This next variation on the theme introduces several new components. First, the code for an individual parent or child has been set into an “Individual” class. The Individual includes the AminoCode to compare against the target, as well as that individual’s respective score. This enables us to cut down the score calculations considerably and thus reduce the time it takes to go through each generation by one third. It is also useful in that it groups the individual’s characteristics together and allows it to be treated as a unit.
Second, this version introduces more realistic population simulation. Rather than simply having one parent surviving to reproduce, we can now simulate various population sizes. Two new constants have been added to facilitate this purpose: The PARENT_POPULATION constant specifies the number of parents involved in each generation. This is the surviving population of each round of selection. Related to the PARENT_POPULATION constant is the OFFSPRING_PER_PARENT constant, which specifies the number of children that each parent will have. The total child population is therefore PARENT_POPULATION * OFFSPRING_PER_PARENT. (Paired generation will be dealt with next.)
Third, the SUCCESS_STANDARD constant has been added to work with population simulation. This constant is compared against the population’s average score to determine when a relatively successful target has been reached. It has been set to zero for this simulation – in others it has been set to 0.5, requiring at least half of the individuals of the group to exhibit code identical to the target.
SOURCE CODE (VB6):
Option Explicit
Public Const TARGET_STRING As String = “METHINKS@IT@IS@LIKE@A@WEASEL”
Public Const OFFSPRING_PER_PARENT As Long = 20
Public Const PARENT_POPULATION As Long = 20
Public Const SUCCESS_STANDARD As Double = 0
Public Const MUTATION_RATE As Double = 1 / 26
Private Type Individual
AminoCode() As Long
Score As Long
End Type
Private miTarget As Individual
Private miParents(1 To PARENT_POPULATION) As Individual
Private miChildren(1 To PARENT_POPULATION) As Individual
Private mdblAvgScore As Double
Private mlngLength As Long
Private mlngGeneration As Long
Public Sub Main()
Dim lngIndex As Long
Call Initialize
Call Simulate
End Sub
Private Sub Initialize()
Randomize Timer
mlngLength = Len(TARGET_STRING)
Call StringToLong(TARGET_STRING, miTarget.AminoCode)
End Sub
Private Function Simulate() As Long
Dim lngDisplay As Long
Call GenerateInitial
lngDisplay = 1
Do While mdblAvgScore > SUCCESS_STANDARD
If mlngGeneration = lngDisplay Then
Call ShowResult
lngDisplay = lngDisplay * 10
End If
Call GenerateOffspring
Loop
If mlngGeneration * 10 lngDisplay Then
ShowResult
End If
Simulate = mlngGeneration
End Function
Private Sub GenerateInitial()
Dim lngParent As Long
Dim lngIndex As Long
mdblAvgScore = 0
mlngGeneration = 1
For lngParent = 1 To PARENT_POPULATION
With miParents(lngParent)
ReDim .AminoCode(1 To mlngLength)
For lngIndex = 1 To mlngLength
.AminoCode(lngIndex) = Int(Rnd * 27)
Next lngIndex
Call CalculateScore(miParents(lngParent))
mdblAvgScore = mdblAvgScore + .Score
End With
Next lngParent
mdblAvgScore = mdblAvgScore / PARENT_POPULATION
End Sub
Public Sub StringToLong(ByRef StringIn As String, ByRef LongOut() As Long)
Dim lngIndex As Long
ReDim LongOut(1 To Len(StringIn))
For lngIndex = 1 To Len(StringIn)
LongOut(lngIndex) = AscW(Mid$(StringIn, lngIndex, 1)) – 64
Next lngIndex
End Sub
Public Function LongToString(ByRef LongIn() As Long) As String
Dim lngIndex As Long
LongToString = vbNullString
For lngIndex = LBound(LongIn) To UBound(LongIn)
LongToString = LongToString & Chr$(LongIn(lngIndex) + 64)
Next lngIndex
End Function
Private Sub GenerateOffspring()
Dim lngParent As Long
Dim lngIndex As Long
Dim iNext As Individual
Call ClearChildren
For lngParent = 1 To PARENT_POPULATION
For lngIndex = 1 To OFFSPRING_PER_PARENT
iNext = miParents(lngParent)
Call MutateString(iNext)
Call CalculateScore(iNext)
Call AddChild(iNext)
Next lngIndex
Next lngParent
Call NextGeneration
End Sub
Private Sub ClearChildren()
Dim lngChild As Long
For lngChild = 1 To PARENT_POPULATION
miChildren(lngChild).Score = -1
Next lngChild
End Sub
Private Sub AddChild(ByRef NewChild As Individual)
Dim lngIndex As Long
If miChildren(PARENT_POPULATION).Score > NewChild.Score Or _
miChildren(PARENT_POPULATION).Score = -1 Then
For lngIndex = PARENT_POPULATION – 1 To 1 Step -1
If miChildren(lngIndex).Score > NewChild.Score Then
miChildren(lngIndex + 1) = miChildren(lngIndex)
ElseIf miChildren(lngIndex).Score -1 Then
miChildren(lngIndex + 1) = NewChild
Exit Sub
End If
Next lngIndex
miChildren(1) = NewChild
End If
End Sub
Private Sub NextGeneration()
Dim lngChild As Long
mdblAvgScore = 0
For lngChild = 1 To PARENT_POPULATION
miParents(lngChild) = miChildren(lngChild)
mdblAvgScore = mdblAvgScore + miParents(lngChild).Score
Next lngChild
mdblAvgScore = mdblAvgScore / PARENT_POPULATION
mlngGeneration = mlngGeneration + 1
End Sub
Private Sub MutateString(ByRef MutateFrom As Individual)
Dim lngIndex As Long
With MutateFrom
For lngIndex = 1 To mlngLength
If Int(Rnd * (1 / MUTATION_RATE)) = 0 Then
Call MutateChar(.AminoCode(lngIndex))
End If
Next lngIndex
End With
End Sub
Private Sub MutateChar(ByRef FromVal As Long)
FromVal = (FromVal + Int(Rnd * 26) + 1) Mod 27
End Sub
Private Sub CalculateScore(ByRef CompareTo As Individual)
Dim lngIndex As Long
With CompareTo
.Score = 0
For lngIndex = 1 To mlngLength
If miTarget.AminoCode(lngIndex) .AminoCode(lngIndex) Then
.Score = .Score + 1
End If
Next lngIndex
End With
End Sub
Private Sub ShowResult()
With miParents(1)
Debug.Print “Generation ” & mlngGeneration & “: ” & _
Replace$(LongToString(.AminoCode), “@”, ” “) & _
” [” & mdblAvgScore & “]”
End With
End Sub
Leave a comment