85 lines
1.9 KiB
Plaintext
85 lines
1.9 KiB
Plaintext
' version 01-07-2018
|
|
' compile with: fbc -s console
|
|
|
|
Randomize Timer
|
|
Const As UInteger children = 100
|
|
Const As Double mutate_rate = 0.05
|
|
|
|
Function fitness(target As String, tmp As String) As UInteger
|
|
|
|
Dim As UInteger x, f
|
|
|
|
For x = 0 To Len(tmp) -1
|
|
If tmp[x] = target[x] Then f += 1
|
|
Next
|
|
Return f
|
|
|
|
End Function
|
|
|
|
Sub mutate(tmp As String, chars As String, mute_rate As Double)
|
|
|
|
If Rnd <= mute_rate Then
|
|
tmp[Int(Rnd * Len(tmp))] = chars[Int(Rnd * Len(chars))]
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' ------=< MAIN >=------
|
|
|
|
Dim As String target = "METHINKS IT IS LIKE A WEASEL"
|
|
Dim As String chars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
|
Dim As String parent, mutation()
|
|
Dim As UInteger x, iter, f, fit(), best_fit, parent_fit
|
|
|
|
For x = 1 To Len(target)
|
|
parent += Chr(chars[Int(Rnd * Len(chars))])
|
|
Next
|
|
|
|
f = fitness(target, parent)
|
|
parent_fit = f
|
|
best_fit = f
|
|
|
|
Print "iteration best fit Parent"
|
|
Print "========= ======== ============================"
|
|
Print Using " #### #### ";iter; best_fit;
|
|
Print parent
|
|
|
|
Do
|
|
iter += 1
|
|
ReDim mutation(1 To children),fit(1 To children)
|
|
|
|
For x = 1 To children
|
|
mutation(x) = parent
|
|
mutate(mutation(x), chars, mutate_rate)
|
|
Next
|
|
|
|
For x = 1 To children
|
|
If mutation(x) <> parent Then
|
|
f = fitness(target, mutation(x))
|
|
If best_fit < f Then
|
|
best_fit = f
|
|
fit(x) = f
|
|
Else
|
|
fit(x) = parent_fit
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
If best_fit > parent_fit Then
|
|
For x = 1 To children
|
|
If fit(x) = best_fit Then
|
|
parent = mutation(x)
|
|
Print Using " #### #### ";iter; best_fit;
|
|
Print parent
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
Loop Until parent = target
|
|
|
|
' empty keyboard buffer
|
|
While InKey <> "" : Wend
|
|
Print : Print "hit any key to end program"
|
|
Sleep
|
|
End
|