' 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