RosettaCodeData/Task/Evolutionary-algorithm/Liberty-BASIC/evolutionary-algorithm.basic

70 lines
2.4 KiB
Plaintext

C = 10
'mutaterate has to be greater than 1 or it will not mutate
mutaterate = 2
mutationstaken = 0
generations = 0
Dim parentcopies$((C - 1))
Global targetString$ : targetString$ = "METHINKS IT IS LIKE A WEASEL"
Global allowableCharacters$ : allowableCharacters$ = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
currentminFitness = Len(targetString$)
For i = 1 To Len(targetString$)
parent$ = parent$ + Mid$(allowableCharacters$, Int(Rnd(1) + 1 * Len(allowableCharacters$)), 1) 'corrected line
Next i
Print "Parent = " + parent$
While parent$ <> targetString$
generations = (generations + 1)
For i = 0 To (C - 1)
parentcopies$(i) = mutate$(parent$, mutaterate)
mutationstaken = (mutationstaken + 1)
Next i
For i = 0 To (C - 1)
currentFitness = Fitness(targetString$, parentcopies$(i))
If currentFitness = 0 Then
parent$ = parentcopies$(i)
Exit For
Else
If currentFitness < currentminFitness Then
currentminFitness = currentFitness
parent$ = parentcopies$(i)
End If
End If
Next i
CLS
Print "Generation - " + str$(generations)
Print "Parent - " + parent$
Scan
Wend
Print
Print "Congratulations to me; I finished!"
Print "Final Mutation: " + parent$
'The ((i + 1) - (C)) reduces the total number of mutations that it took by one generation
'minus the perfect child mutation since any after that would not have been required.
Print "Total Mutations Taken - " + str$(mutationstaken - ((i + 1) - (C)))
Print "Total Generations Taken - " + str$(generations)
Print "Child Number " + str$(i) + " has perfect similarities to your target."
End
Function mutate$(mutate$, mutaterate)
If (Rnd(1) * mutaterate) > 1 Then
'The mutatingcharater randomizer needs 1 more than the length of the string
'otherwise it will likely take forever to get exactly that as a random number
mutatingcharacter = Int(Rnd(1) * (Len(targetString$) + 1))
mutate$ = Left$(mutate$, (mutatingcharacter - 1)) + Mid$(allowableCharacters$, Int(Rnd(1) * Len(allowableCharacters$)), 1) _
+ Mid$(mutate$, (mutatingcharacter + 1))
End If
End Function
Function Fitness(parent$, offspring$)
For i = 1 To Len(targetString$)
If Mid$(parent$, i, 1) <> Mid$(offspring$, i, 1) Then
Fitness = (Fitness + 1)
End If
Next i
End Function