SimpleGeneticAlgorithm implementation

Lex Spoon lex at cc.gatech.edu
Tue Apr 25 00:29:21 UTC 2000


Dean_Swan at Mitel.COM wrote:

>      Could you elaborate on this, please?  The "evaluationBlock" stuff is tricky
> because the "population" is stored in a 'Form' so I could use BitBlt to do the
> genetic operators.  The 'evaluationBlock' needs to take a chromosome, which is a
> one pixel high by "population width" Form extracted from the population.  It is
> made up of a number of "fields" of varying bit widths, which are concatenated to
> form the chromosome.  The evaluationBlock needs to parse these fields back out
> of the chromosome, so that it can reconstitute the numeric values of the various
> fields.  This is currently solved by the evaluationBlock sending
> 'fieldAt:width:' to the instance of SimpleGeneticAlgorithm, which returns an
> integer value that can then be scaled and offset appropriately.
> 

Okay, I took a crack at it.  The blocks can be removed without making
things messy.  In general, I divided up SimpleGeneticAlgorithm into 3-4
classes.  Here are the particulars:


	1. The chromosomes are now accessed via a ChromosomePool.  The
chromosomes are still stored in a form, but that detail is abstracted.

	2. There is a Chromosome class.  You can query the ChromosomePool for a
particular Chromosome, and you can put a chromosome back at a different index. 
Chromosomes can have their genes queried via #geneSlice:width:.  (This
is where the externally visible fieldAt:width: ended up).  The
combination of Chromosome and ChromosomePool meens that several methods
can get simpler--for example, swapChromosome:with: is now just a couple
of gets and a couple of sets, instead of 3 BitBlt operations.  #mutate:
and #crossOver:with: could also be updated similarly, although I didn't
get around to it.

	3. Finally, there is an Evaluator class, which compares two Chromosome
instances.  An ExampleEvaluator is provided which computes the example
from the class comment.  There is no access needed to the original SGA
instance; all that the evaluator needs to work is the relevant instance of
Chromosome.


I think this new design is a little better--there are more things
reperesented explicitly with classes and methods.  Changing the block to
a method didn't seem to hurt things, and the non-local features of blocks
turned out not to be needed.

By the way, this version is slower, but that's only because the
#fieldAt:width:put: method is now used.  I toyed with it about 15
minutes, to try and duplicate the trick in #fieldAt:width:, but
ultimately I gave up. :|  I'm sure someone who knows BitBlt better could
fix this right up and get performance back up.

The code is attached, for anyone who is curious.


-Lex



====
'From Squeak2.8alpha of 9 March 2000 [latest update: #1974] on 25 April 2000 at 12:08:57 am'!
Object subclass: #Chromosome
	instanceVariableNames: 'genes width '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SoftComputing'!
Object subclass: #ChromosomeEvaluator
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SoftComputing'!
Object subclass: #ChromosomePool
	instanceVariableNames: 'chromosomeMap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SoftComputing'!
ChromosomeEvaluator subclass: #ExampleChromosomeEvaluator
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SoftComputing'!
Object subclass: #SimpleGeneticAlgorithm
	instanceVariableNames: 'chromosomePool fitness mutationRate survivalRate evaluator '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SoftComputing'!

!Chromosome commentStamp: 'ls 4/24/2000 23:05' prior: 0!
A chromosome in a genetic algorithm.  It consists of a sequence of bits.!

!Chromosome methodsFor: 'initialization' stamp: 'ls 4/24/2000 23:06'!
genes: genes0  width: width0
	genes := genes0.
	width := width0.! !

!Chromosome methodsFor: 'access' stamp: 'ls 4/24/2000 23:17'!
geneSliceFrom: start width: sliceWidth
	"return a slice of the genes from index start to width"
	^(genes >> start) bitAnd: (1 << sliceWidth - 1)! !

!Chromosome methodsFor: 'access' stamp: 'ls 4/24/2000 23:35'!
genes
	"return all of the genes for this chromosome"
	^genes! !

!Chromosome methodsFor: 'access' stamp: 'ls 4/24/2000 23:35'!
width
	"return the number of significant bits in this chromosome"
	^width! !


!Chromosome class methodsFor: 'instance creation' stamp: 'ls 4/24/2000 23:06'!
genes: genes  width: width
	^super new genes: genes  width: width! !


!ChromosomeEvaluator commentStamp: 'ls 4/24/2000 23:22' prior: 0!
An evaluation function for chromosomes.!

!ChromosomeEvaluator reorganize!
('evaluating' evaluate:)
!


!ChromosomeEvaluator methodsFor: 'evaluating' stamp: 'ls 4/24/2000 23:25'!
evaluate: chromosome
	"return an evaluation of the given chromosome"
	^self subclassResponsibility! !


!ChromosomePool commentStamp: 'ls 4/24/2000 23:05' prior: 0!
A pool of chromosomes.  Instances are used by SimpleGeneticAlgorithm.  The chromoosmes are stored in a Form for efficiency.!

!ChromosomePool methodsFor: 'initialization' stamp: 'ls 4/24/2000 22:30'!
numChromosomes: numChromosomes  chromosomeWidth: chromosomeWidth
	chromosomeMap _ Form extent: (chromosomeWidth @ numChromosomes)! !

!ChromosomePool methodsFor: 'access' stamp: 'ls 4/24/2000 22:35'!
chromosomeMap
	"return the form used to store the chromosomes"
	^chromosomeMap! !

!ChromosomePool methodsFor: 'access' stamp: 'ls 4/24/2000 22:41'!
chromosomeWidth
	"return the width of each chromosome"
	^chromosomeMap width! !

!ChromosomePool methodsFor: 'access' stamp: 'ls 4/24/2000 22:47'!
fieldAt: pt width: w
	"return a portion of the underlying bitmap"
	| val pixPerWord blt |

	(w < 30)
		ifTrue:
			[
				pixPerWord _ 32.
				blt _ BitBlt destForm: (Form extent: pixPerWord at 1 depth: 1)
				 	sourceForm: chromosomeMap 
					halftoneForm: nil
					combinationRule: Form over
					destOrigin: (pixPerWord - w)@0
					sourceOrigin: pt
					extent: w at 1
					clipRect: (0 at 0 extent: pixPerWord at 1).
				blt destForm bits at: 1 put: 0.
				blt copyBits.
				val _ blt destForm bits at: 1.
			]
		ifFalse:
			[
				val _ 0.
				1 to: w do:
					[
						:n |
						val _ (val bitShift: 1) + (chromosomeMap  pixelValueAt: (pt + ((n - 1) @ 0))).
					].
			].
	^val.! !

!ChromosomePool methodsFor: 'access' stamp: 'ls 4/24/2000 23:32'!
fieldAt: pt width: w put: val
	| tmpVal |

	tmpVal _ val.

	w to: 1 by: -1 do:
		[
			:n |
			chromosomeMap pixelValueAt: (pt + ((n - 1) @ 0)) put: (tmpVal bitAnd: 1).
			tmpVal _ tmpVal bitShift: -1.
		].

	^val.! !

!ChromosomePool methodsFor: 'access' stamp: 'ls 4/24/2000 23:18'!
getChromosome: number
	"return the number'th chromosome"
	| genes |
	genes := self fieldAt: 0 at number width: self chromosomeWidth.
	^Chromosome genes: genes  width: self chromosomeWidth! !

!ChromosomePool methodsFor: 'access' stamp: 'ls 4/24/2000 22:48'!
numChromosomes
	^chromosomeMap height! !

!ChromosomePool methodsFor: 'access' stamp: 'ls 4/24/2000 23:36'!
putChromosome: chromosome at: index
	self fieldAt: (0 at index) width: chromosome width put: chromosome genes! !

!ChromosomePool methodsFor: 'GA transformations' stamp: 'ls 4/24/2000 22:58'!
crossOver: c1 with: c2 at: xPoint
	"cross the c1-th chromosome with the c2-th chromosome.  Use xPoint genes from the first chromosome, and (width - xPoint) genes from the second"
	| tempC |

	tempC _ chromosomeMap  copy: 
		(Rectangle origin: (0 @ c1) extent: (chromosomeMap width @ 1)).

	tempC 
		copy: (Rectangle origin: (xPoint @ 0) extent: ( chromosomeMap  width - xPoint) @ 1)
		from: (xPoint @ c2)
		in: chromosomeMap
		rule: Form over.

	^tempC
! !

!ChromosomePool methodsFor: 'GA transformations' stamp: 'ls 4/24/2000 23:34'!
swapChromosome: c1 with: c2
	"Exchange chromosome at row c1 with chromosome at row c2."
	| chrom1 chrom2 |

	chrom1 := self getChromosome: c1.
	chrom2 := self getChromosome: c2.

	self putChromosome: chrom1 at: c2.
	self putChromosome: chrom2 at: c1.
! !


!ChromosomePool class methodsFor: 'instance creation' stamp: 'ls 4/24/2000 22:30'!
numChromosomes: numChromosomes  chromosomeWidth: chromosomeWidth
	^self new numChromosomes: numChromosomes  chromosomeWidth: chromosomeWidth! !


!ExampleChromosomeEvaluator commentStamp: 'ls 4/24/2000 23:32' prior: 0!
An example evaluator, which computes the sum of two quadratic formulas.!

!ExampleChromosomeEvaluator methodsFor: 'evaluating' stamp: 'ls 4/24/2000 23:26'!
evaluate: chromosome
	| xv yv |
	xv _ (chromosome geneSliceFrom: 0 width: 8) - 100.
	yv _ (chromosome geneSliceFrom: 8 width: 8) - 237.
	xv _ 999999 - (xv * xv).
	yv _ 999999 - (yv * yv).
	^xv+yv.! !


!SimpleGeneticAlgorithm commentStamp: '<historical>' prior: 0!
This class implements John H. Holland's simple genetic algorithm.
Chromosomes are stored as bit vectors. The entire population of
chromosomes is stored in a Form in the instance variable 'chromosomes'.

The block assigned with 'SimpleGeneticAlgorithm>>evaluationBlock:'
must return a positive fitness value for the chromosome number passed
into the block.  You will get all kinds of ugly runtime errors if the
fitness value is not >= 0.  The rest of the class assumes that higher
fitness values mean that the chromosome is a "better" answer.

Fields can be extracted from a given chromosome, as positive integers
with the 'SimpleGeneticAlgorithm>>fieldAt:width:' message.  This means
that you need to devise a scheme to encode the optimisation parameters
into bit vectors, and concatenate the bit vectors to form a chromosome.

An example of the usage of this class is given below.  This example
will simultaneously find the maximum of two parabolas.  Admittedly,
this isn't a terribly complex example, but it should give an idea of how
this class can be used.

										-drs, 28 Jan. 2000


"
| s xv yv |

s _ SimpleGeneticAlgorithm new chromosomes: 100 chromosomeWidth: 16.

s evaluationBlock:
	[
		:c |
		xv _ (s fieldAt: (0 @ c) width: 8) - 100.
		yv _ (s fieldAt: (8 @ c) width: 8) - 237.
		xv _ 999999 - (xv * xv).
		yv _ 999999 - (yv * yv).
		xv+yv.
	].

s explore.
s evaluatePopulation.
1 to: 100 do:
	[
		:n |
		s chromosomes displayAt: 10 @ 10.
		s nextGeneration.
		xv _ s fieldAt: (0 @ (s bestChromosome)) width: 8.
		yv _ s fieldAt: (8 @ (s bestChromosome)) width: 8.
		n printString displayAt: (10 at 280).
		xv printString displayAt: (10 at 300).
		yv printString displayAt: (10 at 320).
	]
"!

!SimpleGeneticAlgorithm methodsFor: 'as yet unclassified' stamp: 'ls 4/24/2000 22:50'!
bestChromosome
	"Returns the chromosome index of the chromosome with the highest fitness."

	^(0 to: (chromosomePool numChromosomes) - 1)
		detectMax: [ :i |
			fitness at: i+1 ].
! !

!SimpleGeneticAlgorithm methodsFor: 'as yet unclassified' stamp: 'ls 4/24/2000 22:36'!
evaluateGenerations: genCount
	"Evaluate the specified number of generations."

	self evaluatePopulation.
	1 to: genCount do:
		[
			:g |
			self nextGeneration.
			g printString displayAt: 10 @ 10.
			self chromosomeMap displayAt: 10 @ 30.
		].! !

!SimpleGeneticAlgorithm methodsFor: 'as yet unclassified' stamp: 'ls 4/24/2000 23:27'!
evaluatePopulation
	"Evaluate each chromosome and update fitness array."

	0 to: ((chromosomePool chromosomeMap  height) - 1) do:
		[
			:y |
			fitness at: (y + 1) put:
				(evaluator evaluate: (chromosomePool getChromosome: y)).
			"self halt."
		]! !

!SimpleGeneticAlgorithm methodsFor: 'as yet unclassified' stamp: 'ls 4/24/2000 22:59'!
mateSurvivors
	"Combine survivors using single point crossover to produce offspring.
	Also apply mutation to offspring."

	| cCount sCount rCount parentA parentB offspring cLength |

	cCount _ chromosomePool numChromosomes.
	sCount _ (cCount * survivalRate) asInteger.
	rCount _ cCount - sCount.
	cLength _ chromosomePool chromosomeWidth.

	1 to: rCount do:
		[
			:r |
			parentA _ (0 to: (sCount - 1)) atRandom.
			parentB _ (0 to: (sCount - 1)) atRandom.
			offspring _ chromosomePool crossOver: parentA with: parentB at: ((0 to: (cLength - 1)) atRandom).

			offspring _ self mutate: offspring.
			chromosomePool chromosomeMap  copy: (Rectangle origin: (0 @ (sCount + r - 1)) extent: (chromosomePool chromosomeMap  width @ 1)) from: (0 @ 0) in: offspring rule: Form over.
		].
! !

!SimpleGeneticAlgorithm methodsFor: 'as yet unclassified' stamp: 'ls 4/24/2000 22:41'!
mutate: c
	"Randomly flip bits based on mutationRate."

	| cLength randNum mutation |

	randNum _ Random new.
	cLength _ chromosomePool chromosomeWidth.

	mutation _ c copy: (Rectangle origin: 0 at 0 extent: cLength @ 1).

	0 to: (cLength - 1) do:
		[
			:b |
			(randNum next < mutationRate) ifTrue:
				[
					"self halt."
					mutation pixelValueAt: (b @ 0) put: (1 - (mutation pixelValueAt: (b @ 0))).
				].
		].
	^mutation! !

!SimpleGeneticAlgorithm methodsFor: 'as yet unclassified' stamp: 'drs 3/20/2000 11:52'!
nextGeneration

	| sCount |

	self selectSurvivors.
	self mateSurvivors.
	self evaluatePopulation.
"
	sCount _ ((chromosomes height) * survivalRate) asInteger.
	sCount to: ((chromosomes height) - 1) do:
		[
			:y |
			fitness at: (y + 1) put:
				(evaluationBlock value: y).
		].
"
	^self.! !

!SimpleGeneticAlgorithm methodsFor: 'initialization' stamp: 'ls 4/24/2000 23:04'!
chromosomes: c chromosomeWidth: w
	"Initialize a new instance of SimpleGeneticAlgorithm"

	| mutation |

	survivalRate _ 0.5.
	chromosomePool _ ChromosomePool numChromosomes: c  chromosomeWidth: w.

	mutationRate _ 0.5.   "set to 50% during initialization"
	1 to: c do:
		[
			:n |
			mutation _ (chromosomePool chromosomeMap copy: (Rectangle origin: (0 @ n) extent: ((chromosomePool numChromosomes) @ 1))).
			mutation _ self mutate: mutation.
			chromosomePool chromosomeMap copy: (Rectangle origin: (0 @ n) extent: (chromosomePool chromosomeMap  width @ 1)) from: (0 @ 0) in: mutation rule: Form over.
		].
	mutationRate _ 0.001.



	fitness _ Array new: c.
	1 to: c do:
		[
			:n |
			fitness at: n put: 0.
		].

	^self.
! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'ls 4/24/2000 22:36'!
chromosomeMap
	^chromosomePool chromosomeMap! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'ls 4/24/2000 23:20'!
chromosomePool
	"return the associated pool of chromosomes"
	^chromosomePool! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'ls 4/24/2000 23:26'!
evaluator: anEvaluator
	"set the evaluator to be used in assessing chromosomes"
	evaluator := anEvaluator! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'ls 4/24/2000 22:37'!
fastFieldAt: pt width: w
	| val pixPerWord blt |

	(w < 30)
		ifTrue:
			[
				pixPerWord _ 32.
				blt _ BitBlt destForm: (Form extent: pixPerWord at 1 depth: 1)
				 	sourceForm: chromosomePool chromosomeMap 
					halftoneForm: nil
					combinationRule: Form over
					destOrigin: (pixPerWord - w)@0
					sourceOrigin: pt
					extent: w at 1
					clipRect: (0 at 0 extent: pixPerWord at 1).
				blt destForm bits at: 1 put: 0.
				blt copyBits.
				val _ blt destForm bits at: 1.
			]
		ifFalse:
			[
				val _ 0.
				1 to: w do:
					[
						:n |
						val _ (val bitShift: 1) + (chromosomePool chromosomeMap  pixelValueAt: (pt + ((n - 1) @ 0))).
					].
			].
	^val.! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'ls 4/24/2000 22:48'!
fieldAt: pt width: w
	^chromosomePool fieldAt: pt width: w! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'ls 4/24/2000 23:00'!
fieldAt: pt width: w put: val
	^chromosomePool fieldAt: pt width: w put: val! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'drs 1/28/2000 15:54'!
mutationRate
	^mutationRate! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'drs 1/28/2000 15:55'!
mutationRate: m
	mutationRate _ m.! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'ls 4/24/2000 22:37'!
selectSurvivors
	"Select survivors based on survivalRate, using Roulette Wheel algorithm."

	| cCount sCount fitSum survivor sRand randGen sSum |
	cCount _ chromosomePool chromosomeMap  height.
	sCount _ (cCount * survivalRate) asInteger.

	randGen _ Random new.

	fitSum _ 0.0.
	1 to: cCount do:
		[
			:c |
			fitSum _ fitSum + (fitness at: c)
		].

	fitSum printString displayAt: 50 @ 10.
	((fitness at: (self bestChromosome + 1)) printString) displayAt: 10 @ 300.


	self swapChromosome: 0 with: (self bestChromosome).
	1 to: (sCount - 1) do:
		[
			:s |
			sSum _ 0.

			"Only pick from chromosomes that are not already chosen to survive."
			survivor _ s.

			sRand _ 1.0e-20 + ((randGen next) * fitSum).
			[(sSum < sRand) and: [survivor < cCount]] whileTrue:
				[
					sSum _ sSum + (fitness at: (survivor + 1)).
					survivor _ survivor + 1.
				].
			self swapChromosome: (survivor - 1) with: s.

			"Only pick from chromosomes that are not already chosen to survive."
			fitSum _ fitSum - (fitness at: s).
		].! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'drs 1/28/2000 15:54'!
survivalRate
	^survivalRate! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'drs 1/28/2000 15:55'!
survivalRate: s
	survivalRate _ s.! !

!SimpleGeneticAlgorithm methodsFor: 'accessing' stamp: 'ls 4/24/2000 22:43'!
swapChromosome: c1 with: c2
	"Exchange chromosome at row c1 with chromosome at row c2."

	| tempC |

	tempC _ fitness at: (c1 + 1).
	fitness at: (c1 + 1) put: (fitness at: (c2 + 1)).
	fitness at: (c2 + 1) put: tempC.

	chromosomePool swapChromosome: c1 with: c2.

! !





More information about the Squeak-dev mailing list