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


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