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

Advertisements