Yet Another cGA Implementation, Now in Haskell.

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

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]