MastermindPopulation: IPopulation implementation
This is a breeding population of answers from which we are trying to find the mastermind solution.
'\\ --[MastermindGuessPopulation]-----------------
'\\ Represents the IPopulation implementation
'\\ that represents a the current guess
'\\ population of a game of mastermind in
'\\ progress...
'\\ ----------------------------------------------
Public Class MastermindGuessPopulation
Inherits IPopulation
#Region "Private properties"
Private _Genomes As New MastermindGenomeCollection()
#End Region
#Region "Public constructors"
Public Sub New(ByVal PopulationSize As Integer, _
ByVal NumberOfPegholes As Integer)
Dim nItem As Integer
If PopulationSize <= 5 Then
Throw New ArgumentException("There must be at least 5 _
mastermind genomes in the _
population", "PopulationSize")
ElseIf PopulationSize > 1000 Then
Throw New ArgumentException("There must be at most 1000 _
mastermind genomes in the _
population", "PopulationSize")
Else
For nItem = 1 To PopulationSize
_Genomes.Add(New MastermindGenome(NumberOfPegholes))
Next
End If
End Sub
Public Sub New()
End Sub
#End Region
#Region "Public properties"
Default Public ReadOnly Property Item(ByVal index As Integer) _
As MastermindGenome
Get
Return _Genomes.Item(index)
End Get
End Property
Public ReadOnly Property PopulationSize() As Integer
Get
Return _Genomes.Count
End Get
End Property
Public Function AddGenome(ByVal Genome As MastermindGenome)
_Genomes.Add(Genome)
End Function
Public Sub Kill(ByVal index As Integer)
_Genomes.RemoveAt(index)
End Sub
#End Region
#Region "MastermindGenomeCollection"
'\\ --[MastermindGeneCollection]--------------
'\\ A strongly typed collection of mastermind
'\\ genomes
'\\ ------------------------------------------
Private Class MastermindGenomeCollection
Inherits CollectionBase
Default Public Property Item(ByVal index As Integer) _
As MastermindGenome
Get
Return CType(List(index), MastermindGenome)
End Get
Set(ByVal Value As MastermindGenome)
List(index) = Value
End Set
End Property
Public Function Add(ByVal value As MastermindGenome) As Integer
Return List.Add(value)
End Function 'Add
Public Function IndexOf(ByVal value As MastermindGenome) _
As Integer
Return List.IndexOf(value)
End Function 'IndexOf
Public Sub Insert(ByVal index As Integer, ByVal value _
As MastermindGenome)
List.Insert(index, value)
End Sub 'Insert
Public Sub Remove(ByVal value As MastermindGenome)
List.Remove(value)
End Sub 'Remove
Public Function Contains(ByVal value As MastermindGenome) _
As Boolean
' If value is not of type MastermindGuessGene, this will
' return false.
Return List.Contains(value)
End Function 'Contains
Protected Overrides Sub OnInsert(ByVal index As Integer, _
ByVal value As [Object])
' Insert additional code to be run only when inserting
' values.
End Sub 'OnInsert
Protected Overrides Sub OnRemove(ByVal index As Integer, _
ByVal value As [Object])
' Insert additional code to be run only when removing
' values.
End Sub 'OnRemove
Protected Overrides Sub OnSet(ByVal index As Integer, _
ByVal oldValue As [Object], _
ByVal newValue As [Object])
' Insert additional code to be run only when setting values.
End Sub 'OnSet
Protected Overrides Sub OnValidate(ByVal value As [Object])
If Not value.GetType() Is _
Type.GetType("Mastermind.MastermindGenome") Then
Throw New ArgumentException("value must be of type _
MastermindGenome.", _
"value")
End If
End Sub 'OnValidate
End Class
#End Region
End Class
MastermindEnvironment: IEnvironment implementation
This defines the rules by which a game of mastermind can be solved.
'\\ --[ManstermindEnvironment]--------------------
'\\ Represents the IEnvironment implementation
'\\ that represents a game
'\\ of mastermind in progress...
'\\ ----------------------------------------------
Public Class MastermindEnvironment
Inherits EvolutionaryComputingFramework.IEnvironment
#Region "Private properties"
Private _CorrectGuess As MastermindGenome
Private _Population As MastermindGuessPopulation
Private _MaxScore As Integer
Private _HealthiestIndividual As MastermindGenome
#End Region
#Region "Private constants"
Private _PointsForRightColourWrongPosition As Int32 = 5
Private _PointsForRightColourRightPosition As Int32 = 50
#End Region
#Region "IEnvironment implementation"
Public Overrides Function GetPopulation() As IPopulation
If Not _Population Is Nothing Then
Return _Population
Else
Throw New InvalidOperationException("The population has _
not been created yet")
End If
End Function
Public Overrides Function GetHealth(ByVal TestIndividual _
As IGenome) As Integer
If Not TestIndividual.GetType() Is Type.GetType( _
"Mastermind.MastermindGenome") Then
Throw New ArgumentException("TestIndividual must be of _
type MastermindGenome.", "value")
Else
Dim CumulativeScore As Integer
'\\ Go through each GuessGene in the test individual
Dim NextGuessPosition As Integer
Dim GuessIndividual As MastermindGenome
GuessIndividual = CType(TestIndividual, MastermindGenome)
For NextGuessPosition = 0 To GuessIndividual.Count - 1
'\\ If it is the right colour in the right place
'\\ add points for that
If GuessIndividual.GetGene(NextGuessPosition).Value +
= _CorrectGuess.GetGene(NextGuessPosition).Value Then
CumulativeScore += _PointsForRightColourRightPosition
Else
'\\ Otherwise if it is the right colour in the
'\\ wrong place add points for that
If _CorrectGuess.Contains(GuessIndividual.GetGene _
(NextGuessPosition).Value) Then
CumulativeScore += _PointsForRightColourWrongPosition
End If
End If
Next NextGuessPosition
Return CumulativeScore
End If
End Function
Public Overrides Function Breed(ByVal Parents As IPopulation) _
As IGenome
'\\ Currently our "mastermind species" only breeds from two
'\\ parents.
'\\ Future versions can have this configurable to measure
'\\ the effect of increasing the parental pool.
Dim GenomeOut As New MastermindGenome(_CorrectGuess.NumberOfPegHoles)
'\\ Make Genome out by selecting (at random) a dominant
'\\ gene from each of the two parents
Dim ParentOne As MastermindGenome = CType(Parents, _
MastermindGuessPopulation).Item(0)
Dim ParentTwo As MastermindGenome = CType(Parents, _
MastermindGuessPopulation).Item(1)
Dim GeneIndex As Integer
For GeneIndex = 0 To GenomeOut.NumberOfPegHoles - 1
If Rnd() <= MutationRate Then
GenomeOut.GetGene(GeneIndex).Value = New _
MastermindGuessGene().Value
Else
If Rnd() < 0.5 Then
GenomeOut.GetGene(GeneIndex).Value = _
ParentOne.GetGene(GeneIndex).Value
Else
GenomeOut.GetGene(GeneIndex).Value = _
ParentTwo.GetGene(GeneIndex).Value
End If
End If
Next
Return GenomeOut
End Function
Public Overrides ReadOnly Property MutationRate() As Single
Get
Return 0.1
End Get
End Property
#End Region
#Region "Public constructors"
Public Sub New(ByVal PopulationSize As Integer, _
ByVal CorrectGuess As MastermindGenome)
_CorrectGuess = CorrectGuess
_Population = New MastermindGuessPopulation(PopulationSize, _
CorrectGuess.NumberOfPegHoles)
_MaxScore = CorrectGuess.NumberOfPegHoles * _
_PointsForRightColourRightPosition
End Sub
#End Region
#Region "Public properties"
Public ReadOnly Property MaximumScore() As Integer
Get
Return _MaxScore
End Get
End Property
'\\ --[NextGeneration]------------------------
'\\ Evaluates the health of each individual
'\\ in the current population,
'\\ killing off the least healthy and
'\\ breeding from the rest
'\\ ------------------------------------------
Public Sub NextGeneration()
If _Population.PopulationSize = 0 Then
Throw New Exception("The population is extinct")
Else
Dim GenomeHealth As Integer
Dim TotalHealth As Integer
_HealthiestIndividual = Nothing
Dim TestGenome As Integer
For TestGenome = 0 To _Population.PopulationSize - 1
If _HealthiestIndividual Is Nothing Then
_HealthiestIndividual = _Population.Item(TestGenome)
TotalHealth = GetHealth(_Population.Item(TestGenome))
Else
GenomeHealth = GetHealth(_Population.Item(TestGenome))
If GenomeHealth > GetHealth(_HealthiestIndividual) Then
_HealthiestIndividual = _Population.Item(TestGenome)
End If
TotalHealth = TotalHealth + GenomeHealth
End If
Next
Dim Averagehealth As Integer = TotalHealth / _
_Population.PopulationSize
Dim MaxIndex As Integer = _Population.PopulationSize - 1
For TestGenome = 0 To MaxIndex
If TestGenome > MaxIndex Then
Exit For
End If
GenomeHealth = GetHealth(_Population.Item(TestGenome))
If GenomeHealth < Averagehealth OrElse GenomeHealth = 0 Then
_Population.Kill(TestGenome)
MaxIndex = MaxIndex - 1
End If
Next
For TestGenome = 0 To _Population.PopulationSize - 2 Step 2
Dim Parents As New MastermindGuessPopulation()
Parents.AddGenome(_Population.Item(TestGenome))
Parents.AddGenome(_Population.Item(TestGenome + 1))
_Population.AddGenome(Breed(Parents))
Next
End If
End Sub
Public ReadOnly Property BestGuess() As MastermindGenome
Get
Return _HealthiestIndividual
End Get
End Property
#End Region
End Class
Comments
There are no comments yet. Be the first to comment!