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]