1  
   2  -------------  Beginning of class  pga.ijs   -------------------
   3  coclass'pga'
   4  create=:3 : 0
   5  genes=: ? 4 $ 100  NB. 4 random integers 0-99
   6  )
   7  getgenes =: 3 : 'genes'
   8  setgenes =: 3 : 'genes=:y.'
   9  matewith=: 3 : 0
  10  other=. y.
  11  mine=. ((#genes) % 2) ? (#genes) NB. crossover
  12  childgene=. getgenes__other '' NB. copy others intially
  13  child=. conew 'pga'
  14  setgenes__child ((mine { genes) (mine }) childgene)
  15  child
  16  )
  17  perform =: 3 : 0 NB. dummy problem
  18  +/ genes
  19  )
  20  destroy=:codestroy
  21  -------------  End of of class  pga.ijs   ----------------------
  22  -------------  beginning of script ga.ijs ----------------------
  23  NB. genetic algorithm 
  24  NB. needs pga class
  25  NB. define a dummy target to measure fitness against
  26  targetvalue =:  500  
  27  fitness=: 3 : 0
  28  object=. y.
  29  1000 * %(targetvalue - perform__object '')
  30  )
  31  
  32  load jpath '~user\classes\pga.ijs'
  33  
  34  
  35  top =: 4 : '(i.y.) { \: (fitness each x.)'  NB. pop top 10 returns the 10 fittest
  36  
  37  pair=: 3 : 0  NB. pick two random ga objects, mate them, and return the child
  38  pop=. y.
  39  mom=. > (?#pop) { pop NB. must unbox!
  40  dad=. > (?#pop) { pop NB.  # is length of boxed list
  41  matewith__mom dad
  42  )
  43  
  44  NB.  pop evolve generations returns the fittest ga after 
  45  NB. sifting the top 25 ga's
  46  evolve=: 4 : 0
  47  pop=. x.
  48  n=. y.
  49  for_k. i.n do.
  50  kpop=.  3 : 'pop' NB. not sure if necessary to do here
  51  newgen=.  (pair@kpop) each i.100  NB. create 100 children
  52  best=.  (newgen top 25) { newgen NB. find the indices of the best, then select the corresponding objects
  53  pop=. best,best,best,best  NB. not really necessary?
  54  end.
  55  >0{best  NB. return best
  56  )
  57  NB. usage  
  58  load jpath '~user\ga.ijs'
  59  average =: +/%#
  60  pop=: conew&'pga' each i.100   NB. create 100 boxed ga objects
  61  fitness each pop  NB. should show a boxed list of fitness values
  62  average ; fitness each pop  NB. shows average fitness
  63  
  64  fred=: pop evolve 100
  65  fitness fred
  66  uberfred=: pop evolve 1000
  67  
  68  NB. the fitness values increase pretty slowly which is disappointing
  69  NB. probably needs some mutation :)
  70  -------------    end of script ga.ijs     ----------------------