[clean-list] Clean and Haskell: MersenneTwister

[Philippos Apolinarius]

Hi everybody.
I put my hands on a very interesting Genetic Programming system written in Scheme. I am not talking about Koza's Little GP.  I decided to translate it to Clean. My intention is to make it available to the Clean community soon. I cannot do it now because I got it  under a non-disclusure agrement before publication. As soon as the original authors publish the algorithm, I will release my Clean and Haskell versions. In the mean time, I am selecting the non-original parts of the algorithm, and posting them in various lists, in order to get suggestions for improvements. A Haskell programmer, who is helping me to improve my Haskell version, suggested that I should not pass a lazy list of random numbers to the state variable, since this makes Haskell very slow; I received the same suggestion from a Haskell list too. 

I modified the Haskell version accordingly, and it became 4 times faster, closing the gap between Haskell and Clean performance from 8 times slower to 2 times slower. However, I noticed that the same suggestion works for Clean too; if I substitute the Random library for the MersenneTwister library, Clean becomes 10 times faster, making the gap between Clean and Haskell even greater than before. The problem is that the Random library does not work so well as the MersenneTwister library, in the sense that the program fails to converge once in ten trials. Since the MersenneTwister library does not builds a lazy list of integers in Haskell, the Haskell program works fine all the time.

I tried to modify Clean MersenneTwister library in order to make it work as in Haskell. The result was disappointing: MersenneTwist doesn't even compile with my modifications (I am sure that it was sheer incompetence; no need to tell me that :-). Therefore, I wrote a downsized version of the program, where I replaced dummy algorithms for the original ones to prevent breaching of the non-disclosure agreement. I will appreciate if somebody could tell me how to modify the MersenneTwister library, in order to make it work like in Haskell. Here is the dummy program that uses the MersenneTwister library:

module gp;
import StdEnv, MersenneTwister, 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], tt::TT};

Start w
  #    (ct,w)= getCurrentTime w;
      seed= 1+ct.seconds+ct.minutes*60;
      xs= genRandInt seed;
    te= [(False, False, False),
            (True, False, True),
            (True, True, False),
            (False, True, True)];
    st = { psz=1000,beastSz=6, seed= xs,
           fs= [OR, AND, NOT], thr=4.0, tt=te};
    (p, st) = gen0 st;
    (gate, st)= evolve 30 p st;
  = gate;

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 p 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 st=:{psz, fs, tt}= loop population 0 st where {
   population :: .{(Real, Tree)};
   population = createArray psz (0.0, L 0);
   loop p i st | i >= size p = (p, st);
   loop p i st
     # (g, ts)= rndXpr st;
     # f = fitness g fs tt;
     = loop {p&[i]=(f, g)}  (i+1) st;}

fitness gt fs tt = ng+1.0+sum[ft t \\ t <- tt]
where{ ng= nGates gt;
   ft (out, t1, t2) | run gt {t1, t2} == out= 1.0;
   ft _ = 0.0; }

evolve n p st | n < 1
  # (p, st)= gen0 st;
  = evolve 30 p st;
evolve n p st=:{thr, fs, tt, 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;
    (f1, f2)= (fitness c1 fs tt, fitness c2 fs tt);
    (f1, f2)= (3.0, 4.0);
    p= insrt (f1, c1) p 0 psz;
    p= insrt (f2, c2) p 0 psz;
    ((f, g), p)= best 0 (0.0, L 0) p;
  | f>thr = (g, st);
  = evolve (n-1) p st where {
  best i res p | i >= size p= (res, p);
  best i fg1 p =:{[i]=fg}
    | (fst fg) > (fst fg1) = best (i+1) fg p;
    = best (i+1) fg1 p;}
  insrt g v i sz | i >= sz = v;
  insrt (f, g) v=:{[i]=fe} i sz
    | (fst fe) < f = {v&[i]= (f, g)};
    = insrt fe v (i+1) sz;
    
 



      __________________________________________________________________
Looking for the perfect gift? Give the gift of Flickr! 

http://www.flickr.com/gift/
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://mailman.science.ru.nl/pipermail/clean-list/attachments/20091017/6a5e3120/attachment.html