RosettaCodeData/Task/Evolutionary-algorithm/PureBasic/evolutionary-algorithm.purebasic

Define population = 100, mutationRate = 6
Define.s target$ = "METHINKS IT IS LIKE A WEASEL"
Define.s charSet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "

Procedure.i fitness(Array aspirant.c(1), Array target.c(1))
  Protected i, len, fit
  len = ArraySize(aspirant())
  For i = 0 To len
    If aspirant(i) = target(i): fit +1: EndIf
  Next
  ProcedureReturn fit
EndProcedure

Procedure mutatae(Array parent.c(1), Array child.c(1), Array charSetA.c(1), rate.i)
  Protected i, L, maxC
  L = ArraySize(child())
  maxC = ArraySize(charSetA())
  For i = 0 To L
    If Random(100) < rate
      child(i) = charSetA(Random(maxC))
    Else
      child(i) = parent(i)
    EndIf
  Next
EndProcedure

Procedure.s cArray2string(Array A.c(1))
  Protected S.s, len
  len = ArraySize(A())+1 : S = Space(len)
  CopyMemory(@A(0), @S, len * SizeOf(Character))
  ProcedureReturn S
EndProcedure

Define mutationRate, maxChar, target_len, i, maxfit, gen, fit, bestfit
Dim targetA.c(Len(target$) - 1)
CopyMemory(@target$, @targetA(0), StringByteLength(target$))

Dim charSetA.c(Len(charSet$) - 1)
CopyMemory(@charSet$, @charSetA(0), StringByteLength(charSet$))

maxChar   = Len(charSet$) - 1
maxfit = Len(target$)
target_len   = Len(target$) - 1
Dim    parent.c(target_len)
Dim     child.c(target_len)
Dim Bestchild.c(target_len)


For i = 0 To target_len
  parent(i) = charSetA(Random(maxChar))
Next

fit = fitness (parent(), targetA())
OpenConsole()

PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(fit) + "/" + Str(maxfit))

While bestfit <> maxfit
  gen + 1
  For i = 1 To population
    mutatae(parent(),child(),charSetA(), mutationRate)
    fit = fitness (child(), targetA())
    If fit > bestfit
      bestfit = fit: CopyArray(child(), Bestchild())
    EndIf
  Next
  CopyArray(Bestchild(), parent())
  PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(bestfit) + "/" + Str(maxfit))
Wend

PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""