evalution : polar bears
Post by bluatigro on Oct 25th, 2015, 11:26am
this is a example of a genetic algoritm
Code:
''les 99i evolution
dim dna( 11 )
WindowWidth = 800
WindowHeight = 600
nomainwin
open "Polar bears ." for graphics as #m
#m "trapclose [quit]"
#m "font Corier_new 30 bold"
''first we fill the dna whit random chromoson
for i = 0 to 11
dna( i ) = int( rnd(0) * 2 ^ 24 )
next
timer 2000 , [timer]
wait
[timer]
#m "fill 127 127 127"
#m "goto 0 30"
#m "down"
#m "\Generation : " ; generation
#m "up"
scan
''draw bears
for x = 0 to 2
for y = 0 to 3
call draw.bear x * 250 + 50 _
, y * 75 + 200 , dna( x + y * 3 )
next y
next x
''next gereration
generation = generation + 1
''sort bears on fitness
for h = 1 to 11
for l = 0 to h - 1
if fout( dna( l ) ) > fout( dna( h ) ) then
help = dna( l )
dna( l ) = dna( h )
dna( h ) = help
end if
next l
next h
if fout( dna( 0 ) ) = 0 then
timer 0
notice "Generation : " ; generation
close #m
end
end if
''create childern and mutate some of them
for i = 4 to 11
a = int( rnd(0) * 4 )
b = int( rnd(0) * 4 )
dna( i ) = child( dna( a ), dna( b ) )
if rnd(0) > 0.5 then
dna( i ) = mutate( dna( i ) )
end if
next i
wait
[quit]
close #m
end
function fout( kl )
r = int( kl and 255 )
g = int( kl / 256 and 255 )
b = int( kl / 256 ^ 2 and 255 )
fout = sqr((255-r)^2+(255-g)^2+(255-b)^2)
end function
sub draw.bear x , y , kl
r = int( kl and 255 )
g = int( kl / 256 and 255 )
b = int( kl / 256 ^ 2 and 255 )
if r + g + b > 127 * 3 then
#m "color black"
else
#m "color white"
end if
#m "backcolor " ; r ; " " ; g ; " " ; b
#m "goto " ; x ; " " ; y
#m "down"
#m "\" + nr$( r ) + " " + nr$( g ) + " " + nr$( b )
#m "up"
end sub
function nr$( x )
nr$ = right$( "000" ; x , 3 )
end function
function child( a , b )
uit = 0
for i = 0 to 23
if rnd(0) < 0.5 then
uit = uit + ( a and ( 2 ^ i ) )
else
uit = uit + ( b and ( 2 ^ i ) )
end if
next i
child = uit
end function
function mutate( a )
mutate = a xor ( 2 ^ int( rnd(0) * 23 ) )
end function
Re: evalution : polar bears
Post by bluatigro on Oct 26th, 2015, 10:10am
pardon :
- i gave no explanation
GA what :
- evalution in the computer
GA how :
- 1 - : create a set of random polarbears [ dna() ]
- 2 - : look how white the polarbears are [ get fitness ]
- 3 - : sort polarbears on 'whitenes'
- 4 - : best polarbears get children
- 5 - : some childern get mutated
- 6 - : if best polarbear <> white goto 2
this is a simulation
it is based on realyty
differences whit realyty :
- the polarbears are not male or female
- there are les polarbears
- bears reproduce after 2 sec. of live
the numbers you see are the red green blue genes
of the color chromoson
update :
- more bears
- more parents
Code:
global dnamax
dnamax = 29
dim dna( dnamax )
global generation
WindowWidth = 800
WindowHeight = 600
'nomainwin
open "Polar bears ." for graphics as #m
#m "trapclose [quit]"
#m "font Corier_new 30 bold"
''first we fill the dna whit random chromoson
for i = 0 to dnamax
dna( i ) = int( rnd(0) * 2 ^ 24 )
next
'goto [timer]
timer 200 , [timer]
wait
[timer]
#m "fill 127 127 127"
#m "goto 0 30"
#m "down"
#m "\Generation : " ; generation
#m "up"
scan
''draw bears
for x = 0 to 2
for y = 0 to dnamax / 3
call draw.bear x * 250 _
, y * 50 + 90 , dna( x + y * 3 )
next y
next x
''next gereration
generation = generation + 1
''sort bears on fitness
for h = 1 to dnamax
for l = 0 to h - 1
if fout( dna( l ) ) > fout( dna( h ) ) then
help = dna( l )
dna( l ) = dna( h )
dna( h ) = help
end if
next l
next h
''create childern and mutate some of them
for i = 6 to dnamax
a = int( rnd(0) * 6 )
b = int( rnd(0) * 6 )
dna( i ) = child( dna( a ), dna( b ) )
if rnd(0) > 0.5 then
dna( i ) = mutate( dna( i ))
end if
next i
wait
[quit]
close #m
end
function fout( kl )
r = int( kl and 255 )
g = int( (kl / 256)) and 255
b = int( (kl / 256) ^ 2) and 255
fout = sqr((255-r)^2+(255-g)^2+(255-b)^2)
end function
sub draw.bear x , y , kl
r = int( kl and 255 )
g = int( (kl / 256)) and 255
b = int( (kl / 256)) ^ 2 and 255
if r + g + b > 127 * 3 then
#m "color black"
else
#m "color white"
end if
#m "backcolor " ; r ; " " ; g ; " " ; b
#m "goto " ; x ; " " ; y
#m "down"
#m "\" + nr$( r ) + " " + nr$( g ) + " " + nr$( b )
#m "up"
end sub
function nr$( x )
nr$ = right$( "000" ; x , 3 )
end function
function child( a , b )
uit = 0
for i = 0 to 23
if rnd(0) < 0.5 then
uit = uit + ( a and ( 2 ^ i ) )
else
uit = uit + ( b and ( 2 ^ i ) )
end if
next i
child = uit
end function
function mutate( a )
mutate = a xor ( 2 ^ int( rnd(0) * 23 ) )
end function
Re: evalution : polar bears
Post by bluatigro on Oct 26th, 2015, 11:45am
update :
- last errors removed
Code:
global dnamax
dnamax = 14
dim dna( dnamax )
global generation
WindowWidth = 800
WindowHeight = 600
nomainwin
open "Polar bears ." for graphics as #m
#m "trapclose [quit]"
#m "font Corier_new 30 bold"
''first we fill the dna whit random chromoson
for i = 0 to dnamax
dna( i ) = int( rnd(0) * 2 ^ 24 )
next
timer 2000 , [timer]
wait
[timer]
#m "fill 127 127 127"
#m "goto 0 30"
#m "down"
#m "\Generation : " ; generation
#m "up"
scan
''draw bears
for x = 0 to 2
for y = 0 to dnamax / 3
call draw.bear x * 250 _
, y * 50 + 90 , dna( x + y * 3 )
next y
next x
''next gereration
generation = generation + 1
''sort bears on fitness
for h = 1 to dnamax
for l = 0 to h - 1
if fout( dna( l ) ) > fout( dna( h ) ) then
help = dna( l )
dna( l ) = dna( h )
dna( h ) = help
end if
next l
next h
if fout( dna( 0 ) ) = 0 then
timer 0
notice "generation : " ; generation
close #m
end
end if
''create childern and mutate some of them
for i = 6 to dnamax
a = int( rnd(0) * 6 )
b = int( rnd(0) * 6 )
dna( i ) = child( dna( a ), dna( b ) )
if rnd(0) > 0.5 then
dna( i ) = mutate( dna( i ))
end if
next i
wait
[quit]
close #m
end
function fout( kl )
r = int( kl) and 255
g = int( (kl / 256)) and 255
b = int( kl / ( 256 ^ 2 ) ) and 255
fout = sqr((255-r)^2+(255-g)^2+(255-b)^2)
end function
sub draw.bear x , y , kl
r = int( kl and 255 )
g = int( (kl / 256)) and 255
b = int( kl / ( 256 ^ 2 )) and 255
if r + g + b > 127 * 3 then
#m "color black"
else
#m "color white"
end if
#m "backcolor " ; r ; " " ; g ; " " ; b
#m "goto " ; x ; " " ; y
#m "down"
#m "\" + nr$( r ) + " " + nr$( g ) + " " + nr$( b )
#m "up"
end sub
function nr$( x )
nr$ = right$( "000" ; x , 3 )
end function
function child( a , b )
uit = 0
for i = 0 to 23
if rnd(0) < 0.5 then
uit = uit + ( a and ( 2 ^ i ) )
else
uit = uit + ( b and ( 2 ^ i ) )
end if
next i
child = uit
end function
function mutate( a )
mutate = a xor ( 2 ^ int( rnd(0) * 23 ) )
end function