Genetic Algorithms

Written by Mats G. Bengtsson
National Defence Research Establishment
Box 1165, S-581 11 Linkoping
Sweden
email:  matben@lin.foa.se

This is intended to be a simple and pedagogical illustration of how genetic algorithms may be used for function optimization. The code is very slow so it is only intended for demos, not for production runs. For further info, see for instance the book by Goldberg.

A genetic algorithm consists essentially of three parts:
--   Selection; each string is selected with a probability proportional to its fitness value.
--   Crossover; in a pair of selected strings, sition along the string is chosen, and the right and left part of each     string is swapped.
--   Mutation; each gene is changed at random with a small probability.

Set up the problem

In our case we have chosen the conventional binary coding. Each individual is coded as a binary string with length stringLength. The problem is limited to 1D, and for x from 0 to 1.

stringLength = 10;
mutationRate = 0.002;
popSize = 50;  		(* must be a power of two *)

Create a random population. The population is defined on the real axis from 0 to 1. The random values are approximated with binary strings given the stringLength.

popFloats = Table[ Random[], {popSize} ];
popStrings = Map[ floatToBinary, popFloats ];

Define the fitness function. It must be defined in the interval 0 to 1. The first one is a simple one, while the second function is a little bit more difficult.

Clear[fitnessFunction];
fitnessFunction[x_] := Sin[ N[Pi] x ]

Clear[fitnessFunction];
fitnessFunction[x_] := Sin[N[Pi]x]*Mod[9x, 1]

Function definitions

Simple crossover

A random position is chosen along the strings. Create two new strings by swapping the parts before and after the cut respectively.

Clear[doSingleCrossover];
doSingleCrossover[ {string1_, string2_} ] := Module[{stle,cut,temp1,temp2},
	stle = Length[string1];
	cut = Random[Integer, {1,stle-1}];
	temp1 = Join[ Take[string1, cut],
		Drop[string2, cut] ];
	temp2 = Join[ Take[string2, cut],
		Drop[string1, cut] ];
	{temp1, temp2} ]

Mutations

Every gene may be excanged, from 0 to 1 and vice versa, with the probability mutationRate. The idea behind this is to introduce a mechanism for escaping from local minimas.

Clear[doMutation];
doMutation[string_] := Module[{tempstring,i},
	tempstring = string;
	Do[ If[ Random[] < mutationRate,
		tempstring[[i]] = 1 - tempstring[[i]] ],
		{i,stringLength} ];
	tempstring
]

Selection

Select two strings from the population, with a probability for each string proportional to its fitness value. Return only the two indices.

This computes the cumulative sum of the fitness values. It is necessary in the selection process.

Clear[doCumSumOfFitness];
doCumSumOfFitness := Module[{temp},
	temp = 0.0;
	Table[ temp += popFitness[[i]], {i, popSize} ]
]

Clear[doSingleSelection];
doSingleSelection := Module[{rfitness,ind},
	rfitness = Random[Real, {0, cumFitness[[popSize]]}];
	ind = 1;
	While[ rfitness > cumFitness[[ind]], ind++ ];
	ind--
]

This routine selects a pair of individuals with probability for each proportional to its fitness value.

Clear[selectPair];
selectPair := Module[{ind1,ind2},
	ind1 = doSingleSelection;
	While[ (ind2 = doSingleSelection) == ind1, ];
	{ind1, ind2}
]

This routine selects a pair at random with equal probability for each. This pair is removed from the population.

Clear[pickRandomPair];
pickRandomPair := Module[{ind1,ind2},
	ind1 = Random[Integer, {1, popSize}];
	While[ (ind2 = Random[Integer, {1, popSize}]) == ind1, ];
	{ind1, ind2}
]

Swap strings. Update both the string and its corresponding fitness value.

Clear[exchangeString];
exchangeString[ind_, newstring_, newF_] := Module[{},
	popStrings[[ind]] = newstring;
	popFitness[[ind]] = newF;
]

Miscellaneous functions

Clear[floatToBinary];
floatToBinary[x_] := Module[{temp},
	temp = RealDigits[ x, 2 ];
	Take[ Join[ 
		Table[0, {-temp[[2]]}], temp[[1]], Table[0, {stringLength}] ],
		stringLength ]
] /; x<1

Clear[binaryStringToFloat];
binaryStringToFloat[string_] :=
	N[Sum[ string[[i]]*2^(-i), {i, Length[string]} ]]

Scale the fitness values linearly so that  max = 2 min. This is a good idea to do because otherwise the genetic material tends to be dominated by very few nonidentical members. There is always a balance between concentrating the search on the best strings, and having a search in a broad spectrum.

Clear[renormalizeFitness];
renormalizeFitness[fitness_List] := Module[{minF,maxF,a,b},
	minF = Min[fitness];
	maxF = Max[fitness];
	a = 0.5*maxF/(maxF+minF);
	b = (1-a)*maxF;
	Map[ a# + b &, fitness ]
]

Initialize

This initializes everything except for the population itself.

Clear[doInitialize];
doInitialize := Module[{i},
	popFitness = Table[
		fitnessFunction[ binaryStringToFloat[ popStrings[[i]] ] ],
		{i,popSize} ];
	cumFitness = doCumSumOfFitness;
	listOfCumFitness = {cumFitness[[popSize]]};
	historyOfPop = { popStrings };
]

Main

Make a new generation; update asynchronously

There are actually two ways you can do it. The asynchronous mode corresponds to picking the parents, do crossover and mutation, and exchange the children with a randomly picked pair. This proceeds pair by pair.

Clear[updateGenerationAsync];

updateGenerationAsync := Module[{parents,children,childrenF,rm,i},
	Do[	parents = selectPair;
		children = doSingleCrossover[ {popStrings[[ parents[[1]] ]], 
			popStrings[[ parents[[2]] ]]} ];
		children = Map[ doMutation, children ]; 
		childrenF = fitnessFunction[ 
			Map[ binaryStringToFloat, children ] ];
		rm = pickRandomPair;
		Do[exchangeString[ rm[[i]], children[[i]], childrenF[[i]] ],
			{i,2} ];
		cumFitness = doCumSumOfFitness;
		AppendTo[ listOfCumFitness, cumFitness[[popSize]] ],
	{popSize/2} ];
];

Make a new generation; update synchronously

This represents the other way to do it. The complete parent population is chosen in a single sweep, and the children constitutes the new population.

Clear[updateGenerationSync];

updateGenerationSync := Module[{parentsid,children,ip},
	parentsid = {};
	Do[	AppendTo[ parentsid, selectPair ], {popSize/2} ];
	children = {};
	Do[ AppendTo[ children, 
			doSingleCrossover[ {popStrings[[parentsid[[ip,1]]]], 
			popStrings[[parentsid[[ip,2]]]]} ] ],
		{ip, popSize/2} ];
	popStrings = Flatten[ children, 1];
	popStrings = Map[ doMutation, popStrings ]; 
	popFitness = fitnessFunction[ 
		Map[ binaryStringToFloat, popStrings ] ];
	popFitness = renormalizeFitness[ popFitness ];
	cumFitness = doCumSumOfFitness;	
];

This is Main

doInitialize;

Do[	updateGenerationSync;
	AppendTo[ historyOfPop, popStrings ];
	AppendTo[ listOfCumFitness, cumFitness[[popSize]] ],
	{10} ];

Plot results

This is the sum of fitness for the whole population plotted versus generation number.

ListPlot[ listOfCumFitness, PlotJoined->True, PlotRange->All ];

fitnessplot = Plot[fitnessFunction[x], {x, 0, 1}, 
	Axes->True,
	DisplayFunction->Identity];

graphicsSingleGeneration[igen_] := Module[{graphelement,x},
	graphelement = {};
	Do[	x = binaryStringToFloat[ historyOfPop[[igen,i]] ];
		AppendTo[ graphelement, 
			Graphics[ Disk[{x,fitnessFunction[x]}, 0.015] ] ],
		{i, popSize} ];
	graphelement
]

Plot the start configuration.

Show[ fitnessplot, graphicsSingleGeneration[1], 
		PlotRange->{{0,1},{0,1.1}},
		DisplayFunction->$DisplayFunction ]

Plot the final configuration

Show[ fitnessplot, graphicsSingleGeneration[Length[ historyOfPop ]], 
		PlotRange->{{0,1},{0,1.1}},
		DisplayFunction->$DisplayFunction ]

Show the final genetic material.

TableForm[ popStrings ]

These cells are suitable for doing an animation of the evolution.

animationlist = {};
Do[
	AppendTo[ animationlist, graphicsSingleGeneration[igen] ],
	{igen, Length[ historyOfPop ]} ];

Table[
	Show[ fitnessplot, animationlist[[i]], 
		PlotRange->{{0,1},{0,1.1}},
		DisplayFunction->$DisplayFunction ],
	{i, Length[ historyOfPop ]} ];