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
Saturday, March 28, 2009
VBA Excel weasel
Submitted by Ian Rhile
Subscribe to:
Post Comments (Atom)
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