99 lines
2.1 KiB
VB.net
99 lines
2.1 KiB
VB.net
'This is the string we want to "evolve" to. Any string of any length will
|
|
'do as long as it consists only of upper case letters and spaces.
|
|
|
|
Target = "METHINKS IT IS LIKE A WEASEL"
|
|
|
|
'This is the pool of letters that will be selected at random for a mutation
|
|
|
|
letters = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
|
|
|
'A mutation rate of 0.5 means that there is a 50% chance that one letter
|
|
'will be mutated at random in the next child
|
|
|
|
mutation_rate = 0.5
|
|
|
|
'Set for 10 children per generation
|
|
|
|
Dim child(10)
|
|
|
|
'Generate the first guess as random letters
|
|
|
|
Randomize
|
|
Parent = ""
|
|
|
|
for i = 1 to len(Target)
|
|
Parent = Parent & Mid(letters,Random(1,Len(letters)),1)
|
|
next
|
|
|
|
gen = 0
|
|
|
|
Do
|
|
bestfit = 0
|
|
bestind = 0
|
|
|
|
gen = gen + 1
|
|
|
|
'make n copies of the current string and find the one
|
|
'that best matches the target string
|
|
|
|
For i = 0 to ubound(child)
|
|
|
|
child(i) = Mutate(Parent, mutation_rate)
|
|
|
|
fit = Fitness(Target, child(i))
|
|
|
|
If fit > bestfit Then
|
|
bestfit = fit
|
|
bestind = i
|
|
End If
|
|
|
|
Next
|
|
|
|
'Select the child that has the best fit with the target string
|
|
|
|
Parent = child(bestind)
|
|
Wscript.Echo parent, "(fit=" & bestfit & ")"
|
|
|
|
Loop Until Parent = Target
|
|
|
|
Wscript.Echo vbcrlf & "Generations = " & gen
|
|
|
|
'apply a random mutation to a random character in a string
|
|
|
|
Function Mutate ( ByVal str , ByVal rate )
|
|
|
|
Dim pos 'a random position in the string'
|
|
Dim ltr 'a new letter chosen at random '
|
|
|
|
If rate > Rnd(1) Then
|
|
|
|
ltr = Mid(letters,Random(1,len(letters)),1)
|
|
pos = Random(1,len(str))
|
|
str = Left(str, pos - 1) & ltr & Mid(str, pos + 1)
|
|
|
|
End If
|
|
|
|
Mutate = str
|
|
|
|
End Function
|
|
|
|
'returns the number of letters in the two strings that match
|
|
|
|
Function Fitness (ByVal str , ByVal ref )
|
|
|
|
Dim i
|
|
|
|
Fitness = 0
|
|
|
|
For i = 1 To Len(str)
|
|
If Mid(str, i, 1) = Mid(ref, i, 1) Then Fitness = Fitness + 1
|
|
Next
|
|
|
|
End Function
|
|
|
|
'Return a random integer in the range lower to upper (inclusive)
|
|
|
|
Private Function Random ( lower , upper )
|
|
Random = Int((upper - lower + 1) * Rnd + lower)
|
|
End Function
|