A year ago, I mentioned that I always write a cGA implementation when I learn a new language. Then, I was trying to get back to fluent in Haskell. A couple of days ago, Martin Pelikan just did the same and wanted to compare implementations. So, what did I do? I looked for my implementation to post it here.
I took a look at the code and change a couple of things, but I can say that the Haskell implementation is the shortest working implementation that I have ever written in any language. It is shorter than the versions I wrote in Scala and Erlang. Python could get awkwardly compressed using some functional flavor to get close to this, but dynamic typing… C, C++, Java, Go and other friends, are far away when you look in the rear Haskell mirror. Anyway, the code below implements cGA for binary strings. You chose the population size, the number of bits, and the evaluation function. Also, some of the constructs are simple and elegant that do not need much explanation (not to mention maintainability…)
import Data.List.Split import System.Random diffBinaryIndividuals popSize ind1 ind2 = map (\ (x, y) -> if x == y then 0 else (2 * x - 1) / popSize) $ zip ind1 ind2 updateBinaryModel f popSize model ind1 ind2 = zipWith (+) model update where f1 = f ind1 f2 = f ind2 update = if f1 > f2 then diffBinaryIndividuals popSize ind1 ind2 else diffBinaryIndividuals popSize ind2 ind1 sampleTwoBinaryIndividuals model gen = chunksOf l $ zipWith (\ m r -> if r < m then 1 else 0) (model ++ model) rnds where rnds = take (2 * l) (randoms gen :: [Float]) l = length model cgaStepForBinaryIndividuals f model popSize gen = updateBinaryModel f popSize model ind1 ind2 where ind1 : ind2 : [] = sampleTwoBinaryIndividuals model gen hasModelConverged model = all (\x -> x > 0.9 || x < 0.1) model cga _ _ model | hasModelConverged model = return model cga f popSize model = do gen <- newStdGen res <- (cga f popSize (cgaStepForBinaryIndividuals f model popSize gen)) return res
And you can see it in action below solving 5-bit and 50-bit OneMax problems.
> cga (sum) 1000 (take 5 $ repeat 0.5) [0.90099484,0.9029948,0.9029948,0.9019948,0.9209946] > cga (sum) 1000 (take 50 $ repeat 0.5) [0.9209946,0.9279945,0.96899396,0.96899396,0.95399415,0.9259945,0.9419943,0.96299404,0.9589941,0.9419943,0.93799436,0.9519942,0.9109947,0.94599426,0.95399415,0.9449943,0.94799423,0.964994,0.9199946,0.93199444,0.9429943,0.9569941,0.95499414,0.96999395,0.9369944,0.9579941,0.96199405,0.9429943,0.96099406,0.9359944,0.967994,0.9209946,0.9449943,0.966994,0.9329944,0.95499414,0.96999395,0.9449943,0.90799475,0.9579941,0.95299417,0.93999434,0.94699425,0.9179946,0.9559941,0.90099484,0.9359944,0.9339944,0.9339944,0.9359944]
Xavier on Google+