Post by titus on Sept 17, 2022 7:11:35 GMT -5
gp :
a prog that creates a funcxtion outof a array of graphix
gp how :
1 create some random functions
2 calc out put
3 calc error of output
4 sort on error
5 the best create children
6 mutate some children
7 goto 2 if not engoug generations or not smal engoug error fount
a prog that creates a funcxtion outof a array of graphix
gp how :
1 create some random functions
2 calc out put
3 calc error of output
4 sort on error
5 the best create children
6 mutate some children
7 goto 2 if not engoug generations or not smal engoug error fount
'' bluatigro 17 sept 2022
'' genetic programming in just basic
'' proof of concept
dim gene$( 200 ) , prog$( 200 ) , fout(200)
dim in( 10 )
global genetel , numberMode , pi _
, true , false , inputMax , letter$
global rndpower , proglenmax , proglenmin , groeirate , mutaterate
global numberpower , parents
global integers , doubles , only.inputs
only.inputs = 0
integers = 1
doubles = 2
numberMode = only.inputs
parents = 20
rndpower = 1
proglenmax = 200
proglenmin = 40
groeirate = 0.5
mutaterate = 0.5
numberpower = 10
pi = atn( 1 ) * 4
true = not( false )
''i think 10 dimesions are enoug
letter$ = "xyzdefghij"
''all subs need activated genes
call integerArray
call use add$()
call use sub$()
call use div$()
call use multi$()
call use sqr$()
''call use abs$()
''call use int$()
''call use pow$()
''call use sign$()
'' use logaritmic genes
''call use ln$()
''call use log10$()
''call use logx$()
''call use exp$()
'' use gonio genes using radians
''call use sin$()
''call use cos$()
''call use tan$()
''call use atn$()
''call use asin$()
''call use acos$()
'' use gonio genes using degrees
''call use dsin$()
''call use dcos$()
''call use dtan$()
''call use datn$()
''call use dasin$()
''call use dacos$()
'' use desion and logic genes
''call use if$()
''call use and$()
''call use or$()
''call use xor$()
''call use not$()
''call use small$() ''a<b
''call use small2$()
''call use big$() ''a>b
''call use big2$()
''call use between00$() ''a<b<c
''call use between01$()
''call use between10$()
''call use between11$()
''call use out00$() ''b<a or c<b
''call use out01$()
''call use out10$()
''call use out11$()
''call use equal$()
''call use diff$()
call test
call testerror
call calculatePI
call calculateDistance
print "[ GAME OVER : push return to end program ]"
end
sub testerror
cls
print "test the folowing errors ."
print "run [ / 1 0 ] = " ; gprun$( "[ / 1 0 0 ]" )
print "run [ sqr -1 ] = " ; gprun$( "[ sqr -1 0 0 ]" )
print "run [ mod 3 0 ] = " ; gprun$( "[ mod 3 0 0 ]" )
print "run [ log -1 ] = " ; gprun$( "[ log -1 0 0 ]" )
print "run [ log 0 ] = " ; gprun$("[ log 0 0 0 ]" )
print "run [ exp 1000 ] = " ; gprun$( "[ exp 1000 0 0 ]" )
print "run [ tan pi/2 ] = " ; gprun$( "[ tan ";pi/2;" 0 0 ]" )
print "run [ asin 2 ] = " ; gprun$( "[ asn 2 0 0 ]" )
print "run [ acos 2 ] = " ; gprun$( "[ acs 2 0 0 ]" )
input "[ end test errors : push return ]" ; in$
end sub
sub test
print "[ test all the subs ]"
print "testing run :"
a$ = "[ + 11 [ - 2 3 4 ] 5 ]"
b$ = "[ * 6 [ / 7 8 9 ] 10 ]"
c$ = "[ / 1 [ - 1 1 1 ] 1 ]"
print "a = " ; a$
print "b = " ; b$
print "and now a formula whit a error to see if it catched"
print "c = " ; c$
print "run a = " ; gprun$( a$ )
print "check a = " ; 11 + ( 2 - 3 )
print "run b = " ; gprun$( b$ )
print "check b = " ; 6 * ( 7 / 8 )
print "run c = " ; gprun$( c$ )
print "check c = error"
input "[ push return ]" ; in$
print "a = " ; a$
print "b = " ; b$
for i = 0 to 4
c$ = mix$( a$ , b$ )
print "mix a b = c = " ; c$
print "run c = " ; gprun$( c$ )
next i
input "[ push return ]" ; in$
print "testing mutate :"
call printoperators
print "a = " ; a$
for i = 0 to 8
c$ = mutate$( a$ )
print "mutate a = " ; c$ ; " = " ; gprun$( c$ )
next i
input "[ push return ]" ; in$
print "testing write :"
call printoperators
for i = 0 to 8
c$ = write$( 6 )
print "write 6 = " ; c$ ; " = " ; gprun$( c$ )
next i
input "[ end of test al subs : push return ]" ; in$
end sub
sub printoperators
print "operators = { " ;
for i = 0 to genetel
if isGene( gene$( i ) ) then
print word$( gene$( i ) , 2 ) + " " ;
end if
next i
print "}"
end sub
sub calculatePI
print "[ try to get a pi function ]"
''first write formula's
for i = 0 to 200
prog$( i ) = write$( 4 )
next i
pi = atn( 1 ) * 4
''then loop thou generation's
for generation = 0 to 20
''for all formula's : calc fitness
for i = 0 to 200
q$ = gprun$( prog$( i ) )
if left$( q$ , 5 ) = "error" then
fout( i ) = 1e14
else
fout( i ) = abs( pi - val( q$ ) )
end if
next i
call evaluate
next generation
input "[ end of calculate pi : push return ]" ; in$
end sub
sub calculateDistance
print "[ calculate phytagoras ]"
call setInputMax 2 , 10
'' first write some formula's
for i = 0 to 200
prog$( i ) = write$( 6 )
next i
'' loop trou some generations
for generation = 0 to 20
'' for all formula's : calc fitness
for i = 0 to 200
f = 0
for x = 0 to 5
for y = 0 to 5
call setInput 1 , x
call setInput 2 , y
uit$ = gprun$( prog$( i ) )
if left$( uit$ , 5 ) = "error" then
uit = 1e6
else
uit = val( uit$ )
end if
df = abs( uit - sqr(x^2+y^2) )
f = f + df ^ 2
next y
next x
fout( i ) = f
next i
call evaluate
next generation
input "[ end of calculate phytagoras : push return ]" ; in$
end sub
sub evaluate
scan
'' sort programs on fitnes
for h = 1 to 200
for l = 0 to h
if fout( l ) > fout( h ) then
a = fout( h )
fout( h ) = fout( l )
fout( l ) = a
a$ = prog$( h )
prog$( h ) = prog$( l )
prog$( l ) = a$
end if
next l
next h
'' create kid's from best formula's
for i = parents to 200
a = int( rnd( 0 ) ^ rndpower * parents )
b = int( rnd( 0 ) ^ rndpower * parents )
prog$( i ) = mix$( prog$( a ) , prog$( b ) )
if rmd( 0 ) < mutaterate then
prog$( i ) = mutate$( prog$( i ) )
end if
next i
print prog$( 0 )
print fout( 0 )
end sub
sub setInputMax m , keer
''for number of variable's
if m < 1 or m > len( letter$ ) then exit sub
inputMax = m
for k = 1 to keer
for i = 1 to m
call use mid$( letter$ , i , 1 )
next i
next k
end sub
sub setInput no , x
''set variable
if no < 1 or no > inputMax then exit sub
in( no ) = x
end sub
function isNumber( x$ )
isNumber = ( val( x$ ) <> 0 ) _
or ( x$ = "0" )
end function
function isInput( x$ )
isInput = ( len( x$ ) = 1 ) _
and ( instr( letter$ , x$ ) <> 0 )
end function
function isGene( x$ )
isGene = ( left$( x$ , 1 ) = "[" )
end function
function gprun$( prog$ )
''eval function for lisp formula's
''returns a double in a string
''or "error" when a iligal calculation is tryed
''i m not sure i catch all "error"s corectly
''please report mistakes
on error goto [run.error]
if prog$ = "" then prog$ = "error"
if len( prog$ ) > proglenmax then prog$ = "error"
while instr( prog$ , "]" ) <> 0 _
and prog$ <> "error"
einde = instr( prog$ , "]" )
begin = einde
while mid$( prog$ , begin , 1 ) <> "[" and begin > 1
begin = begin - 1
wend
part$ = mid$( prog$ , begin , einde - begin + 1 )
f$ = word$( part$ , 2 )
a$ = word$( part$ , 3 )
b$ = word$( part$ , 4 )
c$ = word$( part$ , 5 )
if isInput( a$ ) then
a = in( instr( letter$ , a$ ) )
else
if isNumber( a$ ) then
a = val( a$ )
else
prog$ = "error"
end if
end if
if isInput( b$ ) then
b = in( instr( letter$ , b$ ) )
else
if isNumber( b$ ) then
b = val( b$ )
else
prog$ = "error"
end if
end if
if isInput( c$ ) then
c = in( instr( letter$ , c$ ) )
else
if isNumber( c$ ) then
c = val( c$ )
else
prog$ = "error"
end if
end if
select case f$
case "+" : ab = a + b
case "-" : ab = a - b
case "*" : ab = a * b
case "/" : ab = a / b
case "sqr" : ab = sqr( a )
case "mod" : ab = a mod b
case "abs" : ab = abs( a )
case "int" : ab = int( a )
case "sign"
if a < 0 then
ab = -1
else
if a > 0 then
ab = 1
else
ab = 0
end if
end if
case "^" : ab = a ^ b
case "ln" : ab = log( a ) / log( exp( 1 ) )
case "log10" : ab = log( a ) / log( 10 )
case "logX" : ab = log( a ) / log( b )
case "exp" : ab = exp( a )
case "sin" : ab = sin( a )
case "cos" : ab = cos( a )
case "tan" : ab = tan( a )
case "atn" : ab = atn( a )
case "asin" : ab = asn( a )
case "acos" : ab = acs( a )
case "dsin" : ab = sin( rad( a ) )
case "dcos" : ab = cos( rad( a ) )
case "dtan" : ab = tan( rad( a ) )
case "datn" : ab = degrees( atn( a ) )
case "dasin" : ab = degrees( asn( a ) )
case "dacos" : ab = degrees( acs( a ) )
case "?" : ab = iif( a , b , c )
case "and" : ab = a and b
case "or" : ab = a or b
case "xor" : ab = a xor b
case "not" : ab = not( a )
case "<"
ab = iif( a < b , true , false )
case "<="
ab = iif( a <= b , true , false )
case ">"
ab = iif( a > b , true , false )
case ">="
ab = iif( a >= b , true , false )
case "<?<"
ab = iif( a < b and b < c , true , false )
case "<?<="
ab = iif( a < b and b <= c , true , false )
case "<=?<"
ab = iif( a <= b and b < c , true , false )
case "<=?<="
ab = iif( a <= b and b <= c , true , false )
case "?<<?"
ab = iif( a > b or b > c , true , false )
case "?<<=?"
ab = iif( a > b or b >= c , true , false )
case "?<=<?"
ab = iif( a >= b or b > c , true , false )
case "?<=<=?"
ab = iif( a >= b or b >= c , true , false )
case "="
ab = iif( a = b , true , false )
case "<>"
ab = iif( a <> b , true , false )
case else
prog$ = "error"
end select
if prog$ <> "error" then
l$ = left$( prog$ , begin - 1 )
r$ = mid$( prog$ , einde + 1 _
, len( prog$ ) - einde + 1 )
prog$ = l$ + str$( ab ) + r$
end if
wend
gprun$ = prog$
exit function
[run.error]
gprun$ = "error"
end function
function iif( bool , t , f )
uit = t
if bool then uit = f
iif = uit
end function
function write$( hookmax )
''write a program whit the activated genes
''get a function gene for seed
dice = int( rnd( 0 ) * genetel )
while not( isGene( gene$( dice ) ) )
dice = int( rnd( 0 ) * genetel )
wend
uit$ = gene$( dice )
while instr( uit$, "#" ) <> 0 _
and hook < hookmax
p = instr( uit$ , "#" )
dice = int( rnd( 0 ) * genetel )
l$ = left$( uit$ , p - 1 )
r$ = right$( uit$ , len( uit$ ) - p )
uit$ = l$ +" "+ gene$( dice ) + r$
if isGene( gene$( dice ) ) then
hook = hook + 1
end if
wend
uit$ = lasthekje$( uit$ )
if rnd(0) < groeirate _
or len( uit$ ) < proglenmin then
uit$ = groei$( uit$ )
end if
write$ = uit$
end function
function lasthekje$( uit$ )
''remove al #'s
while instr( uit$, "#" ) <> 0
p = instr( uit$ , "#" )
dice = int( rnd( 0 ) * genetel )
while isGene( gene$( dice ) )
dice = int( rnd( 0 ) * genetel )
wend
l$ = left$( uit$ , p - 1 )
r$ = right$( uit$ , len( uit$ ) - p )
uit$ = l$ +" "+ gene$( dice ) + r$
wend
lasthekje$ = uit$
end function
function groei$( a$ )
''add function gen to formula
tel = 0
for i = 1 to len( a$ )
if mid$( a$ , i , 1 ) = " " then tel = tel + 1
next i
dice = int( rnd(0) * tel + 1 )
while not( isInput( word$( a$ , dice ) ) ) _
and not( isNumber( word$( a$ , dice ) ) )
dice = int( rnd(0) * tel + 1 )
wend
atom$ = word$( a$ , dice )
dice2 = int( rnd(0) * genetel )
while not( isGene( gene$( dice2 ) ) )
dice2 = int( rnd(0) * genetel )
wend
gen$ = gene$( dice2 )
uit$ = ""
for i = 1 to tel
if i = dice then
uit$ = uit$ + gen$ + " "
else
uit$ = uit$ + word$( a$ , i ) + " "
end if
next i
groei$ = lasthekje$( uit$ )
end function
sub use gen$
''activate gen$ for use in writing and mutation
gene$( genetel ) = gen$
genetel = genetel + 1
end sub
sub integerArray
''create a array of integer genes
for i = 0 to numberpower
call use str$( 2 ^ i )
call use str$( ( 2 ^ i ) * -1 )
next i
call use "0"
numberMode = integers
end sub
sub doubleArray
''create a array of double genes
for i = 0-numberpower to numberpower
call use str$( 2 ^ i )
call use str$( ( 2 ^ i ) * -1 )
next i
call use "0"
numberMode = doubles
end sub
function mix$( a$ , b$ )
''take a random part of a formula
''and put it a random place
''of another formula
if rnd( 0 ) < .5 then
h$ = a$
a$ = b$
b$ = h$
end if
for i = 1 to len( a$ )
if mid$( a$ , i , 1 ) = "[" then
qa$ = qa$ + str$( i ) + " "
at = at + 1
end if
next i
for i = 1 to len( b$ )
if mid$( b$ , i , 1 ) = "[" then
qb$ = qb$ + str$( i ) + " "
bt = bt + 1
end if
next i
begina = val( word$( qa$ , int( rnd(0) * at + 1 ) ) )
eindea = begina
fl = 0
while fl >= 0
eindea = eindea + 1
if mid$( a$ , eindea , 1 ) = "[" then fl=fl+1
if mid$( a$ , eindea , 1 ) = "]" then fl=fl-1
wend
beginb = val( word$( qb$ , int( rnd(0) * bt + 1 ) ) )
eindeb = beginb
fl = 0
while fl >= 0
eindeb = eindeb + 1
if mid$( b$ , eindeb , 1 ) = "[" then fl=fl+1
if mid$( b$ , eindeb , 1 ) = "]" then fl=fl-1
wend
l$ = left$( b$ , beginb - 1 )
r$ = right$( b$ , len( b$ ) - eindeb + 1 )
mix$ = l$ _
+ mid$( a$ , begina , eindea - begina ) _
+ r$
end function
function mutate$( a$ )
''mutate prog a$
''find complexity
tel = 0
for i = 1 to len( a$ )
if mid$( a$ , i , 1 ) = " " then
tel = tel + 1
end if
next i
''take a atom that isnt a hook or empty
dice = int( rnd( 0 ) * tel + 1 )
while word$( a$ , dice ) = "[" _
or word$( a$ , dice ) = "]" _
or word$( a$ , dice ) = ""
dice = int( rnd( 0 ) * tel + 1 )
wend
atom$ = word$( a$ , dice )
if isInput( atom$ ) then
if rnd(0) < .6 then
atom$ = mid$( letter$ _
, int( rnd(0) * inputMax ) , 1 )
else
select case numberMode
case integers
atom$ = str$( 2 _
^ ( int( rnd(0) * numberpower ) ) )
case doubles
atom$ = str$( 2 _
^ ( int( rnd(0) * numberpwer * 2 - numberpower ) ) )
case else
atom$ = mid$( letter$ _
, int( rnd(0) * ( inputMax - 1 ) + 1 ) _
, 1 )
end select
end if
else
if isNumber( atom$ ) then
select case numberMode
case integers
x = val( atom$ )
atom$ = str$( x _
xor 2 ^ int( rnd(0) * numberpower ) )
case else ''doubles
x = val( atom$ )
q = 2 ^ int( rnd(0) * numberpower * 2 - numberpower )
if rnd(0) < .5 then
atom$ = str$( x - q )
else
atom$ = str$( x + q )
end if
end select
if inputMax > 0 then
if rnd(0) < .4 then
atom$ = mid$( letter$ _
, int( rnd(0) * ( inputMax - 1 ) + 1 ) _
, 1 )
end if
end if
else
''atom is a function
q = 0
while not( isGene( gene$( q ) ) )
q = int( rnd( 0 ) * genetel )
wend
atom$ = word$( gene$( q ) , 2 )
end if
end if
uit$ = ""
for i = 1 to tel + 2
if i = dice then
uit$ = uit$ + atom$ + " "
else
uit$ = uit$ + word$( a$ , i ) + " "
end if
next i
if rnd(0) < mutaterate _
and len( uit$ ) < proglenmax then
uit$ = groei$( uit$ )
end if
mutate$ = uit$
end function
function rad( deg )
rad = deg * pi / 180
end function
function degrees( r )
degrees = r / pi * 180
end function
''gene pool
''feel free to extemd
''if you extend this you have
''to alter gprun$() to
function add$()
add$ = "[ + # # # ]"
end function
function sub$()
sub$ = "[ - # # # ]"
end function
function div$()
div$ = "[ / # # # ]"
end function
function multi$()
multi$ = "[ * # # # ]"
end function
function sqr$()
sqr$ = "[ sqr # # # ]"
end function
function mod$()
mod$ = "[ mod # # # ]"
end function
function abs$()
abs$ = "[ abs # # # ]"
end function
function int$()
int$ = "[ int # # # ]"
end function
function sign$()
sign$ = "[ sign # # # ]"
end function
function pow$()
pow$ = "[ ^ # # # ]"
end function
function ln$()
ln$ = "[ ln # # # ]"
end function
function log10$()
log10$ = "[ log10 # # # ]"
end function
function logx$()
logx$ = "[ logX # # # ]"
end function
function exp$()
exp$ = "[ exp # # # ]"
end function
function sin$()
sin$ = "[ sin # # # ]"
end function
function cos$()
cos$ = "[ cos # # # ]"
end function
function tan$()
tan$ = "[ tan # # # ]"
end function
function atn$()
atn$ = "[ atn # # # ]"
end function
function asin$()
asin$ = "[ asin # # # ]"
end function
function acos$()
acos$ = "[ acos # # # ]"
end function
function dsin$()
sin$ = "[ dsin # # # ]"
end function
function dcos$()
cos$ = "[ dcos # # # ]"
end function
function dtan$()
tan$ = "[ dtan # # # ]"
end function
function datn$()
atn$ = "[ datn # # # ]"
end function
function dasin$()
asin$ = "[ dasin # # # ]"
end function
function dacos$()
acos$ = "[ dacos # # # ]"
end function
function if$()
if$ = "[ ? # # # ]"
end function
function and$()
and$ = "[ and # # # ]"
end function
function or$()
or$ = "[ or # # # ]"
end function
function xor$()
xor$ = "[ xor # # # ]"
end function
function not$()
not$ = "[ not # # # ]"
end function
function small$()
small$ = "[ < # # # ]"
end function
function small2$()
small2$ = "[ <= # # # ]"
end function
function big$()
big$ = "[ > # # # ]"
end function
function big2$()
big2$ = "[ >= # # # ]"
end function
function between00$()
between00$ = "[ <?< # # # ]"
end function
function between01$()
between01$ = "[ <?<= # # # ]"
end function
function between10$()
between10$ = "[ <=?< # # # ]"
end function
function between11$()
between11$ = "[ <=?<= # # # ]"
end function
function out00$()
out00$ = "[ ?<<? # # # ]"
end function
function out01$()
out01$ = "[ ?<<=? # # # ]"
end function
function out10$()
out10$ = "[ ?<=<? # # # ]"
end function
function out11$()
out11$ = "[ ?<=<=? # # # ]"
end function
function equal$()
equal$ = "[ = # # # ]"
end function
function diff$()
diff$ = "[ <> # # # ]"
end function