[clean-list] MersenneTwister --- fixing the program

Philippos Apolinarius phi500ac at yahoo.ca
Mon Oct 19 04:34:11 MEST 2009


My previous program has quite a few bugs. I fixed them in the program below. However, both programs are very slow in Clean. As I told before, I believe that the problem lies in the Mersennetwister library. In order to see how slow it is, change the population size to something like 5000.


module gp;
import StdEnv, MersenneTwister, ArgEnv, StdTime;

:: Op = AND | OR | NOT;
:: Tree= L Int | T Op [Tree];
::TT :== [(Bool,Bool,Bool)];
::Stt= !{ psz::Int, beastSz::Int, seed::[Int], 
         thr::Real, fs::[Op]};
         
table= [(False, False, False),
            (True, False, True),
            (True, True, False),
            (False, True, True)];

Start w
  # (ct,w)= getCurrentTime w;
    seed= 1+ct.seconds+ct.minutes*60;
    xs= genRandInt seed;
    st = { psz=popsz,beastSz=5, seed= xs,  
           fs= [OR, AND, NOT], thr=4.0};
    (p, st) = gen0 population st;
    (gate, st)= evolve 30 p (L 0) st; 
  = gate;
where {
  popsz= 50;
  population :: .{!Tree};
  population = createArray popsz (L 0);
}
rn n st=:{seed}
 # [x:seed] = seed; 
 = ((abs x) rem n, {st&seed= seed});
rnLen (T _ s) st= rn (length s) st;

nGates (L i)= 0.0;
nGates (T p xs) = -0.1 + sum[nGates g \\ g <- xs];

run :: Tree {Bool} -> Bool;// Interpreter
run (L i) v= v.[i];
run (T AND xs) v = and [run c v \\ c <- xs];
run (T OR xs) v= or [run c v \\ c <- xs];
run (T NOT [t:_]) v= not (run t v);

mutate e (L i, st) = (e, st);
mutate e (t, st) = ins t (rnLen t st) where { 
  ins (T p [x:xs]) (n, st) | n > 0 
    # (T _ mt, st)= ins (T p xs) (n-1, st);
    = (T p [x:mt], st);
  ins (T p [L i:xs]) (0, st)=(T p[e:xs], st); 
  ins (T p [t:xs]) (0,st) 
    # (coin, st)= rn 2 st
    | coin==0 = (T p [e:xs], st);
    # (xpr, st)= mutate e (t, st);
    = (T p [xpr:xs], st); }

crossover e1 e2 st
    # (g1, st) = frag (e1, st);
      (g2, st) = frag (e2, st);
      (c1, st) = mutate g1 (e2, st);
      (c2, st) = mutate g2 (e1, st);
    = ([c2, c1], st) where{
  frag (L i, st) = (L i, st);
  frag (T p xs, st)
    # (n, st)= rnLen (T p xs) st;
      # xpr = xs!!n;
      # (coin, st)= rn 2 st;
    | coin== 0=  (xpr, st);
    = frag (xpr, st); }

rndXpr st=:{fs, beastSz}= loop beastSz st where {
  rth s st
  # (n, st) = rn (length s) st; 
  = (s!!n, st);
  fxy NOT st
  # (n, st)= rn 2 st;
  = (T NOT [L n], st);
  fxy AND st = (T AND [L 0, L 1], st);
  fxy OR  st = (T OR  [L 0, L 1], st);
  loop n st | n<1 
   # (fn, st)= rth fs st;
   # (f, st)= fxy fn st;
   = (f, st);
  loop n st
   # (f1, st) = loop (n-1) st;
   # (fn, st) = rth fs st; 
   # (e, st) = fxy fn st;
   = mutate e (f1, st); }

gen0 population st=:{psz, fs}= loop population 0 st where {
   loop p i st | i >= size p = (p, st);
   loop p i st
     # (g, ts)= rndXpr st;
     = loop {p&[i]=g}  (i+1) st;}

fitness gt= ng+1.0+sum[ft t \\ t <- table] 
where{ ng= nGates gt;
   ft (out, t1, t2) | run gt {t1, t2} == out= 1.0;
   ft _ = 0.0; }
      
evolve n p b st | n < 1 
  # (p, st)= gen0 p st;
  = evolve 30 p b st;
evolve n p b st=:{thr, fs, psz} 
  # (n1, st)= rn psz st;
    (n2, st)= rn psz st;
    (g1, p) = p![n1];
    (g2, p) = p![n2];
    ([c1, c2:_], st) = crossover g1 g2 st;
    p= insrt c1 p 0 psz;
    p= insrt c2 p 0 psz;
    (g, p)= best 0 b p;
    f= fitness g;
  | f>thr = (g, st);
  = evolve (n-1) p b st;
  
  best i res p | i >= size p= (res, p);
  best i fg1 p =:{[i]=fg}
    | (fitness fg) > (fitness fg1) = best (i+1) fg p;
    = best (i+1) fg1 p;
    
  insrt g v i sz | i >= sz = v;
  insrt g v=:{[i]=a} i sz 
    | (fitness g) > (fitness a) = {v&[i]=g};
    = insrt g v (i+1) sz;



      __________________________________________________________________
The new Internet Explorer® 8 - Faster, safer, easier.  Optimized for Yahoo!  Get it Now for Free! at http://downloads.yahoo.com/ca/internetexplorer/
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://mailman.science.ru.nl/pipermail/clean-list/attachments/20091018/a03f6452/attachment.html


More information about the clean-list mailing list