I’ve decided to do a little study on Dawkin’s tired old “METHINKS IT IS LIKE A WEASEL” algorithm. The first step is obviously to replicate the original behaviour. The following code and results were written in VB6. I’ll try to include source code throughout the study. This version should be like the original with n generations of x offspring moving towards a target phrase. Phrases are scored according to the sum of the similarities of each letter to their corrosponding letters in the target phrase. Since we are only using one of the offspring as the new parent, and since this is always the best of the offspring, we need not keep an array of results. The following code should suffice:

SOURCE CODE (VB6):

Option Explicit

Public Const TARGET_STRING As String = _
    "METHINKS@IT@IS@LIKE@A@WEASEL"
Public Const OFFSPRING_PER_GENERATION = 200

Private mstrParent As String
Private mlngLength As Long
Private mlngGeneration As Long

Public Sub Main()

    Randomize Timer

    mlngLength = Len(TARGET_STRING)
    Debug.Print "Target is: " & _
                Replace$(TARGET_STRING, "@", " ") & vbCrLf

    Call GenerateInitial
    Call ShowResult

    Do While CalculateScore(mstrParent) > 0
        Call GenerateOffspring
        Call ShowResult
    Loop

End Sub

Private Sub GenerateInitial()

    Dim lngIndex As Long

    mlngGeneration = 1
    mstrParent = vbNullString
    For lngIndex = 1 To mlngLength
        mstrParent = mstrParent & Chr$(Int(Rnd * 27) + 64)
    Next lngIndex

End Sub

Private Sub GenerateOffspring()

    Dim lngIndex As Long
    Dim strBest As String
    Dim strNext As String

    strBest = mstrParent
    Mid$(strBest, Int(Rnd * mlngLength) + 1, 1) = _
        Chr$(Int(Rnd * 27) + 64)

    For lngIndex = 2 To OFFSPRING_PER_GENERATION
        strNext = mstrParent
        Mid$(strNext, Int(Rnd * mlngLength) + 1, 1) = _
            Chr$(Int(Rnd * 27) + 64)

        If CalculateScore(strNext) < CalculateScore(strBest) Then
            strBest = strNext
        End If
    Next lngIndex

    mstrParent = strBest
    mlngGeneration = mlngGeneration + 1

End Sub

Private Function CalculateScore(ByVal CompareTo As String) As Long

    Dim lngIndex As Long

    For lngIndex = 1 To mlngLength
        CalculateScore = CalculateScore + _
                         Abs(AscW(Mid$(TARGET_STRING, _
                                       lngIndex, 1)) - _
                         AscW(Mid$(CompareTo, lngIndex, 1)))
    Next lngIndex

End Function

Private Sub ShowResult()

    Debug.Print "Generation " & mlngGeneration & ": " & _
                Replace$(mstrParent, "@", " ") & _
                " [" & CalculateScore(mstrParent) & "]"

End Sub

OUTPUT:

Target is: METHINKS IT IS LIKE A WEASEL

Generation 1: OM WVL LTYDMIBCXNOTUKJIJAOSV [287]
Generation 2: OM WVL LTYDMIBCXNOT KJIJAOSV [266]
Generation 3: OMSWVL LTYDMIBCXNOT KJIJAOSV [247]
Generation 4: OMSWVL LBYDMIBCXNOT KJIJAOSV [229]
Generation 5: OMSWVL LBIDMIBCXNOT KJIJAOSV [213]
Generation 6: OMSWVL LBIUMIBCXNOT KJIJAOSV [198]
Generation 7: OMSWVL LBIUMIBCXNOT KJWJAOSV [184]
Generation 8: OMSGVL LBIUMIBCXNOT KJWJAOSV [170]
Generation 9: OMSGVL LBIUMIBCXNOE KJWJAOSV [155]
Generation 10: OMSGVL LBIUMIRCXNOE KJWJAOSV [139]
Generation 11: OMSGVL LBIUMIRCXNOE KJWJAOCV [127]
Generation 12: OMSGJL LBIUMIRCXNOE KJWJAOCV [115]
Generation 13: OMSGJL LBIU IRCXNOE KJWJAOCV [102]
Generation 14: OMSGJL LBIU IRCKNOE KJWJAOCV [91]
Generation 15: OMSGJL LBIU IRCKNOE KJWJAOCL [81]
Generation 16: OMSGJLKLBIU IRCKNOE KJWJAOCL [70]
Generation 17: OMSGJLKLBIU IRCKNOE KCWJAOCL [63]
Generation 18: OMSGJLKLBIU IRCKNOE CCWJAOCL [55]
Generation 19: OESGJLKLBIU IRCKNOE CCWJAOCL [47]
Generation 20: OESGJLKTBIU IRCKNOE CCWJAOCL [41]
Generation 21: OESGJLKTBIU IRCKNOE CCWCAOCL [38]
Generation 22: OESGJLKTBIU IR KNOE CCWCAOCL [35]
Generation 23: OESGJLKTBIU IR KJOE CCWCAOCL [31]
Generation 24: OESGJLKTBIU IR KJOE CCWCAOEL [29]
Generation 25: OESGJLKTBIU IR KJOE CCWCAREL [26]
Generation 26: MESGJLKTBIU IR KJOE CCWCAREL [24]
Generation 27: MESGJLKTBIU IR KJOE C WCAREL [21]
Generation 28: MESGJLKTBIU IR KJJE C WCAREL [18]
Generation 29: MESGJLKTBIU IR KJJE A WCAREL [16]
Generation 30: MESGJNKTBIU IR KJJE A WCAREL [14]
Generation 31: MESGJNKTBIU IR KJJE A WEAREL [12]
Generation 32: METGJNKTBIU IR KJJE A WEAREL [11]
Generation 33: METGJNKTAIU IR KJJE A WEAREL [10]
Generation 34: METGJNKTAIU IR KJJE A WEASEL [9]
Generation 35: METHJNKTAIU IR KJJE A WEASEL [8]
Generation 36: METHJNKTAIU IR KJJE A WEASEL [8]
Generation 37: METHJNKTAIU IR KIJE A WEASEL [7]
Generation 38: METHJNKTAIU IR KIKE A WEASEL [6]
Generation 39: METHJNKTAIT IR KIKE A WEASEL [5]
Generation 40: METHJNKTAIT IR KIKE A WEASEL [5]
Generation 41: METHINKTAIT IR KIKE A WEASEL [4]
Generation 42: METHINKSAIT IR KIKE A WEASEL [3]
Generation 43: METHINKSAIT IR KIKE A WEASEL [3]
Generation 44: METHINKSAIT IR KIKE A WEASEL [3]
Generation 45: METHINKS IT IR KIKE A WEASEL [2]
Generation 46: METHINKS IT IS KIKE A WEASEL [1]
Generation 47: METHINKS IT IS KIKE A WEASEL [1]
Generation 48: METHINKS IT IS KIKE A WEASEL [1]
Generation 49: METHINKS IT IS KIKE A WEASEL [1]
Generation 50: METHINKS IT IS KIKE A WEASEL [1]
Generation 51: METHINKS IT IS KIKE A WEASEL [1]
Generation 52: METHINKS IT IS KIKE A WEASEL [1]
Generation 53: METHINKS IT IS KIKE A WEASEL [1]
Generation 54: METHINKS IT IS KIKE A WEASEL [1]
Generation 55: METHINKS IT IS KIKE A WEASEL [1]
Generation 56: METHINKS IT IS KIKE A WEASEL [1]
Generation 57: METHINKS IT IS LIKE A WEASEL [0]

Note: To run the code, copy the code into a module and set the project to start on Sub Main.

Advertisements