|
Post by bluatigro on Apr 8, 2018 3:23:56 GMT -5
i been working some time on this GP what : create a formula that makes a given array or graph GP how : 1 : create a array of random formula's 2 : sort formula's on fitness 3 : best formula's make kid's 4 : some kid's are mutated 5 : if generation < max and fitness > wanted then goto 2 rem : i m not sure about function gprun() it is posible that i made some mistakes whit error chatching please help whit that if you need more REM in the code ask Attachments:Gene_Prog.bas (19.44 KB)
|
|
|
Post by badbug on Apr 8, 2018 15:50:14 GMT -5
Interesting. I'm working on predictions that tries to be like nature. Basically if the perdition is correct the parent lives. If incorrect then it mutates and if a mutate is better, mutate or child lives and the parent dies.
I went the really simple route. I simply ask you for 0 or 1, true or false, up or down. The system tries to predict what you would say. It has an array that is very simple . Each table position has the your prediction (0 or 1) and two pointers - a yes (true) or no (false) pointer.
The arrays:
pred(100)
predY(100)
predN(100)
curNode = current location in the array.
endNode = the last position in the array
ynList = a list of your answers. It appends your answer to the end
ynLen = the length of the ynList. The shorter you make this the faster it changes to your response.
totGood = the total of good predictions
totBad = the total of bad predictions
If you are using the table to watch a stock, Basically all you need it greater than 50% of predictions of Up or Down for the day.
To start off I set up 10 nodes with predY() and predN() pointers and randomly set pred() to Y or N
Mutations.
if the guess is wrong it tries to mutate 1000 times. You can set this to whatever you want.
1. Randomly add a node with Y/N and point it to somewhere in the table. Randomly point some other nodes to it.
2. Randomly delete a node. Then make sure you have no pointers past the end.
3. Randomly change the current location
4. Randomly change some Y/N
5. Randomly change some Y/N pointers.
Each mutation should make sure you don't point go past the endNode. Make sure you have no Nodes that don't get pointed to.
So far, believe it or not, it can out guess your input. That's because everyone has some bias. Flipping a coin is not permitted.
If this could work, then looking at the stock could predict if it would go up or down.
If that works then instead of Y/N we could introduce a percentage up or down..
Anyway - an interesting concept.. Will it work? Dunno!
|
|
|
Post by bluatigro on Apr 22, 2018 2:22:03 GMT -5
update :
tryed to ad error catching
error :
BUG FOUNT IN LB4.5.1
on error goto [erroor] does NOT work Always !!!
so this code somitmes crashes 
'' bluatigro 22 apr 2018 '' 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 calculatePI ''call calculateDistance print "[ GAME OVER ]"
end sub test print "[ test all the subs ]" print "[ test of 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 "[ end test run : push return ]" ; in$ cls print "[ test mix ]" 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 "[ end test mix : push return ]" ; in$ cls print "[ test of mutate ]" call printoperators print "a = " ; a$ for i = 0 to 4 c$ = mutate$( a$ ) print "mutate a = c = " ; c$ print "run c = " ; gprun$( c$ ) next i input "[ end test mutate : push return ]" ; in$ cls print "[ test of write ]" call printoperators for i = 0 to 4 c$ = write$( 6 ) print "write 6 = c = " ; c$ print "run 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 print prog$( 0 ) print fout( 0 ) 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 10 for y = 0 to 10 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 '' 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 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
if prog$ = "" then prog$ = "error" if len( prog$ ) > proglenmax then prog$ = "error" on error goto [gprunError] 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 [gprunError] 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 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 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
|
|
|
Post by tsh73 on Apr 22, 2018 6:15:05 GMT -5
Hello bluatigro I tried to run your program under debug - and it halts on this line fout( i ) = abs( pi - val( q$ ) ) into sub calculatePI with error Float overflow exception
Actually it is val( q$ ) And q$ in question was 618 digits That is more then Double number could contain (1e+308, 308 numbers only).
So it was not error on function gprun$( prog$ ) , and error check in there could not help.
BUT it looks like float overflow does not caught with on Error... EDIT Indeed it does get caught.
(but you can just check if len(q$) is too much)
|
|
|
Post by bluatigro on Apr 22, 2018 7:54:41 GMT -5
tsh73thanks for finding that !! i was aready verry buzy finding the 'bug' update : i added a check line to sub calculatePI rem : if LB reports a eooror it does not jump to the error-line if it did that i can fint error's mutch faster i tested this several times : i worked whitout crashing '' bluatigro 22 apr 2018 '' 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 calculatePI ''call calculateDistance print "[ GAME OVER ]"
end sub test print "[ test all the subs ]" print "[ test of 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 "[ end test run : push return ]" ; in$ cls print "[ test mix ]" 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 "[ end test mix : push return ]" ; in$ cls print "[ test of mutate ]" call printoperators print "a = " ; a$ for i = 0 to 4 c$ = mutate$( a$ ) print "mutate a = c = " ; c$ print "run c = " ; gprun$( c$ ) next i input "[ end test mutate : push return ]" ; in$ cls print "[ test of write ]" call printoperators for i = 0 to 4 c$ = write$( 6 ) print "write 6 = c = " ; c$ print "run 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 len( q$ ) > 14 then q$ = "error" if left$( q$ , 5 ) = "error" then fout( i ) = 1e14 else fout( i ) = abs( pi - val( q$ ) ) end if next i call evaluate print prog$( 0 ) print fout( 0 ) 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 10 for y = 0 to 10 call setInput 1 , x call setInput 2 , y uit$ = gprun$( prog$( i ) ) if len( uit$ ) > 14 then uit$ = "error" 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 '' 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 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
if prog$ = "" then prog$ = "error" if len( prog$ ) > proglenmax then prog$ = "error" on error goto [gprunError] 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 [gprunError] 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 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 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
this works now can anyone think of a game around this ?
|
|
|
Post by Rod on Apr 22, 2018 12:08:20 GMT -5
It does, Anatoly just found your last error by using that technique. You need to use the debugger more.
|
|
|
Post by bluatigro on Jul 8, 2019 6:06:59 GMT -5
i Always wondered what is the inv from x ^ x that is why i m trying this error : WARNING : my pc froze
the error must be in foo()
'' bluatigro 8 jul 2019 '' genetic programming in liberty/just basic '' proof of concept
dim gene$( 200 ) , prog$( 200 ) , fout( 200 ) dim in( 10 ) , qq( 100 ) 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 small0$() ''a<b ''call use small1$() ''call use big0$() ''a>b ''call use big1$() ''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 aprox$() ''call use equal$() ''call use diff$() print "strange function gen's" print between00$() ''a<b<c print between01$() print between10$() print between11$() print out00$() ''b<a or c<b print out01$() print out10$() print out11$() print aprox$()
input "[ push return ]" ; in$ call test ''call calculatePI ''call calculateDistance call calculateInvFoo print "[ GAME OVER ]"
end sub test print "[ test all the subs ]" print "[ test of 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 "[ end test run : push return ]" ; in$ cls print "[ test mix ]" 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 "[ end test mix : push return ]" ; in$ cls print "[ test of mutate ]" call printoperators print "a = " ; a$ for i = 0 to 4 c$ = mutate$( a$ ) print "mutate a = c = " ; c$ print "run c = " ; gprun$( c$ ) next i input "[ end test mutate : push return ]" ; in$ cls print "[ test of write ]" call printoperators for i = 0 to 4 c$ = write$( 6 ) print "write 6 = c = " ; c$ print "run 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 function foo( x ) ''i have always wondered what is the inv of x^x ''thats why i m trying this ''there is somting wrong whit this ''my pc freezes low = 1 high = x while low <> high m = int( ( low + high ) / 2 ) if x^x < m then high = m else low = m end if wend foo = high end function sub calculateInvFoo print "[ try to get formula for inv x ^ x ]" ''calculate f(x) = x^x for i = 1 to 100 qq( i ) = foo( i ) next i call setInputMax 1 , 10 ''first write formula's for i = 0 to 200 prog$( i ) = write$( 4 ) next i for generation = 0 to 20 ''for all formula's : calc fitness for i = 0 to 200 fout( i ) = 0 for x = 1 to 100 call setInput 1 , x q$ = gprun$( prog$( i ) ) if len( q$ ) > 14 then q$ = "error" if left$( q$ , 5 ) = "error" then f = 1e14 else f = abs( qq( x ) - val( q$ ) ) end if fout( i ) = fout( i ) + f ^ 2 next x next i call evaluate print prog$( 0 ) print fout( 0 ) next generation input "[ end try to get formula for inv x^x ]" ; in$ 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 len( q$ ) > 14 then q$ = "error" if left$( q$ , 5 ) = "error" then fout( i ) = 1e14 else fout( i ) = abs( pi - val( q$ ) ) end if next i call evaluate print prog$( 0 ) print fout( 0 ) 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 10 for y = 0 to 10 call setInput 1 , x call setInput 2 , y uit$ = gprun$( prog$( i ) ) if len( uit$ ) > 14 then uit$ = "error" 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 '' 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 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
if prog$ = "" then prog$ = "error" if len( prog$ ) > proglenmax then prog$ = "error" on error goto [gprunError] 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 "&" : ab = a and b case "|" : 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 chr$( 171 ) '' << ab = iif( a < b and b < c , true , false ) case chr$( 171 ) + "=" ab = iif( a < b and b <= c , true , false ) case "=" + chr$( 171 ) ab = iif( a <= b and b < c , true , false ) case "=" + chr$( 171 ) ab = iif( a <= b and b <= c , true , false ) case chr$( 187 ) '' >> ab = iif( a > b or b > c , true , false ) case chr$( 187 ) + "=" ab = iif( a > b or b >= c , true , false ) case "=" + chr$( 187 ) ab = iif( a >= b or b > c , true , false ) case "=" + chr$( 187 ) + "=" ab = iif( a >= b or b >= c , true , false ) case chr$( 177 ) ''+- ab = iif( abs( a - 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 [gprunError] 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 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 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$ = "[ & # # # ]" end function function or$() or$ = "[ | # # # ]" end function function xor$() xor$ = "[ xor # # # ]" end function function not$() not$ = "[ not # # # ]" end function function small0$() small0$ = "[ < # # # ]" end function function small1$() small1$ = "[ <= # # # ]" end function function aprox$() ''+- aprox$ = "[ " ; chr$( 177 ) ; " # # # ]" end function function big0$() big0$ = "[ > # # # ]" end function function big1$() big1$ = "[ >= # # # ]" end function function between00$() ''<< between00$ = "[ " + chr$( 171 ) + " # # # ]" end function function between01$() ''<<= between01$ = "[ " + chr$( 171 ) + "= # # # ]" end function function between10$() ''=<< between10$ = "[ =" + chr$( 171 ) + " # # # ]" end function function between11$() ''=<<= between11$ = "[ =" + chr$( 171 ) + "= # # # ]" end function function out00$() ''>> out00$ = "[ " + chr$( 187 ) + " # # # ]" end function function out01$() ''>>= out01$ = "[ " + chr$( 187 ) + "= # # # ]" end function function out10$() ''=>> out10$ = "[ =" + chr$( 187 ) + " # # # ]" end function function out11$() ''=>>= out11$ = "[ =" + chr$( 187 ) + "= # # # ]" end function function equal$() equal$ = "[ = # # # ]" end function function diff$() diff$ = "[ <> # # # ]" end function
|
|
|
Post by bluatigro on Jul 8, 2019 6:09:23 GMT -5
i was wondering : can there be a game what uses this ?
|
|
|
Post by bluatigro on Jul 15, 2019 5:50:26 GMT -5
update : foo() inproved the code produces a result
error : foo() = f(x) = x shoot be inv x ^ x
'' bluatigro 15 jul 2019 '' genetic programming in liberty/just basic '' proof of concept
dim gene$( 200 ) , prog$( 200 ) , fout( 200 ) dim in( 10 ) , qq( 60 ) 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 small0$() ''a<b ''call use small1$() ''call use big0$() ''a>b ''call use big1$() ''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 aprox$() ''call use equal$() ''call use diff$() print "strange function gen's" print between00$() ''a<b<c print between01$() print between10$() print between11$() print out00$() ''b<a or c<b print out01$() print out10$() print out11$() print aprox$()
input "[ push return ]" ; in$ call test ''call calculatePI ''call calculateDistance call calculateInvFoo print "[ GAME OVER ]"
end sub test print "[ test all the subs ]" print "[ test of 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 "[ end test run : push return ]" ; in$ cls print "[ test mix ]" 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 "[ end test mix : push return ]" ; in$ cls print "[ test of mutate ]" call printoperators print "a = " ; a$ for i = 0 to 4 c$ = mutate$( a$ ) print "mutate a = c = " ; c$ print "run c = " ; gprun$( c$ ) next i input "[ end test mutate : push return ]" ; in$ cls print "[ test of write ]" call printoperators for i = 0 to 4 c$ = write$( 6 ) print "write 6 = c = " ; c$ print "run 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 function foo( x ) ''i have always wondered what is the inv of x^x ''thats why i m trying this ''there is somting wrong whit this ''my pc freezes low = 1 high = x while low <> high scan m = ( low + high ) / 2 if m ^ m < x then high = m else low = m end if wend foo = high end function sub calculateInvFoo print "[ try to get formula for inv x ^ x ]" ''calculate f(x) = x^x for i = 1 to 60 qq( i ) = foo( i ) print i ; " " ; qq( i ) next i print call setInputMax 1 , 10 ''first write formula's for i = 0 to 200 prog$( i ) = write$( 4 ) next i for generation = 0 to 20 ''for all formula's : calc fitness for i = 0 to 200 fout( i ) = 0 for x = 1 to 60 call setInput 1 , x q$ = gprun$( prog$( i ) ) if len( q$ ) > 14 then q$ = "error" if left$( q$ , 5 ) = "error" then f = 1e14 else f = abs( qq( x ) - val( q$ ) ) end if fout( i ) = fout( i ) + f ^ 2 next x next i call evaluate print prog$( 0 ) print fout( 0 ) next generation input "[ end try to get formula for inv x^x ]" ; in$ 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 len( q$ ) > 14 then q$ = "error" if left$( q$ , 5 ) = "error" then fout( i ) = 1e14 else fout( i ) = abs( pi - val( q$ ) ) end if next i call evaluate print prog$( 0 ) print fout( 0 ) 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 10 for y = 0 to 10 call setInput 1 , x call setInput 2 , y uit$ = gprun$( prog$( i ) ) if len( uit$ ) > 14 then uit$ = "error" 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 '' 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 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
if prog$ = "" then prog$ = "error" if len( prog$ ) > proglenmax then prog$ = "error" on error goto [gprunError] 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 "&" : ab = a and b case "|" : 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 chr$( 171 ) '' << ab = iif( a < b and b < c , true , false ) case chr$( 171 ) + "=" ab = iif( a < b and b <= c , true , false ) case "=" + chr$( 171 ) ab = iif( a <= b and b < c , true , false ) case "=" + chr$( 171 ) ab = iif( a <= b and b <= c , true , false ) case chr$( 187 ) '' >> ab = iif( a > b or b > c , true , false ) case chr$( 187 ) + "=" ab = iif( a > b or b >= c , true , false ) case "=" + chr$( 187 ) ab = iif( a >= b or b > c , true , false ) case "=" + chr$( 187 ) + "=" ab = iif( a >= b or b >= c , true , false ) case chr$( 177 ) ''+- ab = iif( abs( a - 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 [gprunError] 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 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 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$ = "[ & # # # ]" end function function or$() or$ = "[ | # # # ]" end function function xor$() xor$ = "[ xor # # # ]" end function function not$() not$ = "[ not # # # ]" end function function small0$() small0$ = "[ < # # # ]" end function function small1$() small1$ = "[ <= # # # ]" end function function aprox$() ''+- aprox$ = "[ " ; chr$( 177 ) ; " # # # ]" end function function big0$() big0$ = "[ > # # # ]" end function function big1$() big1$ = "[ >= # # # ]" end function function between00$() ''<< between00$ = "[ " + chr$( 171 ) + " # # # ]" end function function between01$() ''<<= between01$ = "[ " + chr$( 171 ) + "= # # # ]" end function function between10$() ''=<< between10$ = "[ =" + chr$( 171 ) + " # # # ]" end function function between11$() ''=<<= between11$ = "[ =" + chr$( 171 ) + "= # # # ]" end function function out00$() ''>> out00$ = "[ " + chr$( 187 ) + " # # # ]" end function function out01$() ''>>= out01$ = "[ " + chr$( 187 ) + "= # # # ]" end function function out10$() ''=>> out10$ = "[ =" + chr$( 187 ) + " # # # ]" end function function out11$() ''=>>= out11$ = "[ =" + chr$( 187 ) + "= # # # ]" end function function equal$() equal$ = "[ = # # # ]" end function function diff$() diff$ = "[ <> # # # ]" end function
|
|