Genteties Programmeren

Algemene discussies en vragen omtrent Liberty BASIC programma's. Stuur zoveel mogelijk delen van listings (snippets) in als je hulp wilt.

Moderators: anthonio, Abcott

Genteties Programmeren

Berichtdoor bluatigro » do jun 19, 2014 10:51 am

dit is een proof of concept van GP in LB

GP wat :
- proberen n functie omschijving te genereren uit n grafiek of tabel

GP hoe :
- 1 : laat de computer n paar programmas schijven [ write() ]
- 2 : bereken output van programmas [ runprog() ]
- 3 : sorteer programmas op fout [ fitnes ]
- 4 : laat beste programmas kinderen maken [ mix() ]
- 5 : muteer somige of de kinderen [ mutate() ]
- 6 : als beste.fout > gewenst en genratie < max dan ganaar 2

Code: Selecteer alles
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
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$()
''call use big$()
''call use between$()
''call use out$()
''call use equal$()
''call use diff$()

call test
input "[ push return ]" ; a$
call inputsetings
''call calculatePI
''input "[ push return ]" ; a$
''call calculateDistance
print "ready"

end
sub test
''test all the subs
  print "testing mix :"
  a$ = "[ + 1 [ - 2 3 4 ] 5 ]"
  b$ = "[ * 6 [ / 7 8 9 ] 10 ]"
  print "a = " ; a$
  print "b = " ; b$
  print "run a = " ; gprun$( a$ )
  print "run b = " ; gprun$( b$ )
  for i = 0 to 10
    c$ = mix$( a$  , b$ )
    print "mix a b = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing mutate :"
  call printoperators
  print "a = " ; a$
  for i = 0 to 10
    c$ = mutate$( a$ )
    print "mutate a = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing write :"
  call printoperators
  for i = 0 to 10
    c$ = write$( 6 )
    print "write 6 = " ; c$ ; " = " ; gprun$( c$ )
  next i
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 inputsetings
  notice chr$( 13 ) _
  + "setings :" + chr$( 13 ) _
  + "population = 200" + chr$( 13 ) _
  + "parents = " ; parents ; chr$( 13 ) _
  + "rnd power = " ; rndpower ; chr$( 13 ) _
  + "prog len max = " ; proglenmax ; chr$( 13 ) _
  + "prog len min = " ; proglenmin ; chr$( 13 ) _
  + "groei rate = " ; groeirate ; chr$( 13 ) _
  + "mutate rate = " ; mutaterate ; chr$( 13 ) _
  + "number power = " ; numberpower ; chr$( 13 )
  confirm "Use setings ?" ; yn$
  if yn$ = "no" then
    in$ = str$( parents )
    prompt "parents [ 10 - 100 ]  = " ; in$
    parents = val( in$ )
    in$ = str$( rndpower )
    prompt "rnd paternt power [ > 1 ] = " ; in$
    rndpower = val( in$ )
    in$ = str$( proglenmax )
    prompt "prog len max [ < 800 ] = " ; in$
    proglenmax = val( in$ )
    in$ = str$( proglenmin )
    prompt "prog len min [ > 40 ] = " ; in$
    proglenmin = val( in$ )
    in$ = str$( groeirate )
    prompt "groei rate [ .1 - .9 ] = " ; in$
    groeirate = val( in$ )
    in$ = str$( mutaterate )
    prompt "mutate rate [ .1 - .9 ] = " ; in$
    mutaterate = val( in$ )
    in$ = str$( numberpower )
    prompt "number power [ 3 - 31 ] = " ; in$
    numberpower = val( in$ )
  end if
end sub
sub calculatePI
''try to get a pi function
  ''then write programs
  for i = 0 to 200
    prog$( i ) = write$( 4 )
  next i
  pi = atn( 1 ) * 4
  ''then loop thou generations
  for generation = 0 to 20
    ''generate fitnes of every prog$
    for i = 0 to 200
      q$ = gprun$( prog$( i ) )
      if q$ = "error" then
        fout( i ) = 1e14
      else
        fout( i ) = abs( pi - val( q$ ) )
      end if
    next i
    call evaluate
  next generation
end sub
sub calculateDistance
  call setInputMax 2 , 10
  for i = 0 to 200
    prog$( i ) = write$( 6 )
  next i
  for generation = 0 to 20
    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 uit$ = "error" then
            uit = 1e10
          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
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
  ''print best program and its fit ness
    print prog$( 0 )
    print fout( 0 )
  ''get childern
  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 max , keer
  if max < 1 or max > len( letter$ ) then exit sub
  inputMax = max
  for k = 1 to keer
    for i = 1 to max
      call use mid$( letter$ , i , 1 )
    next i
  next k
end sub
sub setInput no , x
  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 functions
  if prog$ = "" then prog$ = "error"
  if len( prog$ ) > proglenmax then prog$ = "error"
  on error goto [catchrun]
  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 "?"
        if a then
          ab = b
        else
          ab = c
        end if
      case "and" : ab = a and b
      case "or" : ab = a or b
      case "xor" : ab = a xor b
      case "not" : ab = not( a )
      case "<"
        if a < b then ab = true
      case "<="
        if a <= b then ab = true
      case ">"
        if a > b then ab = true
      case ">="
        if a >= b then ab = true
      case "<?<"
        if a > b and a < c then ab = true
      case "?<<?"
        if a < b or a > c then ab = true
      case "="
        if a = b then ab = true
      case "<>"
        if a <> b then ab = true
      case else
        prog$ = "error"
    end select
    l$ = left$( prog$ , begin - 1 )
    r$ = mid$( prog$ , einde + 1, len( prog$ ) - einde + 1)
    prog$ = l$ + str$( ab ) + r$
  wend
  gprun$ = prog$
  exit function
  [catchrun]
  gprun$ = "error"
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$ )
  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$ )
  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 = 1
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 = 2
end sub
function mix$( a$ , b$ )
''take a random part of a prog
''and put it a random place
''of another prog
  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 1
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpower ) ) )
        case 2
          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 1 ''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 between$()
  between$ = "[ <?< # # # ]"
end function
function out$()
  out$ = "[ ?<<? # # # ]"
end function
function equal$()
  equal$ = "[ = # # # ]"
end function
function diff$()
  diff$ = "[ <> # # # ]"
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: Genteties Programmeren

Berichtdoor bluatigro » zo okt 11, 2015 4:21 pm

update :
- ik heb bijna alle errors die kunnen onstaan afgevangen in gprun$()
- ik heb hulp nodig bij de laatste errors
Code: Selecteer alles
dim gene$( 200 ) , prog$( 200 ) , fitness( 200 )
dim variable( 10 )
global genetel , numberMode , pi _
, true , false , inputMax , letter$
global rndpower , proglenmax , proglenmin , groeirate , mutaterate
global numberpower , parents
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$()
''call use big$()
''call use between$()
''call use out$()
''call use equal$()
''call use diff$()
''call use aprox$()

call test
input "[ push return ]" ; a$
''call inputsetings
call calculatePI
''input "[ push return ]" ; a$
''call calculateDistance
print "game over"

end
sub test
''test all the subs
  print "testing mix :"
  a$ = "[ + 1 [ - 2 3 4 ] 5 ]"
  b$ = "[ * 6 [ / 7 8 9 ] 10 ]"
  print "a = " ; a$
  print "b = " ; b$
  print "run a = " ; gprun$( a$ )
  print "run b = " ; gprun$( b$ )
  for i = 0 to 10
    c$ = mix$( a$  , b$ )
    print "mix a b = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing mutate :"
  call printoperators
  print "a = " ; a$
  for i = 0 to 10
    c$ = mutate$( a$ )
    print "mutate a = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing write :"
  call printoperators
  for i = 0 to 10
    c$ = write$( 6 )
    print "write 6 = " ; c$ ; " = " ; gprun$( c$ )
  next i
end sub
sub printoperators
''prints all the functions you activated
  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 inputsetings
''lists all the settings
  notice chr$( 13 ) _
  + "setings :" + chr$( 13 ) _
  + "population = 200" + chr$( 13 ) _
  + "parents = " ; parents ; chr$( 13 ) _
  + "rnd power = " ; rndpower ; chr$( 13 ) _
  + "prog len max = " ; proglenmax ; chr$( 13 ) _
  + "prog len min = " ; proglenmin ; chr$( 13 ) _
  + "groei rate = " ; groeirate ; chr$( 13 ) _
  + "mutate rate = " ; mutaterate ; chr$( 13 ) _
  + "number power = " ; numberpower ; chr$( 13 )
  confirm "Use setings ?" ; yn$
  if yn$ = "no" then
    in$ = str$( parents )
    prompt "parents [ 10 - 100 ]  = " ; in$
    parents = val( in$ )
    in$ = str$( rndpower )
    prompt "rnd paternt power [ > 1 ] = " ; in$
    rndpower = val( in$ )
    in$ = str$( proglenmax )
    prompt "prog len max [ < 800 ] = " ; in$
    proglenmax = val( in$ )
    in$ = str$( proglenmin )
    prompt "prog len min [ > 40 ] = " ; in$
    proglenmin = val( in$ )
    in$ = str$( groeirate )
    prompt "groei rate [ .1 - .9 ] = " ; in$
    groeirate = val( in$ )
    in$ = str$( mutaterate )
    prompt "mutate rate [ .1 - .9 ] = " ; in$
    mutaterate = val( in$ )
    in$ = str$( numberpower )
    prompt "number power [ 3 - 31 ] = " ; in$
    numberpower = val( in$ )
  end if
end sub
sub calculatePI
''example use
''try to get a pi function
  print "Trying to get a function for pi ."
  call printoperators
  input "[ push return ]" ; a$
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 4 )
  next i
  pi = atn( 1 ) * 4
  ''then loop thou generations
  for generation = 0 to 50
    ''generate fitnes of every program
    for i = 0 to 200
      ''get output of program
      q$ = gprun$( prog$( i ) )
      if q$ = "error" then
        fitness( i ) = 1e14
      else
        ''calculate fitness of program
        fitness( i ) = abs( pi - val( q$ ) )
      end if
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "     Error = " ; fitness( 0 )
  next generation
end sub
sub calculateDistance
''example use
''try to get a pytagoras function
  print "Trying to get a function for pytagoras ."
  call printoperators
  input "[ push return ]" ; a$
  ''create variable genes
  call setVariableMax 2 , 10
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 6 )
  next i
  ''generate generations
  for generation = 0 to 20
    ''calulate fitness for all programs
    for i = 0 to 200
      ''first we reset fitness for this programn
      fitness = 0
      ''loop trou some coordinates
      for x = -5 to 5
        for y = -5 to 5
          ''set variables for this point
          call setVariable 1 , x
          call setVariable 2 , y
          ''get output of this point
          uit$ = gprun$( prog$( i ) )
          if uit$ = "error" then
            uit = 1e10
          else
            uit = val( uit$ )
          end if
          ''calculate fitness of this point
          df = abs( uit - sqr( x ^ 2 + y ^ 2 ) )
          ''calculate total fitness of this program
          fitness = fitness + df ^ 2
        next y
      next x
      fitness( i ) = f
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "    Error = " ; fitness( 0 )
  next generation
end sub
sub evaluate
''evaluate al programs
  ''sort programs on fitnes
  for h = 1 to 200
    for l = 0 to h
      if fitness( l ) > fitness( h ) then
        a = fitness( h )
        fitness( h ) = fitness( l )
        fitness( l ) = a
        a$ = prog$( h )
        prog$( h ) = prog$( l )
        prog$( l ) = a$
      end if
    next l
  next h
  ''next generatoin : create childern
  for i = parents to 200
    a = int( rnd( 0 ) ^ rndpower * parents )
    b = int( rnd( 0 ) ^ rndpower * parents )
    prog$( i ) = mix$( prog$( a ) , prog$( b ) )
    ''mutate some childern
    if rmd( 0 ) < mutaterate then
      prog$( i ) = mutate$( prog$( i ) )
    end if
  next i
end sub
sub setVariableMax max , keer
''set the number of variables
  if max < 1 or max > len( letter$ ) then exit sub
  variableMax = max
  for k = 1 to keer
    for i = 1 to max
      call use mid$( letter$ , i , 1 )
    next i
  next k
end sub
sub setVariable no , x
''set a variable
  if no < 1 or no > inputMax then exit sub
  variable( no ) = x
end sub
function isNumber( x$ )
  isNumber = ( val( x$ ) <> 0 ) _
             or ( x$ = "0" )
end function
function isVariable( x$ )
  isVariable = ( 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 programs
''returns a double in as string if al is wel
''returns "error" if there is a iligal calculation
  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 isVariable( a$ ) then
      a = variable( instr( letter$ , a$ ) )
    else
      if isNumber( a$ ) then
        a = val( a$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( b$ ) then
      b = variable( instr( letter$ , b$ ) )
    else
      if isNumber( b$ ) then
        b = val( b$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( c$ ) then
      c = variable( 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 "/"
        if abs( b ) < 1e-10 then
          prog$ = "error"
        else
          ab = a / b
        end if
      case "sqr"
        if a < 0 then
          prog$ = "error"
        else
          ab = sqr( a )
        end if
      case "mod"
        if b <> int( b ) or b = 0 then
          prog$ = "error"
        else
          ab = a mod b
        end if
      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 "^"
        if ( a <= 0 ) _
        or ( a <= 0 and b <= 0 ) then
          prog$ = "error"
        else
          ab = a ^ b
        end if
      case "ln"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( exp( 1 ) )
        end if
      case "log10"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( 10 )
        end if
      case "logX"
        if a <= 0 or b <= 0 or b = 1 then
          prog$ = "error"
        else
          ab = log( a ) / log( b )
        end if
      case "exp"
        if abs( a ) > 63 then
          prog$ = "error"
        else
          ab = exp( a )
        end if
      case "sin"
        ab = sin( a )
      case "cos"
        ab = cos( a )
      case "tan"
        ab = tan( a )
      case "atn"
        ab = atn( a )
      case "asin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = asn( a )
        end if
      case "acos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = acs( a )
        end if
      case "dsin"
        ab = sin( rad( a ) )
      case "dcos"
        ab = cos( rad( a ) )
      case "dtan"
        if ( a mod 360 ) = 90 _
        or ( a mod 360 ) = 270 then
          prog$ = "error"
        else
          ab = tan( rad( a ) )
        end if
      case "datn"
        ab = degrees( atn( a ) )
      case "dasin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( asn( a ) )
        end if
      case "dacos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
        ab = degrees( acs( a ) )
        end if
      case "?"
        if a then
          ab = b
        else
          ab = c
        end if
      case "and"
        ab = a and b
      case "or"
        ab = a or b
      case "xor"
        ab = a xor b
      case "not"
        ab = not( a )
      case "<"
        if a < b then ab = true
      case "<="
        if a <= b then ab = true
      case ">"
        if a > b then ab = true
      case ">="
        if a >= b then ab = true
      case "<?<"
        if a > b and a < c then ab = true
      case "?<<?"
        if a < b or a > c then ab = true
      case "="
        if a = b then ab = true
      case "<>"
        if a <> b then ab = true
      case "~~"
        if abs( a - b ) < c then ab = true
      case else
        prog$ = "error"
    end select
    l$ = left$( prog$ , begin - 1 )
    r$ = mid$( prog$ , einde + 1, len( prog$ ) - einde + 1)
    prog$ = l$ + str$( ab ) + r$
  wend
  gprun$ = prog$
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$ )
  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$ )
  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( isVariable( 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 = 1
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 = 2
end sub
function mix$( a$ , b$ )
''take a random part of a prog
''and put it a random place
''of another prog
  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 isVariable( atom$ ) then
    if rnd(0) < .6 then
      atom$ = mid$( letter$ _
      , int( rnd(0) * inputMax ) , 1 )
    else
      select case numberMode
        case 1
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpower ) ) )
        case 2
          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 1 ''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 between$()
  between$ = "[ <?< # # # ]"
end function
function out$()
  out$ = "[ ?<<? # # # ]"
end function
function equal$()
  equal$ = "[ = # # # ]"
end function
function diff$()
  diff$ = "[ <> # # # ]"
end function
function aprox$()
  aprox$ = "[ ~~ # # # ]"
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: Genteties Programmeren

Berichtdoor bluatigro » zo okt 11, 2015 5:35 pm

update :
- nu is alles is engels
Code: Selecteer alles
dim gene$( 200 ) , prog$( 200 ) , fitness( 200 )
dim variable( 10 )
global genecount , numberMode , pi _
, true , false , inputMax , char$
global rndpower , proglenmax , proglenmin , growrate , mutaterate
global numberpower , parents
parents = 20
rndpower = 1
proglenmax = 200
proglenmin = 40
growrate = 0.5
mutaterate = 0.5
numberpower = 10
pi = atn( 1 ) * 4
true = not( false )
''i think 10 dimesions are enoug
char$ = "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$()
''call use big$()
''call use between$()
''call use out$()
''call use equal$()
''call use diff$()
''call use aprox$()

call test
input "[ push return ]" ; a$
''call inputsetings
call calculatePI
''input "[ push return ]" ; a$
''call calculateDistance
print "game over"

end
sub test
''test all the subs
  print "testing mix :"
  a$ = "[ + 1 [ - 2 3 4 ] 5 ]"
  b$ = "[ * 6 [ / 7 8 9 ] 10 ]"
  print "a = " ; a$
  print "b = " ; b$
  print "run a = " ; gprun$( a$ )
  print "run b = " ; gprun$( b$ )
  for i = 0 to 10
    c$ = mix$( a$  , b$ )
    print "mix a b = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing mutate :"
  call printoperators
  print "a = " ; a$
  for i = 0 to 10
    c$ = mutate$( a$ )
    print "mutate a = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing write :"
  call printoperators
  for i = 0 to 10
    c$ = write$( 6 )
    print "write 6 = " ; c$ ; " = " ; gprun$( c$ )
  next i
end sub
sub printoperators
''prints all the functions you activated
  print "operators = { " ;
  for i = 0 to genecount
    if isGene( gene$( i ) ) then
      print word$( gene$( i ) , 2 ) + " " ;
    end if
  next i
  print "}"
end sub
sub inputsetings
''lists all the settings
  notice chr$( 13 ) _
  + "setings :" + chr$( 13 ) _
  + "population = 200" + chr$( 13 ) _
  + "parents = " ; parents ; chr$( 13 ) _
  + "rnd power = " ; rndpower ; chr$( 13 ) _
  + "prog len max = " ; proglenmax ; chr$( 13 ) _
  + "prog len min = " ; proglenmin ; chr$( 13 ) _
  + "grow rate = " ; growrate ; chr$( 13 ) _
  + "mutate rate = " ; mutaterate ; chr$( 13 ) _
  + "number power = " ; numberpower ; chr$( 13 )
  confirm "Use setings ?" ; yn$
  if yn$ = "no" then
    in$ = str$( parents )
    prompt "parents [ 10 - 100 ]  = " ; in$
    parents = val( in$ )
    in$ = str$( rndpower )
    prompt "rnd paternt power [ > 1 ] = " ; in$
    rndpower = val( in$ )
    in$ = str$( proglenmax )
    prompt "prog len max [ < 800 ] = " ; in$
    proglenmax = val( in$ )
    in$ = str$( proglenmin )
    prompt "prog len min [ > 40 ] = " ; in$
    proglenmin = val( in$ )
    in$ = str$( growrate )
    prompt "grow rate [ .1 - .9 ] = " ; in$
    growrate = val( in$ )
    in$ = str$( mutaterate )
    prompt "mutate rate [ .1 - .9 ] = " ; in$
    mutaterate = val( in$ )
    in$ = str$( numberpower )
    prompt "number power [ 3 - 31 ] = " ; in$
    numberpower = val( in$ )
  end if
end sub
sub calculatePI
''example use
''try to get a pi function
  print "Trying to get a function for pi ."
  call printoperators
  input "[ push return ]" ; a$
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 4 )
  next i
  pi = atn( 1 ) * 4
  ''then loop thou generations
  for generation = 0 to 50
    ''generate fitnes of every program
    for i = 0 to 200
      ''get output of program
      q$ = gprun$( prog$( i ) )
      if q$ = "error" then
        fitness( i ) = 1e14
      else
        ''calculate fitness of program
        fitness( i ) = abs( pi - val( q$ ) )
      end if
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "     Error = " ; fitness( 0 )
  next generation
end sub
sub calculateDistance
''example use
''try to get a pytagoras function
  print "Trying to get a function for pytagoras ."
  call printoperators
  input "[ push return ]" ; a$
  ''create variable genes
  call setVariableMax 2 , 10
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 6 )
  next i
  ''generate generations
  for generation = 0 to 20
    ''calulate fitness for all programs
    for i = 0 to 200
      ''first we reset fitness for this programn
      fitness = 0
      ''loop trou some coordinates
      for x = -5 to 5
        for y = -5 to 5
          ''set variables for this point
          call setVariable 1 , x
          call setVariable 2 , y
          ''get output of this point
          output$ = gprun$( prog$( i ) )
          if output$ = "error" then
            output = 1e10
          else
            output = val( output$ )
          end if
          ''calculate fitness of this point
          df = abs( output - sqr( x ^ 2 + y ^ 2 ) )
          ''calculate total fitness of this program
          fitness = fitness + df ^ 2
        next y
      next x
      fitness( i ) = fitness
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "    Error = " ; fitness( 0 )
  next generation
end sub
sub evaluate
''evaluate al programs
  ''sort programs on fitnes
  for h = 1 to 200
    for l = 0 to h
      if fitness( l ) > fitness( h ) then
        a = fitness( h )
        fitness( h ) = fitness( l )
        fitness( l ) = a
        a$ = prog$( h )
        prog$( h ) = prog$( l )
        prog$( l ) = a$
      end if
    next l
  next h
  ''next generatoin : create childern
  for i = parents to 200
    a = int( rnd( 0 ) ^ rndpower * parents )
    b = int( rnd( 0 ) ^ rndpower * parents )
    prog$( i ) = mix$( prog$( a ) , prog$( b ) )
    ''mutate some childern
    if rmd( 0 ) < mutaterate then
      prog$( i ) = mutate$( prog$( i ) )
    end if
  next i
end sub
sub setVariableMax max , keer
''set the number of variables
  if max < 1 or max > len( char$ ) then exit sub
  variableMax = max
  for k = 1 to keer
    for i = 1 to max
      call use mid$( char$ , i , 1 )
    next i
  next k
end sub
sub setVariable no , x
''set a variable
  if no < 1 or no > inputMax then exit sub
  variable( no ) = x
end sub
function isNumber( x$ )
  isNumber = ( val( x$ ) <> 0 ) _
             or ( x$ = "0" )
end function
function isVariable( x$ )
  isVariable = ( len( x$ ) = 1 ) _
            and ( instr( char$ , x$ ) <> 0 )
end function
function isGene( x$ )
  isGene = ( left$( x$ , 1 ) = "[" )
end function
function gprun$( prog$ )
''eval function for lisp programs
''returns a double in as string if al is wel
''returns "error" if there is a iligal calculation
  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 isVariable( a$ ) then
      a = variable( instr( char$ , a$ ) )
    else
      if isNumber( a$ ) then
        a = val( a$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( b$ ) then
      b = variable( instr( char$ , b$ ) )
    else
      if isNumber( b$ ) then
        b = val( b$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( c$ ) then
      c = variable( instr( char$ , 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 "/"
        if abs( b ) < 1e-10 then
          prog$ = "error"
        else
          ab = a / b
        end if
      case "sqr"
        if a < 0 then
          prog$ = "error"
        else
          ab = sqr( a )
        end if
      case "mod"
        if b <> int( b ) or b = 0 then
          prog$ = "error"
        else
          ab = a mod b
        end if
      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 "^"
        if ( a <= 0 ) _
        or ( a <= 0 and b <= 0 ) then
          prog$ = "error"
        else
          ab = a ^ b
        end if
      case "ln"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( exp( 1 ) )
        end if
      case "log10"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( 10 )
        end if
      case "logX"
        if a <= 0 or b <= 0 or b = 1 then
          prog$ = "error"
        else
          ab = log( a ) / log( b )
        end if
      case "exp"
        if abs( a ) > 63 then
          prog$ = "error"
        else
          ab = exp( a )
        end if
      case "sin"
        ab = sin( a )
      case "cos"
        ab = cos( a )
      case "tan"
        ab = tan( a )
      case "atn"
        ab = atn( a )
      case "asin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = asn( a )
        end if
      case "acos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = acs( a )
        end if
      case "dsin"
        ab = sin( rad( a ) )
      case "dcos"
        ab = cos( rad( a ) )
      case "dtan"
        if ( a mod 360 ) = 90 _
        or ( a mod 360 ) = 270 then
          prog$ = "error"
        else
          ab = tan( rad( a ) )
        end if
      case "datn"
        ab = degrees( atn( a ) )
      case "dasin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( asn( a ) )
        end if
      case "dacos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
        ab = degrees( acs( a ) )
        end if
      case "?"
        if a then
          ab = b
        else
          ab = c
        end if
      case "and"
        ab = a and b
      case "or"
        ab = a or b
      case "xor"
        ab = a xor b
      case "not"
        ab = not( a )
      case "<"
        if a < b then ab = true
      case "<="
        if a <= b then ab = true
      case ">"
        if a > b then ab = true
      case ">="
        if a >= b then ab = true
      case "<?<"
        if a > b and a < c then ab = true
      case "?<<?"
        if a < b or a > c then ab = true
      case "="
        if a = b then ab = true
      case "<>"
        if a <> b then ab = true
      case "~~"
        if abs( a - b ) < c then ab = true
      case else
        prog$ = "error"
    end select
    l$ = left$( prog$ , begin - 1 )
    r$ = mid$( prog$ , einde + 1, len( prog$ ) - einde + 1)
    prog$ = l$ + str$( ab ) + r$
  wend
  gprun$ = prog$
end function
function write$( hookmax )
''write a program whit the activated genes
  ''get a function gene for seed
  dice = int( rnd( 0 ) * genecount )
  while not( isGene( gene$( dice ) ) )
    dice = int( rnd( 0 ) * genecount )
  wend
  output$ = gene$( dice )
  while instr( output$, "#" ) <> 0 _
  and hook < hookmax
    p = instr( output$ , "#" )
    dice = int( rnd( 0 ) * genecount )
    l$ = left$( output$ , p - 1 )
    r$ = right$( output$ , len( output$ ) - p )
    output$ = l$ +" "+ gene$( dice ) + r$
    if isGene( gene$( dice ) ) then
      hook = hook + 1
    end if
  wend
  output$ = lastemptyplace$( output$ )
  if rnd(0) < growrate _
  or len( output$ ) < proglenmin then
    output$ = grow$( output$ )
  end if
  write$ = output$
end function
function lastemptyplace$( output$ )
''fill the last # whit number or variable
  while instr( output$, "#" ) <> 0
    p = instr( output$ , "#" )
    dice = int( rnd( 0 ) * genecount )
    while isGene( gene$( dice ) )
      dice = int( rnd( 0 ) * genecount )
    wend
    l$ = left$( output$ , p - 1 )
    r$ = right$( output$ , len( output$ ) - p )
    output$ = l$ +" "+ gene$( dice ) + r$
  wend
  lastemptyplace$ = output$
end function
function grow$( a$ )
''let the program grow in lenght
  count = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = " " then count = count + 1
  next i
  dice = int( rnd(0) * count + 1 )
  while not( isVariable( word$( a$ , dice ) ) ) _
  and not( isNumber( word$( a$ , dice ) ) )
    dice = int( rnd(0) * count + 1 )
  wend
  atom$ = word$( a$ , dice )
  dice2 = int( rnd(0) * genecount )
  while not( isGene( gene$( dice2 ) ) )
    dice2 = int( rnd(0) * genecount )
  wend
  gen$ = gene$( dice2 )
  output$ = ""
  for i = 1 to count
    if i = dice then
      output$ = output$ + gen$ + " "
    else
      output$ = output$ + word$( a$ , i ) + " "
    end if
  next i
  grow$ = lastemptyplace$( output$ )
end function
sub use gen$
''activate gen$ for use in writing and mutation
  gene$( genecount ) = gen$
  genecount = genecount + 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 = 1
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 = 2
end sub
function mix$( a$ , b$ )
''take a random part of a prog
''and put it a random place
''of another prog
  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
  count = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = " " then
    count = count + 1
    end if
  next i
  ''take a atom that isnt a hook or empty
  dice = int( rnd( 0 ) * count + 1 )
  while word$( a$ , dice ) = "[" _
  or    word$( a$ , dice ) = "]" _
  or    word$( a$ , dice ) = ""
    dice = int( rnd( 0 ) * count + 1 )
  wend
  atom$ = word$( a$ , dice )
  if isVariable( atom$ ) then
    if rnd(0) < .6 then
      atom$ = mid$( char$ _
      , int( rnd(0) * variableMax ) , 1 )
    else
      select case numberMode
        case 1
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpower ) ) )
        case 2
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpwer * 2 - numberpower ) ) )
        case else
          atom$ = mid$( char$ _
          , int( rnd(0) * ( variableMax - 1 ) + 1 ) _
          , 1 )
      end select
    end if
  else
    if isNumber( atom$ ) then
      select case numberMode
        case 1 ''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 variableMax > 0 then
        if rnd(0) < .4 then
          atom$ = mid$( char$ _
          , int( rnd(0) * ( variableMax - 1 ) + 1 ) _
          , 1 )
        end if
      end if
    else
      ''atom is a function
      q = 0
      while not( isGene( gene$( q ) ) )
        q = int( rnd( 0 ) * genecount )
      wend
      atom$ = word$( gene$( q ) , 2 )
    end if
  end if
  output$ = ""
  for i = 1 to count + 2
    if i = dice then
      output$ = output$ + atom$ + " "
    else
      output$ = output$ + word$( a$ , i ) + " "
    end if
  next i
  if rnd(0) < mutaterate _
  and len( output$ ) < proglenmax then
    output$ = grow$( output$ )
  end if
  mutate$ = output$
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 between$()
  between$ = "[ <?< # # # ]"
end function
function out$()
  out$ = "[ ?<<? # # # ]"
end function
function equal$()
  equal$ = "[ = # # # ]"
end function
function diff$()
  diff$ = "[ <> # # # ]"
end function
function aprox$()
  aprox$ = "[ ~~ # # # ]"
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: Genteties Programmeren

Berichtdoor bluatigro » zo okt 11, 2015 5:54 pm

update :
- met alles engels werkte t niet .
- nu weer wel
FOR ENGLISH VISETORS :
- i cant do it in total english
- i tryed and failed
- it is now a proof of consept
Code: Selecteer alles
dim gene$( 200 ) , prog$( 200 ) , fitness( 200 )
dim variable( 10 )
global genecount , numberMode , pi _
, true , false , inputMax , char$
global rndpower , proglenmax , proglenmin , growrate , mutaterate
global numberpower , parents
parents = 20
rndpower = 1
proglenmax = 200
proglenmin = 40
growrate = 0.5
mutaterate = 0.5
numberpower = 10
pi = atn( 1 ) * 4
true = not( false )
''i think 10 dimesions are enoug
char$ = "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$()
''call use big$()
''call use between$()
''call use out$()
''call use equal$()
''call use diff$()
''call use aprox$()

call test
input "[ push return ]" ; a$
''call inputsetings
call calculatePI
''input "[ push return ]" ; a$
''call calculateDistance
print "game over"

end
sub test
''test all the subs
  print "testing mix :"
  a$ = "[ + 1 [ - 2 3 4 ] 5 ]"
  b$ = "[ * 6 [ / 7 8 9 ] 10 ]"
  print "a = " ; a$
  print "b = " ; b$
  print "run a = " ; gprun$( a$ )
  print "run b = " ; gprun$( b$ )
  for i = 0 to 10
    c$ = mix$( a$  , b$ )
    print "mix a b = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing mutate :"
  call printoperators
  print "a = " ; a$
  for i = 0 to 10
    c$ = mutate$( a$ )
    print "mutate a = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing write :"
  call printoperators
  for i = 0 to 10
    c$ = write$( 6 )
    print "write 6 = " ; c$ ; " = " ; gprun$( c$ )
  next i
end sub
sub printoperators
''prints all the functions you activated
  print "operators = { " ;
  for i = 0 to genecount
    if isGene( gene$( i ) ) then
      print word$( gene$( i ) , 2 ) + " " ;
    end if
  next i
  print "}"
end sub
sub inputsetings
''lists all the settings
  notice chr$( 13 ) _
  + "setings :" + chr$( 13 ) _
  + "population = 200" + chr$( 13 ) _
  + "parents = " ; parents ; chr$( 13 ) _
  + "rnd power = " ; rndpower ; chr$( 13 ) _
  + "prog len max = " ; proglenmax ; chr$( 13 ) _
  + "prog len min = " ; proglenmin ; chr$( 13 ) _
  + "grow rate = " ; growrate ; chr$( 13 ) _
  + "mutate rate = " ; mutaterate ; chr$( 13 ) _
  + "number power = " ; numberpower ; chr$( 13 )
  confirm "Use setings ?" ; yn$
  if yn$ = "no" then
    in$ = str$( parents )
    prompt "parents [ 10 - 100 ]  = " ; in$
    parents = val( in$ )
    in$ = str$( rndpower )
    prompt "rnd paternt power [ > 1 ] = " ; in$
    rndpower = val( in$ )
    in$ = str$( proglenmax )
    prompt "prog len max [ < 800 ] = " ; in$
    proglenmax = val( in$ )
    in$ = str$( proglenmin )
    prompt "prog len min [ > 40 ] = " ; in$
    proglenmin = val( in$ )
    in$ = str$( growrate )
    prompt "grow rate [ .1 - .9 ] = " ; in$
    growrate = val( in$ )
    in$ = str$( mutaterate )
    prompt "mutate rate [ .1 - .9 ] = " ; in$
    mutaterate = val( in$ )
    in$ = str$( numberpower )
    prompt "number power [ 3 - 31 ] = " ; in$
    numberpower = val( in$ )
  end if
end sub
sub calculatePI
''example use
''try to get a pi function
  print "Trying to get a function for pi ."
  call printoperators
  input "[ push return ]" ; a$
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 4 )
  next i
  pi = atn( 1 ) * 4
  ''then loop thou generations
  for generation = 0 to 50
    ''generate fitnes of every program
    for i = 0 to 200
      ''get output of program
      q$ = gprun$( prog$( i ) )
      if q$ = "error" then
        fitness( i ) = 1e14
      else
        ''calculate fitness of program
        fitness( i ) = abs( pi - val( q$ ) )
      end if
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "     Error = " ; fitness( 0 )
  next generation
end sub
sub calculateDistance
''example use
''try to get a pytagoras function
  print "Trying to get a function for pytagoras ."
  call printoperators
  input "[ push return ]" ; a$
  ''create variable genes
  call setVariableMax 2 , 10
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 6 )
  next i
  ''generate generations
  for generation = 0 to 20
    ''calulate fitness for all programs
    for i = 0 to 200
      ''first we reset fitness for this programn
      fitness = 0
      ''loop trou some coordinates
      for x = -5 to 5
        for y = -5 to 5
          ''set variables for this point
          call setVariable 1 , x
          call setVariable 2 , y
          ''get output of this point
          uit$ = gprun$( prog$( i ) )
          if uit$ = "error" then
            uit = 1e10
          else
            uit = val( uit$ )
          end if
          ''calculate fitness of this point
          df = abs( uit - sqr( x ^ 2 + y ^ 2 ) )
          ''calculate total fitness of this program
          fitness = fitness + df ^ 2
        next y
      next x
      fitness( i ) = fitness
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "    Error = " ; fitness( 0 )
  next generation
end sub
sub evaluate
''evaluate al programs
  ''sort programs on fitnes
  for h = 1 to 200
    for l = 0 to h
      if fitness( l ) > fitness( h ) then
        a = fitness( h )
        fitness( h ) = fitness( l )
        fitness( l ) = a
        a$ = prog$( h )
        prog$( h ) = prog$( l )
        prog$( l ) = a$
      end if
    next l
  next h
  ''next generatoin : create childern
  for i = parents to 200
    a = int( rnd( 0 ) ^ rndpower * parents )
    b = int( rnd( 0 ) ^ rndpower * parents )
    prog$( i ) = mix$( prog$( a ) , prog$( b ) )
    ''mutate some childern
    if rmd( 0 ) < mutaterate then
      prog$( i ) = mutate$( prog$( i ) )
    end if
  next i
end sub
sub setVariableMax max , keer
''set the number of variables
  if max < 1 or max > len( char$ ) then exit sub
  variableMax = max
  for k = 1 to keer
    for i = 1 to max
      call use mid$( char$ , i , 1 )
    next i
  next k
end sub
sub setVariable no , x
''set a variable
  if no < 1 or no > inputMax then exit sub
  variable( no ) = x
end sub
function isNumber( x$ )
  isNumber = ( val( x$ ) <> 0 ) _
             or ( x$ = "0" )
end function
function isVariable( x$ )
  isVariable = ( len( x$ ) = 1 ) _
            and ( instr( char$ , x$ ) <> 0 )
end function
function isGene( x$ )
  isGene = ( left$( x$ , 1 ) = "[" )
end function
function gprun$( prog$ )
''eval function for lisp programs
''returns a double in as string if al is wel
''returns "error" if there is a iligal calculation
  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 isVariable( a$ ) then
      a = variable( instr( char$ , a$ ) )
    else
      if isNumber( a$ ) then
        a = val( a$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( b$ ) then
      b = variable( instr( char$ , b$ ) )
    else
      if isNumber( b$ ) then
        b = val( b$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( c$ ) then
      c = variable( instr( char$ , 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 "/"
        if abs( b ) < 1e-10 then
          prog$ = "error"
        else
          ab = a / b
        end if
      case "sqr"
        if a < 0 then
          prog$ = "error"
        else
          ab = sqr( a )
        end if
      case "mod"
        if b <> int( b ) or b = 0 then
          prog$ = "error"
        else
          ab = a mod b
        end if
      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 "^"
        if ( a <= 0 ) _
        or ( a <= 0 and b <= 0 ) then
          prog$ = "error"
        else
          ab = a ^ b
        end if
      case "ln"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( exp( 1 ) )
        end if
      case "log10"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( 10 )
        end if
      case "logX"
        if a <= 0 or b <= 0 or b = 1 then
          prog$ = "error"
        else
          ab = log( a ) / log( b )
        end if
      case "exp"
        if abs( a ) > 63 then
          prog$ = "error"
        else
          ab = exp( a )
        end if
      case "sin"
        ab = sin( a )
      case "cos"
        ab = cos( a )
      case "tan"
        ab = tan( a )
      case "atn"
        ab = atn( a )
      case "asin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = asn( a )
        end if
      case "acos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = acs( a )
        end if
      case "dsin"
        ab = sin( rad( a ) )
      case "dcos"
        ab = cos( rad( a ) )
      case "dtan"
        if ( a mod 360 ) = 90 _
        or ( a mod 360 ) = 270 then
          prog$ = "error"
        else
          ab = tan( rad( a ) )
        end if
      case "datn"
        ab = degrees( atn( a ) )
      case "dasin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( asn( a ) )
        end if
      case "dacos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
        ab = degrees( acs( a ) )
        end if
      case "?"
        if a then
          ab = b
        else
          ab = c
        end if
      case "and"
        ab = a and b
      case "or"
        ab = a or b
      case "xor"
        ab = a xor b
      case "not"
        ab = not( a )
      case "<"
        if a < b then ab = true
      case "<="
        if a <= b then ab = true
      case ">"
        if a > b then ab = true
      case ">="
        if a >= b then ab = true
      case "<?<"
        if a > b and a < c then ab = true
      case "?<<?"
        if a < b or a > c then ab = true
      case "="
        if a = b then ab = true
      case "<>"
        if a <> b then ab = true
      case "~~"
        if abs( a - b ) < c then ab = true
      case else
        prog$ = "error"
    end select
    l$ = left$( prog$ , begin - 1 )
    r$ = mid$( prog$ , einde + 1, len( prog$ ) - einde + 1)
    prog$ = l$ + str$( ab ) + r$
  wend
  gprun$ = prog$
end function
function write$( hookmax )
''write a program whit the activated genes
  ''get a function gene for seed
  dice = int( rnd( 0 ) * genecount )
  while not( isGene( gene$( dice ) ) )
    dice = int( rnd( 0 ) * genecount )
  wend
  uit$ = gene$( dice )
  while instr( uit$, "#" ) <> 0 _
  and hook < hookmax
    p = instr( uit$ , "#" )
    dice = int( rnd( 0 ) * genecount )
    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$ = lastemptyplace$( uit$ )
  if rnd(0) < growrate _
  or len( uit$ ) < proglenmin then
    uit$ = grow$( uit$ )
  end if
  write$ = uit$
end function
function lastemptyplace$( uit$ )
''fill the last # whit number or variable
  while instr( uit$, "#" ) <> 0
    p = instr( uit$ , "#" )
    dice = int( rnd( 0 ) * genecount )
    while isGene( gene$( dice ) )
      dice = int( rnd( 0 ) * genecount )
    wend
    l$ = left$( uit$ , p - 1 )
    r$ = right$( uit$ , len( uit$ ) - p )
    uit$ = l$ +" "+ gene$( dice ) + r$
  wend
  lastemptyplace$ = uit$
end function
function grow$( a$ )
''let the program grow in lenght
  count = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = " " then count = count + 1
  next i
  dice = int( rnd(0) * count + 1 )
  while not( isVariable( word$( a$ , dice ) ) ) _
  and not( isNumber( word$( a$ , dice ) ) )
    dice = int( rnd(0) * count + 1 )
  wend
  atom$ = word$( a$ , dice )
  dice2 = int( rnd(0) * genecount )
  while not( isGene( gene$( dice2 ) ) )
    dice2 = int( rnd(0) * genecount )
  wend
  gen$ = gene$( dice2 )
  uit$ = ""
  for i = 1 to count
    if i = dice then
      uit$ = uit$ + gen$ + " "
    else
      uit$ = uit$ + word$( a$ , i ) + " "
    end if
  next i
  grow$ = lastemptyplace$( uit$ )
end function
sub use gen$
''activate gen$ for use in writing and mutation
  gene$( genecount ) = gen$
  genecount = genecount + 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 = 1
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 = 2
end sub
function mix$( a$ , b$ )
''take a random part of a prog
''and put it a random place
''of another prog
  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
  count = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = " " then
    count = count + 1
    end if
  next i
  ''take a atom that isnt a hook or empty
  dice = int( rnd( 0 ) * count + 1 )
  while word$( a$ , dice ) = "[" _
  or    word$( a$ , dice ) = "]" _
  or    word$( a$ , dice ) = ""
    dice = int( rnd( 0 ) * count + 1 )
  wend
  atom$ = word$( a$ , dice )
  if isVariable( atom$ ) then
    if rnd(0) < .6 then
      atom$ = mid$( char$ _
      , int( rnd(0) * variableMax ) , 1 )
    else
      select case numberMode
        case 1
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpower ) ) )
        case 2
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpwer * 2 - numberpower ) ) )
        case else
          atom$ = mid$( char$ _
          , int( rnd(0) * ( variableMax - 1 ) + 1 ) _
          , 1 )
      end select
    end if
  else
    if isNumber( atom$ ) then
      select case numberMode
        case 1 ''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 variableMax > 0 then
        if rnd(0) < .4 then
          atom$ = mid$( char$ _
          , int( rnd(0) * ( variableMax - 1 ) + 1 ) _
          , 1 )
        end if
      end if
    else
      ''atom is a function
      q = 0
      while not( isGene( gene$( q ) ) )
        q = int( rnd( 0 ) * genecount )
      wend
      atom$ = word$( gene$( q ) , 2 )
    end if
  end if
  uit$ = ""
  for i = 1 to count + 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$ = grow$( 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 between$()
  between$ = "[ <?< # # # ]"
end function
function out$()
  out$ = "[ ?<<? # # # ]"
end function
function equal$()
  equal$ = "[ = # # # ]"
end function
function diff$()
  diff$ = "[ <> # # # ]"
end function
function aprox$()
  aprox$ = "[ ~~ # # # ]"
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: Genteties Programmeren

Berichtdoor bluatigro » ma apr 24, 2017 10:14 am

update :
now whit iif function
Code: Selecteer alles
dim gene$( 200 ) , prog$( 200 ) , fitness( 200 )
dim variable( 10 )
global genecount , numberMode , pi _
, true , false , inputMax , char$
global rndpower , proglenmax , proglenmin , growrate , mutaterate
global numberpower , parents
parents = 20
rndpower = 1
proglenmax = 200
proglenmin = 40
growrate = 0.5
mutaterate = 0.5
numberpower = 10
pi = atn( 1 ) * 4
true = not( false )
''i think 10 dimesions are enoug
char$ = "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$()
''call use big$()
''call use between$()
''call use out$()
''call use equal$()
''call use diff$()
''call use aprox$()

call test
input "[ push return to contitue ]" ; in$
call calculatePI
input "[ push return to continue ]" ; in$
call calculateDistance
print "[ game over ]"

end
sub test
''test all the subs
  print "testing run :"
  a$ = "[ + 1 [ - 2 3 4 ] 5 ]"
  b$ = "[ * 6 [ / 7 8 9 ] 10 ]"
  print "a = " ; a$
  print "b = " ; b$
  print "run a = " ; gprun$( a$ )
  print "run b = " ; gprun$( b$ )
  input "[ pres return to continue ]" ; in$
  print "a = " ; a$
  print "b = " ; b$
  for i = 0 to 10
    c$ = mix$( a$  , b$ )
    print "mix a b = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return to continue ]" ; in$
  print "testing mutate :"
  call printoperators
  print "a = " ; a$
  for i = 0 to 10
    c$ = mutate$( a$ )
    print "mutate c = " ; c$
    print "run c = " ; gprun$( c$ )
  next i
  input "[ push return to continue ]" ; in$
  print "testing write :"
  call printoperators
  for i = 0 to 10
    c$ = write$( 6 )
    print "write 6 = c = " ; c$
    print "run c = " ; gprun$( c$ )
  next i
end sub
sub printoperators
''prints all the functions you activated
  print "operators = { " ;
  for i = 0 to genecount
    if isGene( gene$( i ) ) then
      print word$( gene$( i ) , 2 ) + " " ;
    end if
  next i
  print "}"
end sub
sub calculatePI
''example use
''try to get a pi function
  print "Trying to get a function for pi ."
  call printoperators
  input "[ push return ]" ; a$
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 4 )
  next i
  pi = atn( 1 ) * 4
  ''then loop thou generations
  for generation = 0 to 50
    ''generate fitnes of every program
    for i = 0 to 200
      ''get output of program
      q$ = gprun$( prog$( i ) )
      if q$ = "error" then
        fitness( i ) = 1e14
      else
        ''calculate fitness of program
        fitness( i ) = abs( pi - val( q$ ) )
      end if
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "     Error = " ; fitness( 0 )
  next generation
end sub
sub calculateDistance
''example use
''try to get a pytagoras function
  print "Trying to get a function for pytagoras ."
  call printoperators
  input "[ push return ]" ; a$
  ''create variable genes
  call setVariableMax 2 , 10
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 6 )
  next i
  ''generate generations
  for generation = 0 to 20
    ''calulate fitness for all programs
    for i = 0 to 200
      ''first we reset fitness for this programn
      fitness = 0
      ''loop trou some coordinates
      for x = -5 to 5
        for y = -5 to 5
          ''set variables for this point
          call setVariable 1 , x
          call setVariable 2 , y
          ''get output of this point
          uit$ = gprun$( prog$( i ) )
          if uit$ = "error" then
            uit = 1e10
          else
            uit = val( uit$ )
          end if
          ''calculate fitness of this point
          df = abs( uit - sqr( x ^ 2 + y ^ 2 ) )
          ''calculate total fitness of this program
          fitness = fitness + df ^ 2
        next y
      next x
      fitness( i ) = fitness
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "    Error = " ; fitness( 0 )
  next generation
end sub
sub evaluate
''evaluate al programs
  ''sort programs on fitnes
  for h = 1 to 200
    for l = 0 to h
      if fitness( l ) > fitness( h ) then
        a = fitness( h )
        fitness( h ) = fitness( l )
        fitness( l ) = a
        a$ = prog$( h )
        prog$( h ) = prog$( l )
        prog$( l ) = a$
      end if
    next l
  next h
  ''next generatoin : create childern
  for i = parents to 200
    a = int( rnd( 0 ) ^ rndpower * parents )
    b = int( rnd( 0 ) ^ rndpower * parents )
    prog$( i ) = mix$( prog$( a ) , prog$( b ) )
    ''mutate some childern
    if rnd( 0 ) < mutaterate then
      prog$( i ) = mutate$( prog$( i ) )
    end if
  next i
end sub
sub setVariableMax maxi , keer
''set the number of variables
  if maxi < 1 or max > len( char$ ) then exit sub
  variableMax = maxi
  for k = 1 to keer
    for i = 1 to maxi
      call use mid$( char$ , i , 1 )
    next i
  next k
end sub
sub setVariable no , x
''set a variable
  if no < 1 or no > inputMax then exit sub
  variable( no ) = x
end sub
function isNumber( x$ )
  isNumber = ( val( x$ ) <> 0 ) _
             or ( x$ = "0" )
end function
function isVariable( x$ )
  isVariable = ( len( x$ ) = 1 ) _
            and ( instr( char$ , x$ ) <> 0 )
end function
function isGene( x$ )
  isGene = ( left$( x$ , 1 ) = "[" )
end function
function gprun$( prog$ )
''eval function for lisp programs
''returns a double in as string if al is wel
''returns "error" if there is a iligal calculation
  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 isVariable( a$ ) then
      a = variable( instr( char$ , a$ ) )
    else
      if isNumber( a$ ) then
        a = val( a$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( b$ ) then
      b = variable( instr( char$ , b$ ) )
    else
      if isNumber( b$ ) then
        b = val( b$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( c$ ) then
      c = variable( instr( char$ , 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 "/"
        if abs( b ) < 1e-10 then
          prog$ = "error"
        else
          ab = a / b
        end if
      case "sqr"
        if a < 0 then
          prog$ = "error"
        else
          ab = sqr( a )
        end if
      case "mod"
        if b <> int( b ) or b = 0 then
          prog$ = "error"
        else
          ab = a mod b
        end if
      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 "^"
        if ( a <= 0 ) _
        or ( a <= 0 and b <= 0 ) then
          prog$ = "error"
        else
          ab = a ^ b
        end if
      case "ln"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( exp( 1 ) )
        end if
      case "log10"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( 10 )
        end if
      case "logX"
        if a <= 0 or b <= 0 or b = 1 then
          prog$ = "error"
        else
          ab = log( a ) / log( b )
        end if
      case "exp"
        if abs( a ) > 63 then
          prog$ = "error"
        else
          ab = exp( a )
        end if
      case "sin"
        ab = sin( a )
      case "cos"
        ab = cos( a )
      case "tan"
        ab = tan( a )
      case "atn"
        ab = atn( a )
      case "asin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = asn( a )
        end if
      case "acos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = acs( a )
        end if
      case "dsin"
        ab = sin( rad( a ) )
      case "dcos"
        ab = cos( rad( a ) )
      case "dtan"
        if ( a mod 360 ) = 90 _
        or ( a mod 360 ) = 270 then
          prog$ = "error"
        else
          ab = tan( rad( a ) )
        end if
      case "datn"
        ab = degrees( atn( a ) )
      case "dasin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( asn( a ) )
        end if
      case "dacos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( acs( a ) )
        end if
      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 a < c , true , false )
      case "?<<?"
        ab = iif( a < b or a > c , true , false )
      case "="
        ab = iif( a = b , true , false )
      case "<>"
        ab = iif( a <> b , true , false )
      case "~~"
        ab = iif( abs( a - b ) < c , true , false )
      case else
        prog$ = "error"
    end select
    l$ = left$( prog$ , begin - 1 )
    r$ = mid$( prog$ , einde + 1, len( prog$ ) - einde + 1)
    prog$ = l$ + str$( ab ) + r$
  wend
  gprun$ = prog$
end function
function write$( hookmax )
''write a program whit the activated genes
  ''get a function gene for seed
  dice = int( rnd( 0 ) * genecount )
  while not( isGene( gene$( dice ) ) )
    dice = int( rnd( 0 ) * genecount )
  wend
  uit$ = gene$( dice )
  while instr( uit$, "#" ) <> 0 _
  and hook < hookmax
    p = instr( uit$ , "#" )
    dice = int( rnd( 0 ) * genecount )
    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$ = lastemptyplace$( uit$ )
  if rnd(0) < growrate _
  or len( uit$ ) < proglenmin then
    uit$ = grow$( uit$ )
  end if
  write$ = uit$
end function
function lastemptyplace$( uit$ )
''fill the last # whit number or variable
  while instr( uit$, "#" ) <> 0
    p = instr( uit$ , "#" )
    dice = int( rnd( 0 ) * genecount )
    while isGene( gene$( dice ) )
      dice = int( rnd( 0 ) * genecount )
    wend
    l$ = left$( uit$ , p - 1 )
    r$ = right$( uit$ , len( uit$ ) - p )
    uit$ = l$ +" "+ gene$( dice ) + r$
  wend
  lastemptyplace$ = uit$
end function
function grow$( a$ )
''let the program grow in lenght
  count = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = " " then count = count + 1
  next i
  dice = int( rnd(0) * count + 1 )
  while not( isVariable( word$( a$ , dice ) ) ) _
  and not( isNumber( word$( a$ , dice ) ) )
    dice = int( rnd(0) * count + 1 )
  wend
  atom$ = word$( a$ , dice )
  dice2 = int( rnd(0) * genecount )
  while not( isGene( gene$( dice2 ) ) )
    dice2 = int( rnd(0) * genecount )
  wend
  gen$ = gene$( dice2 )
  uit$ = ""
  for i = 1 to count
    if i = dice then
      uit$ = uit$ + gen$ + " "
    else
      uit$ = uit$ + word$( a$ , i ) + " "
    end if
  next i
  grow$ = lastemptyplace$( uit$ )
end function
sub use gen$
''activate gen$ for use in writing and mutation
  gene$( genecount ) = gen$
  genecount = genecount + 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 = 1
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 = 2
end sub
function mix$( a$ , b$ )
''take a random part of a prog
''and put it a random place
''of another prog
  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
  count = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = " " then
    count = count + 1
    end if
  next i
  ''take a atom that isnt a hook or empty
  dice = int( rnd( 0 ) * count + 1 )
  while word$( a$ , dice ) = "[" _
  or    word$( a$ , dice ) = "]" _
  or    word$( a$ , dice ) = ""
    dice = int( rnd( 0 ) * count + 1 )
  wend
  atom$ = word$( a$ , dice )
  if isVariable( atom$ ) then
    if rnd(0) < .6 then
      atom$ = mid$( char$ _
      , int( rnd(0) * variableMax ) , 1 )
    else
      select case numberMode
        case 1
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpower ) ) )
        case 2
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpwer * 2 - numberpower ) ) )
        case else
          atom$ = mid$( char$ _
          , int( rnd(0) * ( variableMax - 1 ) + 1 ) _
          , 1 )
      end select
    end if
  else
    if isNumber( atom$ ) then
      select case numberMode
        case 1 ''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 variableMax > 0 then
        if rnd(0) < .4 then
          atom$ = mid$( char$ _
          , int( rnd(0) * ( variableMax - 1 ) + 1 ) _
          , 1 )
        end if
      end if
    else
      ''atom is a function
      q = 0
      while not( isGene( gene$( q ) ) )
        q = int( rnd( 0 ) * genecount )
      wend
      atom$ = word$( gene$( q ) , 2 )
    end if
  end if
  uit$ = ""
  for i = 1 to count + 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$ = grow$( uit$ )
  end if
  mutate$ = uit$
end function
function iif( bool , t , f )
  uit = f
  if bool then uit = t
  iif = 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 between$()
  between$ = "[ <?< # # # ]"
end function
function out$()
  out$ = "[ ?<<? # # # ]"
end function
function equal$()
  equal$ = "[ = # # # ]"
end function
function diff$()
  diff$ = "[ <> # # # ]"
end function
function aprox$()
  aprox$ = "[ ~~ # # # ]"
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: Genteties Programmeren

Berichtdoor bluatigro » do apr 27, 2017 2:39 pm

update :
the "error' had extentions .
i removed that
more genes to choise from

i m not sure that i got al the catch i need in gprun()
please report them if you see them

Code: Selecteer alles
dim gene$( 200 ) , prog$( 200 ) , fitness( 200 )
dim variable( 10 )
global genecount , numberMode , pi , true , false , inputMax , char$
global rndpower , proglenmax , proglenmin , growrate , mutaterate
global numberpower , parents
parents = 20
rndpower = 1
proglenmax = 200
proglenmin = 40
growrate = 0.5
mutaterate = 0.5
numberpower = 10
pi = atn( 1 ) * 4
true = not( false )
''i think 10 dimesions are enoug
char$ = "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 smal1$()     ''<
''call use smal2$()     ''<=
''call use big1$()      ''>
''call use big2$()      ''>=
''call use between1$()  ''< <
''call use between2$()  ''<= <
''call use between3$()  ''< <=
''call use between4$()  ''<= <=
''call use out1$()      ''< <
''call use out2$()      ''<= <
''call use out3$()      ''< <=
''call use out4$()      ''<= <=
''call use equal$()
''call use diff$()
''call use aprox$()

call test
input "[ push return to contitue ]" ; in$
call calculatePI
input "[ push return to continue ]" ; in$
call calculateDistance
print "[ game over ]"

end
sub test
''test all the subs
  print "testing run :"
  a$ = "[ + 1 [ - 2 3 4 ] 5 ]"
  b$ = "[ * 6 [ / 7 8 9 ] 10 ]"
  print "a = " ; a$
  print "b = " ; b$
  print "run a = " ; gprun$( a$ )
  print "run b = " ; gprun$( b$ )
  input "[ push return to continue ]" ; in$
  print "testing mix :"
  print "a = " ; a$
  print "b = " ; b$
  for i = 0 to 7
    c$ = mix$( a$  , b$ )
    print "mix = " ; c$
    print "run = " ; gprun$( c$ )
  next i
  input "[ push return to continue ]" ; in$
  print "testing mutate :"
  call printoperators
  print "a = " ; a$
  for i = 0 to 7
    c$ = mutate$( a$ )
    print "mutate = " ; c$
    print "run = " ; gprun$( c$ )
  next i
  input "[ push return to continue ]" ; in$
  print "testing write :"
  call printoperators
  for i = 0 to 7
    c$ = write$( 6 )
    print "write = " ; c$
    print "run = " ; gprun$( c$ )
  next i
end sub
sub printoperators
''prints all the functions you activated
  print "operators = { " ;
  for i = 0 to genecount
    if isGene( gene$( i ) ) then
      print word$( gene$( i ) , 2 ) + " " ;
    end if
  next i
  print "}"
end sub
sub calculatePI
''example use
''try to get a pi function
  print "Trying to get a function for pi ."
  call printoperators
  input "[ push return to continue ]" ; a$
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 4 )
  next i
  pi = atn( 1 ) * 4
  ''then loop thou generations
  for generation = 0 to 50
    ''generate fitnes of every program
    for i = 0 to 200
      ''get output of program
      q$ = gprun$( prog$( i ) )
      if q$ = "error" then
        fitness( i ) = 1e14
      else
        ''calculate fitness of program
        fitness( i ) = abs( pi - val( q$ ) )
      end if
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "     Error = " ; fitness( 0 )
  next generation
end sub
sub calculateDistance
''example use
''try to get a pytagoras function
  print "Trying to get a function for pytagoras ."
  call printoperators
  input "[ push return to conitue ]" ; a$
  ''create variable genes
  call setVariableMax 2 , 10
  ''first write programs
  for i = 0 to 200
    prog$( i ) = write$( 6 )
  next i
  ''generate generations
  for generation = 0 to 20
    ''calulate fitness for all programs
    for i = 0 to 200
      ''first we reset fitness for this programn
      fitness = 0
      ''loop trou some coordinates
      for x = -5 to 5
        for y = -5 to 5
          ''set variables for this point
          call setVariable 1 , x
          call setVariable 2 , y
          ''get output of this point
          uit$ = gprun$( prog$( i ) )
          if uit$ = "error" then
            uit = 1e10
          else
            uit = val( uit$ )
          end if
          ''calculate fitness of this point
          df = abs( uit - sqr( x ^ 2 + y ^ 2 ) )
          ''calculate total fitness of this program
          fitness = fitness + df ^ 2
        next y
      next x
      fitness( i ) = fitness
    next i
    call evaluate
    print prog$( 0 )
    print "Generation = " ; generation _
    ; "    Error = " ; fitness( 0 )
  next generation
end sub
sub evaluate
''evaluate al programs
  ''sort programs on fitnes
  for h = 1 to 200
    for l = 0 to h
      if fitness( l ) > fitness( h ) then
        a = fitness( h )
        fitness( h ) = fitness( l )
        fitness( l ) = a
        a$ = prog$( h )
        prog$( h ) = prog$( l )
        prog$( l ) = a$
      end if
    next l
  next h
  ''next generatoin : create childern
  for i = parents to 200
    a = int( rnd( 0 ) ^ rndpower * parents )
    b = int( rnd( 0 ) ^ rndpower * parents )
    prog$( i ) = mix$( prog$( a ) , prog$( b ) )
    ''mutate some childern
    if rnd( 0 ) < mutaterate then
      prog$( i ) = mutate$( prog$( i ) )
    end if
  next i
end sub
sub setVariableMax maxi , keer
''set the number of variables
  if maxi < 1 or max > len( char$ ) then exit sub
  variableMax = maxi
  for k = 1 to keer
    for i = 1 to maxi
      call use mid$( char$ , i , 1 )
    next i
  next k
end sub
sub setVariable no , x
''set a variable
  if no < 1 or no > inputMax then exit sub
  variable( no ) = x
end sub
function isNumber( x$ )
  isNumber = ( val( x$ ) <> 0 ) _
             or ( x$ = "0" )
end function
function isVariable( x$ )
  isVariable = ( len( x$ ) = 1 ) _
            and ( instr( char$ , x$ ) <> 0 )
end function
function isGene( x$ )
  isGene = ( left$( x$ , 1 ) = "[" )
end function
function gprun$( prog$ )
''eval function for lisp programs
''returns a double in as string if al is wel
''returns "error" if there is a iligal calculation
  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 isVariable( a$ ) then
      a = variable( instr( char$ , a$ ) )
    else
      if isNumber( a$ ) then
        a = val( a$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( b$ ) then
      b = variable( instr( char$ , b$ ) )
    else
      if isNumber( b$ ) then
        b = val( b$ )
      else
        prog$ = "error"
      end if
    end if
    if isVariable( c$ ) then
      c = variable( instr( char$ , 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 "/"
        if abs( b ) < 1e-10 then
          prog$ = "error"
        else
          ab = a / b
        end if
      case "sqr"
        if a < 0 then
          prog$ = "error"
        else
          ab = sqr( a )
        end if
      case "mod"
        if b <> int( b ) or b = 0 then
          prog$ = "error"
        else
          ab = a mod b
        end if
      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 "^"
        if ( a <= 0 ) _
        or ( a <= 0 and b <= 0 ) then
          prog$ = "error"
        else
          ab = a ^ b
        end if
      case "ln"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( exp( 1 ) )
        end if
      case "log10"
        if a <= 0 then
          prog$ = "error"
        else
          ab = log( a ) / log( 10 )
        end if
      case "logX"
        if a <= 0 or b <= 0 or b = 1 then
          prog$ = "error"
        else
          ab = log( a ) / log( b )
        end if
      case "exp"
        if abs( a ) > 63 then
          prog$ = "error"
        else
          ab = exp( a )
        end if
      case "sin"
        ab = sin( a )
      case "cos"
        ab = cos( a )
      case "tan"
        ab = tan( a )
      case "atn"
        ab = atn( a )
      case "asin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = asn( a )
        end if
      case "acos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = acs( a )
        end if
      case "dsin"
        ab = sin( rad( a ) )
      case "dcos"
        ab = cos( rad( a ) )
      case "dtan"
        if ( a mod 360 ) = 90 _
        or ( a mod 360 ) = 270 then
          prog$ = "error"
        else
          ab = tan( rad( a ) )
        end if
      case "datn"
        ab = degrees( atn( a ) )
      case "dasin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( asn( a ) )
        end if
      case "dacos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( acs( a ) )
        end if
      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 a < c , true , false )
      case "<=?<"
        ab = iif( a >= b and a < c , true , false )
      case "<?<="
        ab = iif( a > b and a <= c , true , false )
      case "<=?<="
        ab = iif( a >= b and a <= c , true , false )       
      case "?<<?"
        ab = iif( a < b or a > c , true , false )
      case "?<=<?"
        ab = iif( a <= b or a > c , true , false )
      case "?<<=?"
        ab = iif( a < b or a >= c , true , false )
      case "?<=<=?"
        ab = iif( a <= b or a >= c , true , false )
      case "="
        ab = iif( a = b , true , false )
      case "<>"
        ab = iif( a <> b , true , false )
      case "~~"
        ab = iif( abs( a - b ) < c , 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$
end function
function write$( hookmax )
''write a program whit the activated genes
  ''get a function gene for seed
  dice = int( rnd( 0 ) * genecount )
  while not( isGene( gene$( dice ) ) )
    dice = int( rnd( 0 ) * genecount )
  wend
  uit$ = gene$( dice )
  while instr( uit$, "#" ) <> 0 _
  and hook < hookmax
    p = instr( uit$ , "#" )
    dice = int( rnd( 0 ) * genecount )
    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$ = lastemptyplace$( uit$ )
  if rnd(0) < growrate _
  or len( uit$ ) < proglenmin then
    uit$ = grow$( uit$ )
  end if
  write$ = uit$
end function
function lastemptyplace$( uit$ )
''fill the last # whit number or variable
  while instr( uit$, "#" ) <> 0
    p = instr( uit$ , "#" )
    dice = int( rnd( 0 ) * genecount )
    while isGene( gene$( dice ) )
      dice = int( rnd( 0 ) * genecount )
    wend
    l$ = left$( uit$ , p - 1 )
    r$ = right$( uit$ , len( uit$ ) - p )
    uit$ = l$ + " " + gene$( dice ) + r$
  wend
  lastemptyplace$ = uit$
end function
function grow$( a$ )
''let the program grow in lenght
  count = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = " " then count = count + 1
  next i
  dice = int( rnd(0) * count + 1 )
  while not( isVariable( word$( a$ , dice ) ) ) _
  and not( isNumber( word$( a$ , dice ) ) )
    dice = int( rnd(0) * count + 1 )
  wend
  atom$ = word$( a$ , dice )
  dice2 = int( rnd(0) * genecount )
  while not( isGene( gene$( dice2 ) ) )
    dice2 = int( rnd(0) * genecount )
  wend
  gen$ = gene$( dice2 )
  uit$ = ""
  for i = 1 to count
    if i = dice then
      uit$ = uit$ + gen$ + " "
    else
      uit$ = uit$ + word$( a$ , i ) + " "
    end if
  next i
  grow$ = lastemptyplace$( uit$ )
end function
sub use gen$
''activate gen$ for use in writing and mutation
  if genecount >= 200 then exit sub
  gene$( genecount ) = gen$
  genecount = genecount + 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 = 1
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 = 2
end sub
function mix$( a$ , b$ )
''take a random part of a prog
''and put it a random place
''of another prog
  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
  count = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = " " then
    count = count + 1
    end if
  next i
  ''take a atom that isnt a hook or empty
  dice = int( rnd( 0 ) * count + 1 )
  while word$( a$ , dice ) = "[" _
  or    word$( a$ , dice ) = "]" _
  or    word$( a$ , dice ) = ""
    dice = int( rnd( 0 ) * count + 1 )
  wend
  atom$ = word$( a$ , dice )
  if isVariable( atom$ ) then
    if rnd(0) < .6 then
      atom$ = mid$( char$ _
      , int( rnd(0) * variableMax ) , 1 )
    else
      select case numberMode
        case 1
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpower ) ) )
        case 2
          atom$ = str$( 2 _
          ^ ( int( rnd(0) * numberpwer * 2 - numberpower ) ) )
        case else
          atom$ = mid$( char$ _
          , int( rnd(0) * ( variableMax - 1 ) + 1 ) _
          , 1 )
      end select
    end if
  else
    if isNumber( atom$ ) then
      select case numberMode
        case 1 ''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 variableMax > 0 then
        if rnd(0) < .4 then
          atom$ = mid$( char$ _
          , int( rnd(0) * ( variableMax - 1 ) + 1 ) _
          , 1 )
        end if
      end if
    else
      ''atom is a function
      q = 0
      while not( isGene( gene$( q ) ) )
        q = int( rnd( 0 ) * genecount )
      wend
      atom$ = word$( gene$( q ) , 2 )
    end if
  end if
  uit$ = ""
  for i = 1 to count + 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$ = grow$( uit$ )
  end if
  mutate$ = uit$
end function
function iif( bool , t , f )
  uit = f
  if bool then uit = t
  iif = 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
''and dont forget the error catching

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 big1$()
  big1$ = "[ > # # # ]"
end function
function big2$()
  big2$ = "[ >= # # # ]"
end function
function between1$()
  between1$ = "[ <?< # # # ]"
end function
function between2$()
  between2$ = "[ <=?< # # # ]"
end function
function between3$()
  between3$ = "[ <?<= # # # ]"
end function
function between4$()
  between4$ = "[ <=?<= # # # ]"
end function
function out1$()
  out1$ = "[ ?<<? # # # ]"
end function
function out2$()
  out2$ = "[ ?<=<? # # # ]"
end function
function out3$()
  out3$ = "[ ?<<=? # # # ]"
end function
function out4$()
  out4$ = "[ ?<=<=? # # # ]"
end function
function equal$()
  equal$ = "[ = # # # ]"
end function
function diff$()
  diff$ = "[ <> # # # ]"
end function
function aprox$()
  aprox$ = "[ ~~ # # # ]"
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: Genteties Programmeren

Berichtdoor Bromide » vr apr 28, 2017 9:26 am

Ik ben ook al jaren geinteresseerd in Genetic Algorithms. Ik wilde zien wat jouw programma doet en zag een (voor mij) raar repeterende output. Ik heb de source aan mijn cross reference programma gegeven en zag in de output daarvan dat je 'numberpower' en 'numberpwer' gebruikt. Die laatste wordt eenmaal gebruikt en is dus nul want niet geinitialiseerd. Aanpassing geeft andere resultaten.
Laat effe horen of ik dit goed zie? En heb je een beschrijving van dit programma?
Bromide
 
Berichten: 3
Geregistreerd: do jan 16, 2014 12:16 pm

Re: Genteties Programmeren

Berichtdoor bluatigro » ma mei 01, 2017 2:15 pm

bedankt bromide :
ik ben slechtzient dus ik zie niet elke typfout die ik maak

heb je wat aan de beschrijving in de eerste post ?
stel anders een meer specivike vraag

dit is wel n genties algoritme maar dan specivik voor generen van functies
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: Genteties Programmeren

Berichtdoor bluatigro » di jul 25, 2017 10:40 am

update :"
ik denk dat ik nu alle "error"s vang
ik denk niet dat ik het nu foutloos heb
aub help bij t ondervangen van alle mogelijke "error"s
ze zitten in gprun$()
Code: Selecteer alles
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$()
''call use big$()
''call use between$()
''call use out$()
''call use equal$()
''call use diff$()

call test
input "[ push return to continue ]" ; a$
call calculatePI
input "[ push return to continue ]" ; a$
call calculateDistance
print "[ game over ]"

end
sub test
''test all the subs
  print "testing mix :"
  a$ = "[ + 1 [ - 2 3 4 ] 5 ]"
  b$ = "[ * 6 [ / 7 8 9 ] 10 ]"
  print "a = " ; a$
  print "b = " ; b$
  print "run a = " ; gprun$( a$ )
  print "run b = " ; gprun$( b$ )

  for i = 0 to 10
    c$ = mix$( a$  , b$ )
    print "mix a b = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing mutate :"
  call printoperators
  print "a = " ; a$
  for i = 0 to 10
    c$ = mutate$( a$ )
    print "mutate a = " ; c$ ; " = " ; gprun$( c$ )
  next i
  input "[ push return ]" ; i$
  print "testing write :"
  call printoperators
  for i = 0 to 10
    c$ = write$( 6 )
    print "write 6 = " ; c$ ; " = " ; gprun$( c$ )
  next i
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
''try to get a pi function
  ''then write programs
  for i = 0 to 200
    prog$( i ) = write$( 4 )
  next i
  pi = atn( 1 ) * 4
  ''then loop thou generations
  for generation = 0 to 20
    ''generate fitnes of every prog$
    for i = 0 to 200
      q$ = gprun$( prog$( i ) )
      if q$ = "error" then
        fout( i ) = 1e14
      else
        fout( i ) = abs( pi - val( q$ ) )
      end if
    next i
    call evaluate
  next generation
end sub
sub calculateDistance
  call setInputMax 2 , 10
  for i = 0 to 200
    prog$( i ) = write$( 6 )
  next i
  for generation = 0 to 20
    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 uit$ = "error" then
            uit = 1e10
          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
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
  ''print best program and its fit ness
    print prog$( 0 )
    print fout( 0 )
  ''get childern
  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
  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
  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 functions
''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"
  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 "/"
        if abs( b ) < 1e-300 then
          prog$ = "error"
        else
          ab = a / b
        end if
      case "sqr"
        if abs( a ) < 1e-300 then
          prog$ = "error"
        else
          ab = sqr( a )
        end if
      case "mod"
      if abs( b ) < 1e-300 then
        prog$ = "error"
      else
        ab = a mod b
      end if
      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 "^"
''this error migth not be corect
        if a < 1e-300 _
        or b < 1e-300 _
        or log(a)*log(b) > 300 then
          prog$ = "error"
        else
          ab = a ^ b
        end if
      case "ln"
        if a < 1e-300 then
          prog$ = "error"
        else
          ab = log( a ) / log( exp( 1 ) )
        end if
      case "log10"
        if a < 1e-300 then
          prog$ = "error"
        else
          ab = log( a ) / log( 10 )
        end if
      case "logX"
''this error migth not be correct
        if a < 1e-300 _
        or b < 1e-300 _
        or b - 1 < 1e-300 then
          prog$ = "error"
        else
          ab = log( a ) / log( b )
        end if
      case "exp"
''i dont know if 60 is the corect number
        if abs( a ) > 60 then
          prog$ = "error"
        else
          ab = exp( a )
        end if
      case "sin" : ab = sin( a )
      case "cos" : ab = cos( a )
      case "tan" : ab = tan( a )
      case "atn" : ab = atn( a )
      case "asin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = asn( a )
        end if
      case "acos" : ab = acs( a )
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = acs( a )
        end if
      case "dsin"
        ab = sin( rad( a ) )
      case "dcos"
        ab = cos( rad( a ) )
      case "dtan"
        if ( a mod 360 ) = 90 _
        or ( a mod 360 ) = 270 then
          prog$ = "error"
        else
          ab = tan( rad( a ) )
        end if
      case "datn"
        ab = degrees( atn( a ) )
      case "dasin"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( asn( a ) )
        end if
      case "dacos"
        if abs( a ) > 1 then
          prog$ = "error"
        else
          ab = degrees( acs( a ) )
        end if
      case "?"
        if a then
          ab = b
        else
          ab = c
        end if
      case "and" : ab = a and b
      case "or" : ab = a or b
      case "xor" : ab = a xor b
      case "not" : ab = not( a )
      case "<"
        if a < b then ab = true
      case "<="
        if a <= b then ab = true
      case ">"
        if a > b then ab = true
      case ">="
        if a >= b then ab = true
      case "<?<"
        if a > b and a < c then ab = true
      case "?<<?"
        if a < b or a > c then ab = true
      case "="
        if a = b then ab = true
      case "<>"
        if a <> b then ab = true
      case else
        prog$ = "error"
    end select
    l$ = left$( prog$ , begin - 1 )
    r$ = mid$( prog$ , einde + 1, len( prog$ ) - einde + 1)
    prog$ = l$ + str$( ab ) + r$
  wend
  gprun$ = prog$
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$ )
  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$ )
  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 prog
''and put it a random place
''of another prog
  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 between$()
  between$ = "[ <?< # # # ]"
end function
function out$()
  out$ = "[ ?<<? # # # ]"
end function
function equal$()
  equal$ = "[ = # # # ]"
end function
function diff$()
  diff$ = "[ <> # # # ]"
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm


Keer terug naar Liberty BASIC Code

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron