Functional Programming and Intelligent Algorithms

Tutorial: Binary GA

Week 12: The binary GA

2 Tutorial: Binary GA

To get you started, we provide a step-by-step tutorial to the problem of implementing a binary GA for string learning.

The purpose of this GA is to discover, or learn, a target string. To learn the target string, the GA will contain a population of candidate solutions (chromosomes) that represent strings. Each chromosome is a guess and can be evaluated and assigned a cost, where the cost should relate to the difference between the string it represents and the target string.

The GA can then evolve the population over several generations until one or more of the individuals in the population become the target string. Such individuals will have a cost of zero.

Note that this example is adapted from (and is slightly easier than) the song learning example in Chapter 4 of Haupt & Haupt, where a GA is used to learn the song “Mary had a little lamb.”

We begin by creating a module BinaryGA.hs for our code:

1module BinaryGA where

2.1 GA settings

Before we proceed, it is useful to add some GA parameter settings to the top of our file so that they can easily be found and tweaked when we will test the GA later. We adopt the terminology used in class and in Haupt & Haupt and define the following parameters with some default settings:

1numPop = 40   :: Int    -- Population size (number of chromosomes) 
2xRate = 0.5   :: Double -- Selection rate 
3mutRate = 0.1 :: Double -- Mutation rate 
4numElite = 1  :: Int    -- Number of elite chromosomes 
5itMax = 1000  :: Int    -- Max number of iterations

2.2 Alphabet

The alphabet is the set of possible symbols, or characters, that can constitute a string. We store the alphabet as a string with 48 characters

1alphabet = ~abcdefghijklmnopqrstuvwxyz0123456789.,;:?!_+-*/ ~ :: String Please note that the final character ~~ in alphabet’ is the space character and must not be removed. We observe that to encode 48 characters, we need 6 bits, since 5 bits would only encode 25 = 32 characters, whereas 6 bits can encode 26 = 64 characters.

To avoid complications in the operations of our GA, we pad our alphabet with 16 more characters, e.g., we just add the letter ’a’ 16 times:

1alphabet = alphabet ++ ~aaaaaaaaaaaaaaaa~ :: String -- need 64 characters

2.3 Target strings

For testing and debugging purposes, we define a set of test strings:

1s1, s2, s3, s4, s5, s6 :: String 
2s1 = ~h~ 
3s2 = ~abc~ 
4s3 = ~hello world!~ 
5s4 = ~abc123.,;~ 
6s5 = ~descartes: cogito ergo sum~ 
7s6 = ~2+2 is: 4, 2*2 is: 4; why is _/not/_ 2.2*2.2 equal to 4.4?!~ 
8target = s2

2.4 Bits, genes, chromosomes, and the population

In the following, we will assume that a gene consists of a list of bits and encodes a single character, and that a chromosome is a list of genes that encodes a string.

For generality and to make our code compatible with other alphabets than the one given here, we should explicitly calculate the number of bits, numGene, required for each gene to encode all the characters in the alphabet. For this, we can used the log2 function that comes with the Numeric.SpecFunctions library:

1import Numeric.SpecFunctions (log2) -- may require cabal install math-functions Note that you may have to run cabal install math-functions to install this library.

Unfortunately, log2 rounds downwards (floor) whereas we require rounding upwards (ceiling)! Simply adding 1 to the result seems like an intuitive solution but would fail when the length of alphabet is exactly a power of 2 (that is, 2, 4, 8, 16, 32, 64, 128, etc.). For those cases, log2 would return the correct answer and adding 1 would be one too many.

One possible solution is to use the fact that log 2n = log 2(2n 1). We can then determine the required number of genes in our chromosomes like this:

1numGene = log2 $ 2*(length alphabet) - 1 :: Int If we load our module into ghci, we can verify that for the 64-character alphabet above, numGene = 6 bits.

Moreover, the number of characters in the target string is sometimes called the number of (encoding) variables, numVar:

1numVar = length target     :: Int    -- Number of characters (genes) in target This number tells us how many genes are required in each chromosome.

If we are interested in the total number of bits in a chromosome, numBits, we simply multiply the number of bits in each gene numGene with the total number of variables numVar:

1numBits = numGene * numVar :: Int    -- Number of bits required in chromosomes

Next, we need to know the number of chromosomes numKeep to keep between generations. This number is a fraction (the selection rate xRate) of the population size numPop and should be rounded up to the nearest even number to simplify the mating procedure:

1numKeep | numKeep’’ > numPop = numPop - numPop mod 2 
2        | numKeep’’ < 2 = 2 
3        | otherwise = numKeep’’ 
4        where numKeep’’ = numKeep + numKeep mod 2 
5              numKeep = ceiling $ xRate * fromIntegral numPop :: Int
For example, for numPop = 40 and xRate = 0.5, we get numKeep = 20. Some cases are introduced for safety to ensure numKeep is always greater than or equal to 2, and always smaller than or equal to numPop.

We also need to determine the number of chromosomes to mutate, numMut, which is a fraction (the mutation rate mutRate) of the population size, and must be rounded up to nearest integer:

1numMut = ceiling $ mutRate * fromIntegral numPop :: Int For numPop = 40 and mutRate = 0.1, we get numMut = 4.

Finally, we define some type aliases for readability and debugging purposes:

1type Bit = Int 
2type Gene = [Bit] 
3type Chromosome = [Gene] 
4type Population = [Chromosome]
First of all, note that we possibly could have used a binary type (e.g., true or false such as the type Bool, or a library such as BitString) for the Bit and Gene, however, this may have complicated other parts of our code.

Exercise: Experiment with different alphabets and different values for numPop, xRate, and mutRate and verify that numGene, numKeep, and numMut are calculated correctly by testing in the ghci.

2.5 Encoding functions

We need a function encodeString to encode a string as a Chromosome. This means that if we have another function encodeChar that can encode a single character as a Gene, we can just map that function over a string, which is a list of characters, in order to obtain the encoded Chromosome. In addition, it will likely prove useful to have a function encodeStringList that can encode a list of strings as a Population.

2.5.1 Encoding/decoding scheme

First, we need to decide on an encoding/decoding scheme to convert between characters in alphabet and binary and vice versa. One possible scheme is given in the Table 1.

binary decimal character
000000 0 a
000001 1 b
000010 2 c
101110 46 /
101111 47
110000 48 a
110001 49 a
111111 63 a

Table 1: Encoding/decoding scheme.
2.5.2 The encodeChar function

Let us begin with defining the encodechar function:

1encodeChar :: Char -> Gene 
2encodeChar = map digitToInt . encodeChar

Given a character c, the function should return a list of numGene = 6 bits, that is, a gene.

In the encoding/decoding scheme in Table 1, each character in alphabet is encoded as the binary number of length numGene that corresponds to its index (position in alphabet). Therefore, the letter ’a’ is at index 0 and is encoded as 000000, the letter ’b’ is at index 1 and is encoded as 000001, and so forth.

A convenient function to determine the index of an element in a list is elemIndex, which is part of the Data.List library:

1import Data.List (elemIndex)

Its type signature is given by elemIndex :: Eq a => a -> [a] -> Maybe Int. Therefore, we will need to “strip” the Just from the return value but for now, let us just assume that we have obtained an integer that corresponds to the index of a character in alphabet. This integer must then be converted to a 6-bit binary number. For this, we can use the printf function from the Text.Printf library:

1import Text.Printf (printf)

The hackage documentation for printf shows that we can use the flags %06b to format a decimal number as binary number of length 6 and padded with zeros if necessary to obtain the correct length. This binary number will be returned as a string. Putting it together, we then have a function encodeChar’ that can encode a character in alphabet as a binary string of length numGene = 6:

1encodeChar :: Char -> String 
2encodeChar c = printf ~%06b~ $ stripMaybe index 
3    where index = elemIndex c alphabet 
4          stripMaybe (Just index) = index 
5          stripMaybe (Nothing) = error $ ~elemIndex returned Nothing. ~ ++ 
6            ~A character is not in the alphabet!~
The function defines a helper function stripMaybe to remove the Just from the index.

We can test this function in the interpreter:

1*BinaryGA> encodeChar a 
3*BinaryGA> encodeChar b 
5*BinaryGA> encodeChar ’/’ 

The final thing to do is to convert binary strings like these to our Gene type. For this, we can use the digitToInt function readily available from the Data.Char library:

1import Data.Char (digitToInt) The digitToInt function converts a single digit Char to the corresponding Int. Thus, our encodeChar function becomes 1encodeChar :: Char ->  Gene 
2encodeChar = map digitToInt . encodeChar
Again, we should test the function in ghci: 1*BinaryGA> encodeChar a 
3*BinaryGA> encodeChar b 
5*BinaryGA> encodeChar ’/’ 

2.5.3 The encodeString function

It was hard work to define the encodeChar function above! Luckily, the hard work pays off when defining the encodeString function:

1encodeString :: String -> Chromosome 
2encodeString = map encodeChar
That’s it! We just map encodechar over a list of characters (a string) to obtain a list of encoded genes, or a Chromosome.

We can test the function in ghci:

1*BinaryGA> encodeString ~abc~ 
3*BinaryGA> encodeString ~*/ ~ 

2.5.4 The encodeStringList function

The encodeStringList function is just as simple:

1encodeStringList :: [String] -> Population 
2encodeStringList = map encodeString
The output in ghci for a list of two test strings yields 1*BinaryGA> encodeStringList [~ab~,~*/~] 

Exercise: What happens if one of the encoding functions above encounter a character not in alphabet?

2.6 Decoding functions

In addition to encoding functions, we also need decoding functions able to convert back from binary to characters in alphabet.

2.6.1 The bitsToInt function

Given a list of bits, we can first convert this to a decimal that corresponds to the index in alphabet, and then access the element in alphabet at that particular index. Thus, we first create a straightforward recursive bitsToInt function:

1bitsToInt :: [Int] -> Int 
2bitsToInt [] = 0 
3bitsToInt (b:bs) = 2^n*b + bitsToInt bs where n = length (b:bs) - 1

Example usage in ghci:

1*BinaryGA> bitsToInt [1,0,1] 
3*BinaryGA> bitsToInt [0,0,0,1,0,1] 

Exercise: Make sure you understand how bitsToInt works. If necessary, step through the recursive function steps on a piece of paper for some example binary numbers. What is the result of bitsToInt [1,2,3,4]?

2.6.2 The decodeGene function

Next, we define a decodeGene function that converts a Gene to an index (a decimal number) using (bitsToInt g) and then accesses the character at the index position in alphabet using the !! function:

1decodeGene :: Gene -> Char 
2decodeGene g = alphabet!!(bitsToInt g)

Example usage in ghci:

1*BinaryGA> decodeGene [0,0,0,0,0,0] 
3*BinaryGA> decodeGene [0,0,0,0,1,0] 
5*BinaryGA> decodeGene [0,0,1,0,1,0] 
7*BinaryGA> decodeGene [1,0,1,1,1,0] 

2.6.3 The decodeChromosome function

To decode a Chromosome, we just map the decodeGene function over it to obtain the corresponding string of characters:

1decodeChromosome :: Chromosome -> String 
2decodeChromosome c = map decodeGene c

Here is an example in ghci:

1*BinaryGA> let band = encodeString ~ac/dc~ 
2*BinaryGA> band 
4*BinaryGA> decodeChromosome band 

2.6.4 The decodePopulation function

It is also convenient to have a function able to decode an entire Population of chrosomoses to a list of decoded strings. For this, we just map the decodeChromosome function over the population list of chromosomes:

1decodePopulation :: Population -> [String] 
2decodePopulation pop = map decodeChromosome pop

Example functionality in ghci:

1*BinaryGA> let pop = encodeStringList [~ac/dc~,~heavy~,~rock!~] 
2*BinaryGA> pop 
4 [[0,0,0,1,1,1],[0,0,0,1,0,0],[0,0,0,0,0,0],[0,1,0,1,0,1],[0,1,1,0,0,0]], 
5 [[0,1,0,0,0,1],[0,0,1,1,1,0],[0,0,0,0,1,0],[0,0,1,0,1,0],[1,0,1,0,0,1]]] 
6*BinaryGA> decodePopulation pop 

2.7 Randomness functions

Randomness is vital for a GA, e.g., to create a random initial population, a random crossover point, a random mutation, and so on. We will use two functions from the System.Random library to implement the functions we need for randomness, namely StdGen and randomR:

1import System.Random (StdGen, randomR) It will be convenient to have functions for generating lists of random bits in order to construct random genes, chromosomes, and populations; and also for generating a random index (e.g., a crossover point) in a list.

Note that the reason we also return a StdGen in many or most of the functions dealing with randomness is so that we can repeatedly apply them, e.g., in a genetic evolution. In such cases, we need to pass on a StdGen for the next function calls.

2.7.1 The randBits function

The randBits function generates a list of random bits of length n:

1randBits :: Int -> StdGen -> ([Bit], StdGen) 
2randBits 0 g = ([], g) 
3randBits n g = 
4    let (value, g’) = randomR (0,1) g 
5        (restOfList, g’’) = randBits (n-1) g 
6    in  (value:restOfList, g’’)
It uses the randomR function to generate a random integer value in the closed interval [0, 1] and also returns a new PRNG g’. The new PRNG is then used in a recursive call to randBits that fills up a list of random Bit until is has length n.

2.7.2 The randGene function

The randGene function is just a special case of the randBits function that generates a list of random bits with the same length as the required for the genes, or n == numGene:

1randGene :: StdGen -> (Gene, StdGen) 
2randGene g = randBits numGene g

2.7.3 The randGenes function

The randGenes function uses the randGene function to generate a list of random genes with length n:

1randGenes :: Int -> StdGen -> ([Gene], StdGen) 
2randGenes 0 g = ([], g) 
3randGenes n g = 
4    let (value, g’) = randGene g 
5        (restOfList, g’’) = randGenes (n-1) g 
6    in  (value:restOfList, g’’)

2.7.4 The randChrom function

The randChrom function is just a special case of the randGenes function that generates a list of random genes with the required number of genes for a chromosome, or n == numVar:

1randChrom :: StdGen -> (Chromosome, StdGen) 
2randChrom g = randGenes numVar g

2.7.5 The randChroms function

The randChroms function uses the randChrom function to generate a list of random chromosomes with length n:

1randChroms :: Int -> StdGen -> (Population, StdGen) 
2randChroms 0 g = ([], g) 
3randChroms n g = 
4    let (value, g’) = randChrom g 
5        (restOfList, g’’) = randChroms (n-1) g 
6    in  (value:restOfList, g’’)

2.7.6 The randPop function

The randPop function is just a special case of the randChroms function that generates a list of random chromosomes with the required number of chromosomes for a population, or n == numPop:

1randPop :: StdGen -> (Population, StdGen) 
2randPop g = randChroms numPop g

2.7.7 The randIndex function

The randIndex function returns a random index of a list of length n in the closed interval [0,n 1]:

1randIndex :: StdGen -> [a] -> (Int, StdGen) 
2randIndex g xs = (ind, g’) 
3    where (ind, g’) = randomR (0, length xs - 1) g

2.8 Cost functions

Before we proceed with implementing the core of the GA, namely operations such as selection, mating, mutation, and evolution, we need functions to evaluate the cost of chromosomes.

2.8.1 The elemCost function

We begin with the elemCost function, which has the type signature elemCost :: (Eq a) => a -> a -> Int The function compares two elements or items of generic type a and returns a cost of zero if they are equal or a cost of one if they are unequal:

1elemCost a b | a == b = 0 
2             | otherwise = 1
We can then use elemCost together with zipWith to find the accumulated cost of two lists of elements, e.g., a gene or a string.

Some examples of usage in ghci include:

1*BinaryGA> elemCost 5 13 
3*BinaryGA> elemCost 5 5 
5*BinaryGA> elemCost a b 
7*BinaryGA> elemCost a c 
9*BinaryGA> elemCost a a 

2.8.2 The geneCost function

The geneCost function is implemented by zipping together to lists of bits (genes) with the elemCost function and summing the result:

1geneCost :: Gene -> Gene -> Int 
2geneCost g1 g2 = sum $ zipWith (elemCost) g1 g2

Example usage in ghci:

1*BinaryGA> let g1 = encodeChar a 
2*BinaryGA> g1 
4*BinaryGA> let g2 = encodeChar h 
5*BinaryGA> g2 
7*BinaryGA> geneCost g1 g2 

2.8.3 The stringCost and chromCost functions

The stringCost function compares two strings, character by character, and sums the number of unequal characters. Strictly speaking, it is not needed for the GA to work, but firstly, it demonstrates how we can use the generic elemCost function on different types of lists, and secondly, it may prove convenient, for example in a debugging phase.

The stringCost function is given by

1stringCost :: String -> String -> Int 
2stringCost s1 s2 = sum $ zipWith (elemCost) s1 s2

The chromCost function compares two chromosomes, gene by gene and bit by bit, and sums the total number of unequal bits. Again, we make use of zipWith, this time zipping with our ready-made geneCost function:

1chromCost :: Chromosome -> Chromosome -> Int 
2chromCost c1 c2 = sum $ zipWith (geneCost) c1 c2

Example usage in ghci:

1*BinaryGA> let s1 = ~ac/dc~ 
2*BinaryGA> let s2 = ~ac*ac~ 
3*BinaryGA> let c1 = encodeString s1 
4*BinaryGA> let c2 = encodeString s2 
5*BinaryGA> c1 
7*BinaryGA> c2 
9*BinaryGA> stringCost s1 s2 
11*BinaryGA> chromCost c1 c2 

2.8.4 The chromCostPair function

As we shall see later, it is convenient to store the evaluated cost of a chromosome together with the chromosome itself in a tuple. For example, if we have a population of such tuples, we can sort it in increasing order of cost (ranking), which is necessary for selection, where we typically want to select better chromosomes before worse ones.

We therefore define a new type

1type ChromCost = (Int, Chromosome) Next, we define a chromCostPair function to construct such tuples: 1chromCostPair :: Chromosome -> Chromosome -> ChromCost 
2chromCostPair target c = (chromCost target c, c)

Using the variables defined above, we can test the function in ghci:

1*BinaryGA> chromCostPair c1 c2 
The first part of the tuple is the cost of c2, that is, the number of bits that differ from the target chromosome c1. The second part of the tuple is c2 itself.

2.9 Population functions

We now turn our attention to some functions dealing with an entire population of chromosomes. The functions below are used to evaluate the cost of each chromosome in a population (evalPop); to sort a population in increasing order of cost (sortPop); to select chromosomes apart from elite chromosomes to keep for next generation and to use for mating (selection); get a list of chromosomes to be used as parents for mating (getParents); and to convert a list of (cost, chromosome) pairs, [ChromCost], to type Population.

2.9.1 The evalPop function

The evalPop function compares all of the chromosomes in a population with a target chromosome (corresponding to the target string) and returns list of ChromCost. This is accomplished by mapping the partial function chromCostPair target over the population. This is an example of partial function application, where we call a function with too few parameters and get back a partially applied function, that is, a function that takes as many parameters as we left out.

1evalPop :: Chromosome -> Population -> [ChromCost] 
2evalPop target pop = map (chromCostPair target) pop

Example usage in ghci:

1*BinaryGA> let targetString = ~ac/dc~ 
2*BinaryGA> let s1 = ~ac*ac~ 
3*BinaryGA> let s2 = ~hello~ 
4*BinaryGA> let s3 = ~a1234~ 
5*BinaryGA> let s4 = ~ac/ac~ 
6*BinaryGA> let target = encodeString targetString 
7*BinaryGA> let pop = encodeStringList [s1,s2,s3,s4] 
8*BinaryGA> let popEvaluated = evalPop target pop 
9*BinaryGA> popEvaluated 
11 (11,[[0,0,0,1,1,1],[0,0,0,1,0,0],[0,0,1,0,1,1],[0,0,1,0,1,1],[0,0,1,1,1,0]]), 
12 (13,[[0,0,0,0,0,0],[0,1,1,0,1,1],[0,1,1,1,0,0],[0,1,1,1,0,1],[0,1,1,1,1,0]]), 
13 (2,[[0,0,0,0,0,0],[0,0,0,0,1,0],[1,0,1,1,1,0],[0,0,0,0,0,0],[0,0,0,0,1,0]])]

2.9.2 The sortPop function

To sort a population, we can use the sort function from the Data.List library. We therefore add sort to our import statement:

1import Data.List (elemIndex, sort) The sortPop function is then implemented simply as 1sortPop :: [ChromCost] -> [ChromCost] 
2sortPop pop = sort pop
Note that this works because when given a list of tuples (ChromCost is a (cost, chromosome) pair, or tuple), sort sorts the list by the first element of the tuples, namely the cost.

Example usage in ghci using the evaluated population above:

1*BinaryGA> sortPop popEvaluated 
3 (4,[[0,0,0,0,0,0],[0,0,0,0,1,0],[1,0,1,1,0,1],[0,0,0,0,0,0],[0,0,0,0,1,0]]), 
4 (11,[[0,0,0,1,1,1],[0,0,0,1,0,0],[0,0,1,0,1,1],[0,0,1,0,1,1],[0,0,1,1,1,0]]), 
5 (13,[[0,0,0,0,0,0],[0,1,1,0,1,1],[0,1,1,1,0,0],[0,1,1,1,0,1],[0,1,1,1,1,0]])]

2.9.3 The selection function

In addition to numElite elite chromosomes, a number of other chromosomes must be kept in the population for the next generation and also serve the role as parents for mating. There are several ways to select such chromosomes, including roulette wheel selection, tournament selection, random selection, etc. Here, we just take a fraction xRate (called the selection rate) of a sorted (ranked) population. The total number of elite chromosomes plus selected chromosomes should equal numKeep. A possible implementation of a selection function is given below:

1selection :: [ChromCost] -> [ChromCost] 
2selection pop = take (numKeep - numElite) $ drop numElite pop

2.9.4 The getParents function

The getParents function returns the chromosomes to keep in the population for the next generation and to serve as parents. These chromosomes consists of the numElite best chromosomes in the population plus some chromosomes that are selected using the selection function above.

1getParents :: [ChromCost] -> [ChromCost] 
2getParents pop = (take numElite pop) ++ selection pop

2.9.5 The toPopulation function

For some of the genetic operations dealing with the population, it may be convenient not to have to handle a list of (cost, chromosome) pairs but just a list of chromosomes. We therefore define a function toPopulation to perform a conversion of a list of ChromCost to Population:

1toPopulation :: [ChromCost] -> Population 
2toPopulation [] = [] 
3toPopulation ((cost,chrom) : pop) = chrom : toPopulation pop

We can test the population functions in ghci. First, we set the GA parameters in the module that will affect the functions:

1numPop = 8    :: Int    -- Population size (number of chromosomes) 
2xRate = 0.5   :: Double -- Selection rate 
3numElite = 2  :: Int    -- Number of elite chromosomes
That is, we will play with a population of numPop == 8 chromosomes, keep numKeep == 4 chromosomes, of which numElite == 2 shall be elite chromosomes.

In ghci, we do the following:

1*BinaryGA> let stringList = [~aaa~,~aab~,~aac~,~aad~,~aae~,~aaf~,~aag~,~aah~] 
2*BinaryGA> let targetString = ~aah~ 
3*BinaryGA> let pop = encodeStringList stringList 
4*BinaryGA> let target = encodeString targetString 
5*BinaryGA> let sortedPop = sortPop $ evalPop target pop 
6*BinaryGA> let selectedChroms = selection sortedPop 
7*BinaryGA> selectedChroms 
9 (1,[[0,0,0,0,0,0],[0,0,0,0,0,0],[0,0,0,1,1,0]])]
That is, the selectedChroms are the third and fourth chromosome in the sorted population, because the selection function ignores the first numElite == 2 chromosomes and takes the next two chromosomes so that the total is equal to numKeep == 4. Next, we can use the getParents function to complete the selection process, leaving us with the top four chromosomes: 1*BinaryGA> let parents = getParents sortedPop 
2*BinaryGA> parents 
4 (1,[[0,0,0,0,0,0],[0,0,0,0,0,0],[0,0,0,0,1,1]]), 
5 (1,[[0,0,0,0,0,0],[0,0,0,0,0,0],[0,0,0,1,0,1]]), 
6 (1,[[0,0,0,0,0,0],[0,0,0,0,0,0],[0,0,0,1,1,0]])]
If we are curious which strings these chromosomes correspond to, we can use the function toPopulation to convert from a [ChromCost] list to a Population, and then decode the population: 1*BinaryGA> let parentsAsPop = toPopulation parents 
2*BinaryGA> decodePopulation parentsAsPop 

2.10 Mating functions

We are finally ready to begin implementing the core components of the GA, namely mating, mutation, and evolution. We begin with two function required for mating, the single point crossover function and the matePairwise function.

2.10.1 The crossover function

The function crossover is used for mating with single point crossover:

1crossover :: Int -> Chromosome -> Chromosome -> Population 
2crossover cp ma pa = [take cp ma ++ drop cp pa, take cp pa ++ drop cp ma]
Given a crossover point cp, a mother chromosome ma, and a father chromosome pa, it returns two offspring, where one consists of the genes in ma and pa before and after cp, respectively, and the other consists of the remaining genes from ma and pa.

Note that this implementation is probably not ideal, because it only deals with whole chunks of genes instead of bits. A better solution would be to allow for the crossover point cp to exist not only between genes but inside a gene too.

Example usage in ghci:

1*BinaryGA> let c1 = [[0,0,0,0,0,0,0],[1,1,1,1,1,1],[0,0,1,1,0,0],[0,1,0,1,0,1]] 
2*BinaryGA> let c2 = [[0,0,0,0,0,0,1],[0,0,0,0,1,0],[0,0,0,1,0,0],[0,0,1,0,0,0]] 
3*BinaryGA> crossover 0 c1 c2 
5 [[0,0,0,0,0,0,0],[1,1,1,1,1,1],[0,0,1,1,0,0],[0,1,0,1,0,1]]] 
6*BinaryGA> crossover 1 c1 c2 
8 [[0,0,0,0,0,0,1],[1,1,1,1,1,1],[0,0,1,1,0,0],[0,1,0,1,0,1]]] 
9*BinaryGA> crossover 2 c1 c2 
11 [[0,0,0,0,0,0,1],[0,0,0,0,1,0],[0,0,1,1,0,0],[0,1,0,1,0,1]]] 
12*BinaryGA> crossover 3 c1 c2 
14 [[0,0,0,0,0,0,1],[0,0,0,0,1,0],[0,0,0,1,0,0],[0,1,0,1,0,1]]] 
15*BinaryGA> crossover 4 c1 c2 
17 [[0,0,0,0,0,0,1],[0,0,0,0,1,0],[0,0,0,1,0,0],[0,0,1,0,0,0]]]
We observe that for cp == 0, we just clone the parents, as also happens for cp greater than 4. Otherwise, for cp equal to 1, 2, or 3, the offspring is created by a crossover point after gene number 1, 2, or 3, respectively.

2.10.2 The matePairwise function

There are many ways to choose which chromosomes should mate to create offspring, e.g., we could randomly draw a mother and a father chromosome from a subpopulation consisting of the numKeep best chromosomes in a population. Here, we simply use pairwise mating in a recursive function called matePairwise, where chromosomes 1 and 2 mate, chromosomes 3 and 4 mate, and so forth. The resulting offspring is returned as a Population together with a StdGen, both in a tuple. The function requires several standard PRNGs. For this, we add the split function that comes with the System.Random library in our import:

1import System.Random (StdGen, randomR, split, mkStdGen) The implementation of matePairwise is given below: 1matePairwise :: StdGen -> Population -> (Population, StdGen) 
2matePairwise g [] = ([], g) 
3matePairwise g [ma] = ([ma], g) 
4matePairwise g (ma:pa:cs) = (offspring ++ fst (matePairwise g cs), g’’) 
5    where (g’, g’’) = split g 
6          (g’’’, _) = split g’’ 
7          cp = fst $ randIndex g’’’ ma 
8          offspring = crossover cp ma pa
The two base cases say that an empty population should just return the empty list, and if the population only have a single chromosome, we should just clone it. The general case generates a random crossover point cp using the randIndex function and then calls the single point crossover function with cp and the first two chromosomes in the population to create two offspring. It then recursively repeats the process on the remainder of the population.

Example usage in ghci:

1*BinaryGA> let stringList = [~abc~,~def~,~ghj~,~klm~,~nop~,~qrs~,~tuv~,~wxy~] 
2*BinaryGA> let pop = encodeStringList stringList 
3*BinaryGA> pop 
5 [[0,0,0,0,1,1],[0,0,0,1,0,0],[0,0,0,1,0,1]], 
6 [[0,0,0,1,1,0],[0,0,0,1,1,1],[0,0,1,0,0,1]], 
7 [[0,0,1,0,1,0],[0,0,1,0,1,1],[0,0,1,1,0,0]], 
8 [[0,0,1,1,0,1],[0,0,1,1,1,0],[0,0,1,1,1,1]], 
9 [[0,1,0,0,0,0],[0,1,0,0,0,1],[0,1,0,0,1,0]], 
10 [[0,1,0,0,1,1],[0,1,0,1,0,0],[0,1,0,1,0,1]], 
11 [[0,1,0,1,1,0],[0,1,0,1,1,1],[0,1,1,0,0,0]]] 
12*BinaryGA> let (newPop, g’) = matePairwise (mkStdGen 99) pop 
13*BinaryGA> newPop 
15 [[0,0,0,0,1,1],[0,0,0,1,0,0],[0,0,0,0,1,0]], 
16 [[0,0,0,1,1,0],[0,0,1,0,1,1],[0,0,1,1,0,0]], 
17 [[0,0,1,0,1,0],[0,0,0,1,1,1],[0,0,1,0,0,1]], 
18 [[0,0,1,1,0,1],[0,1,0,0,0,1],[0,1,0,0,1,0]], 
19 [[0,1,0,0,0,0],[0,0,1,1,1,0],[0,0,1,1,1,1]], 
20 [[0,1,0,0,1,1],[0,1,0,1,0,0],[0,1,1,0,0,0]], 
21 [[0,1,0,1,1,0],[0,1,0,1,1,1],[0,1,0,1,0,1]]]
We observe that the crossover point for chromosomes 1 and 2 in pop was after the second gene; for chromosomes 3 and 4 it was after the first gene; for chromosomes 5 and 6 it was after the first gene; and for chromosomes 7 and 8 it was after the second gene.

2.11 Mutation functions

Mutation involves flipping a bit in a gene from zero to one or vice versa. The fraction (mutation rate) of chromosomes in the population that should mutate is called mutRate, and corresponds to the integer numMut. For example, for a population size of numPop == 100 and a mutation rate of mutRate == 0.1, the number of chromosomes to mutate would be numMut == 10.

The necessary mutation functions are given below.

2.11.1 The replaceAtIndex and flipBit functions

If we have a list of bits (such as a gene), we cannot just change (overwrite) one of the bits in that list, since data variables in a purely functional language like Haskell are immutable (they cannot change once defined). Instead, we must copy the data we need and put it together in a new data structure (such as a list). We therefore implement a helper function that can replace an item in a list at a particular index, namely the replaceAtIndex function below:

1replaceAtIndex :: Int -> a -> [a] -> [a] 
2replaceAtIndex n item ls = as ++ (item:bs) where (as, (b:bs)) = splitAt n ls
This function uses the splitAt function available in Prelude (so no need to import it) to split the list ls at the position n into two sublists as and (b:bs), where as are the first n elements in ls, and (b:bs) are the remainding elements. The element b is then replaced with item and the pieces are put together again using the ++ function.

Next, we implement a flipBit function that uses the replaceAtIndex function to flip a bit at an index n in a gene g:

1flipBit :: Int -> Gene -> Gene 
2flipBit n g = replaceAtIndex n b g 
3                where b | g!!n == 0 = 1 
4                        | otherwise = 0

Example usage in ghci:

1*BinaryGA> replaceAtIndex 5 99 [0,1,2,3,4,5,6,7,8,9] 
3*BinaryGA> let g = [1,1,0,1,1,1] 
4*BinaryGA> flipBit 2 g 

2.11.2 The mutateChrom function

The mutateChrom function mutates a randomly selected bit among its genes:

1mutateChrom :: StdGen -> Chromosome -> (Chromosome, StdGen) 
2mutateChrom g chrom = (mutChrom, g2’) 
3    where (g1, g2) = split g 
4          (nGene, g1’) = randIndex g1 chrom 
5          oldGene = chrom!!nGene 
6          (nBit, g2’) = randIndex g2 oldGene 
7          mutGene = flipBit nBit oldGene 
8          mutChrom = replaceAtIndex nGene mutGene chrom
The function looks slightly messy (feel free to improve it!), with several PRNGs that are spawned via the split function and the many where clauses. An index nGene is picked randomly and used to access the particular gene at that index in the chromosome chrom and assign it to oldGene. A random bit in oldGene at index nBit is then flipped and the mutated gene is assigned to mutGene. The mutated gene mutGene then replaces the original oldGene in chrom and is assigned to mutChrom and returned.

Example usage in ghci:

1*BinaryGA> let c = [[0,0,0,0,0,0],[1,1,1,1,1,1],[1,1,1,0,0,0],[0,0,0,1,1,1]] 
2*BinaryGA> let (mutatedChrom, g) =  mutateChrom (mkStdGen 99) c 
3*BinaryGA> mutatedChrom 
5*BinaryGA> let (mutatedChrom, g) =  mutateChrom (mkStdGen 98) c 
6*BinaryGA> mutatedChrom 
Using a PRNG obtained from mkdStdGen 99, the fifth bit of the fourth gene is mutated (flipped), whereas using a PRNG obtained from mkdStdGen 98, the last bit of the second gene is mutated.

2.11.3 The mutateChromInPop function

The function mutateChromInPop mutates a chromosome at index n in population pop:

1mutateChromInPop :: StdGen -> Int -> Population -> (Population, StdGen) 
2mutateChromInPop g n pop = (replaceAtIndex n mutChrom pop, g’) 
3    where (g’, g’’) = split g 
4          (mutChrom, _) = mutateChrom g’’ (pop!!n))

2.11.4 The mutatePop function

Finally, we need a function called mutatePop that given a list of indices, mutates all its chromosomes at those indices.

To randomly generate a list of indices, we create a function mutIndices:

1mutIndices :: Population -> StdGen -> [Int] 
2mutIndices pop g = take numMut $ randomRs (numElite, length pop - 1) g
The function makes use of the randomRs function from the System.Random library, hence we add it to our import statement: 1import System.Random (StdGen, randomR, randomRs, split, mkStdGen) The randomRs function produces an infinite list of random indices limited to lower and upper bounds given by it first argument. Here, the lower bound is numElite, because we do not want to mutate any of the elite chromosomes, and the upper bound is the index of the last chromosome in the population. Finally, we take only the first numMut indices from the infinite list.

Now that we have a a function to generate a list of random indices for the chromosomes that shall be mutated, we can implement a recursive mutatePop function:

1mutatePop :: StdGen -> [Int] -> Population -> (Population, StdGen) 
2mutatePop g _ [] = ([], g) 
3mutatePop g [] pop = (pop, g) 
4mutatePop g (n:ns) pop = mutatePop g ns pop 
5    where (pop’, g’) = mutateChromInPop g n p
The first base case says to do nothing if the population is empty or the list of indices is empty. Given a list (n:ns) of indices, the recursive case uses the mutateChromInPop function defined above to mutate the chromosome at index n in the population before it recursively continues with the remaining ns indices. A list of random indices can be provided by the mutIndices function.

Example usage in ghci:

1*BinaryGA> pop 
3 [[0,0,0,0,1,1],[0,0,0,1,0,0],[0,0,0,1,0,1]], 
4 [[0,0,0,1,1,0],[0,0,0,1,1,1],[0,0,1,0,0,1]], 
5 [[0,0,1,0,1,0],[0,0,1,0,1,1],[0,0,1,1,0,0]], 
6 [[0,0,1,1,0,1],[0,0,1,1,1,0],[0,0,1,1,1,1]], 
7 [[0,1,0,0,0,0],[0,1,0,0,0,1],[0,1,0,0,1,0]], 
8 [[0,1,0,0,1,1],[0,1,0,1,0,0],[0,1,0,1,0,1]], 
9 [[0,1,0,1,1,0],[0,1,0,1,1,1],[0,1,1,0,0,0]]] 
10*BinaryGA> numMut 
12*BinaryGA> let mutIdx = mutIndices pop (mkStdGen 99) 
13*BinaryGA> mutIdx 
15*BinaryGA> let (mutPop, g’) = mutatePop (mkStdGen 99) mutIdx pop 
16*BinaryGA> mutPop 
18 [[0,0,0,0,1,1],[0,0,0,1,0,0],[0,0,0,1,0,1]], 
19 [[0,0,0,1,1,0],[0,0,0,1,1,1],[0,0,1,0,0,1]], 
20 [[0,0,1,0,1,0],[0,0,0,0,1,1],[0,0,1,1,0,0]], 
21 [[0,0,1,1,0,1],[0,0,1,1,1,0],[0,0,1,1,1,1]], 
22 [[0,1,0,0,0,0],[0,1,0,1,0,1],[0,1,0,0,1,0]], 
23 [[0,0,0,0,1,1],[0,1,0,1,0,0],[0,1,0,1,0,1]], 
24 [[0,1,0,1,1,0],[1,1,0,1,1,1],[0,1,1,0,0,0]]]
Because numMut == 4, four random chromosomes in pop are mutated. The indices of these four chromosomes is determined by calling the mutIndices function, which returns mutIdx = [7,5,6,3]. By comparing the mutated population mutPop with the original population pop, we observe that for the chromosome at index 3, the third bit in the second gene was mutated; for the chromosome at index 5, the fourth bit in the second gene was mutated; for the chromosome at index 6, the second bit in the first gene was mutated; and for the chromosome at index 7, the first bit in the second gene was mutated.

2.12 Evolution functions

Our GA is almost finished but the most important step is left: evolution. We need two functions, evolvePopOnce and evolvePop, to complete the GA.

2.12.1 The evolvePopOnce function

The evolvePopOnce function evolves a population from one generation to the next:

1evolvePopOnce :: StdGen -> Population -> (Population, StdGen) 
2evolvePopOnce g pop = (newPopMutated, g4) 
3    where (g’, g’’) = split g 
4          ePop = evalPop (encodeString target) pop 
5          sPop = sortPop ePop 
6          parents = toPopulation $ getParents sPop 
7          (offspring, g3) = matePairwise g parents 
8          newPop = parents ++ offspring 
9          mutIdx = mutIndices newPop g3 
10          (newPopMutated, g4) = mutatePop g’’ mutIdx newPop
Its input is a population pop and the output is a new population newPopMutated that has been constructed through genetic operations. Each of the chromosomes in pop is evaluated with respect to the target string target and the evaluated chromosomes are stored in a list ePop. Since the chromosomes in ePop have an associated cost, they can be sorted into a new list sPop. Parents to be kept for the next generation and for generating offspring is selected using the getParents function and stored in parents. The function matePairwise then create offspring using single point crossover on the chromosomes in parents. The parents and the offspring collectively become the new population newPop. Finally, a number numMut of the chromosomes in newPop are mutated and the results is the next generation newPopMutated.

Here is an example usage in ghci for a target=s2 string, where s2="abc", and the following GA settings:

1numPop = 8    :: Int    -- Population size (number of chromosomes) 
2xRate = 0.5   :: Double -- Selection rate 
3mutRate = 0.5 :: Double -- Mutation rate 
4numElite = 2  :: Int    -- Number of elite chromosomes
1*BinaryGA> let stringList = [~xxx~,~def~,~ghj~,~klm~,~nop~,~qrs~,~tuv~,~wxy~] 
2*BinaryGA> let pop = encodeStringList stringList 
3*BinaryGA> let (popEvolvedOnce,g’) = evolvePopOnce (mkStdGen 99) pop 
4*BinaryGA> decodePopulation popEvolvedOnce 

2.12.2 The evolvePop function

Finally, we create the evolvePop function. This function evolves a population n times recursively, making use of the evolvePopOnce function just described.

1evolvePop :: StdGen -> Int -> Population -> (Population, StdGen) 
2evolvePop g 0 pop = (newpop, g) 
3    where newpop = toPopulation $ sortPop $ evalPop (encodeString target) pop 
4evolvePop g n pop = evolvePop g (n-1) newPop 
5    where (newPop, g’) = evolvePopOnce g pop

Example usage in ghci:

1*BinaryGA> let (popEvolvedNTimes,g’) = evolvePop (mkStdGen 99) 10 pop 
2*BinaryGA> decodePopulation popEvolvedNTimes 
4*BinaryGA> let (popEvolvedNTimes,g’) = evolvePop (mkStdGen 99) 20 pop 
5*BinaryGA> decodePopulation popEvolvedNTimes 
We observe that 10 generations was not sufficient to find (learn) the target string, whereas for 20 generations, the population evolved and the best chromosome was identical to the target, decoded as "abc".

2.13 Final remarks

Congratulations! You should now have a working GA contained in your BinaryGA module. Even if you are generous with comments and line shifts (as I am), your module should be less than 300 lines.

What remains is to test the GA. We will investigate this in the next section.

Last updated: 7th April 2017
Robin T. Bye /