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
Showing posts with label macro. Show all posts
Showing posts with label macro. Show all posts
Saturday, March 28, 2009
VBA Excel weasel
Submitted by Ian Rhile
Subscribe to:
Posts (Atom)