Saturday, March 28, 2009

VBA Excel weasel

Submitted by Ian Rhile


Sub weasel()
'An Excel macro for Dawkin's weasel algorithm
gentarget = 0
mutationrate = 0.05
Sheets("Sheet1").Cells.ClearContents
target = "methinks it is like a weasel"
alphabet = "abcdefghijklmnopqrstuvwxyz "
'generate initial random string
For x = 1 To Len(target)
    y = Int(27 * Rnd + 1)
    seq = seq + Mid(alphabet, y, 1)
Next x
Sheets("Sheet1").Range("A1").Value = "original sequence:"
Sheets("Sheet1").Range("B1").Value = seq
Sheets("Sheet1").Range("A2").Value = "generation"
Sheets("Sheet1").Range("B2").Value = "original generational sequence"
Sheets("Sheet1").Range("C2").Value = "matches"
50 gen = gen + 1
Sheets("Sheet1").Cells(gen + 2, 1) = gen
Sheets("Sheet1").Cells(gen + 2, 2) = seq
maxfit = 0
maxfitseq = seq
For x = 1 To 100
    newseq = seq
    For u = 1 To Len(seq)
        If Rnd < mutationrate Then
            w = Int(27 * Rnd + 1)
            Mid(newseq, u, 1) = Mid(alphabet, w, 1)
        End If
    Next u
    Sheets("Sheet1").Cells(gen + 2, x + 4) = newseq
    fit = 0
    For t = 1 To Len(newseq)
        If Mid(target, t, 1) = Mid(newseq, t, 1) Then fit = fit + 1
    Next t
    If fit > maxfit Then
        maxfit = fit
        maxfitseq = x
    End If
Next x
Sheets("Sheet1").Cells(gen + 2, 3) = maxfit
   
seq = Sheets("Sheet1").Cells(gen + 2, maxfitseq + 4).Value
If gentarget > 0 And gen > gentarget Then GoTo 100
If seq = target Then
    If gentarget > 0 Then GoTo 50
    gentarget = gen + 100
End If
GoTo 50
100 End Sub

1 comment:

  1. Hi! I've been using a similar technique to design one-handed keyboard layouts. There are details here: http://geoffsshorts.blogspot.com/2011/11/one-handed-keyboards-and-evolutionary.html Let me know if you'd like the code.

    ReplyDelete