'
' This is an implementation of the principles explained at:
'       http://www.puremango.co.uk/2010/12/genetic-algorithm-for-hello-world/
'
' We're using ASCII values 32-126 here to store as a string. This probably can be
' done in a more efficient way.
'
' Fill in anything for Target$ to approach some other string.
'
' The DomainSize value determines the total population.
' The CloneRate value determines the percentage to clone.
' The MutateRate value determines the percentage of siblings to mutate.
'
' PvE - January 2011 - GPL v3.
' ----------------------------------------------------------------------------------

OPTION BASE 1

CONST Target$ = "Brave New World!"

CONST DomainSize = 400
CONST CloneRate = 40
CONST MutateRate = 20

DECLARE Population$[DomainSize]
DECLARE Nextgen$[DomainSize]

CONST TLen = LEN(Target$)

' ----------------------------------------------------------------------------------

FUNCTION Fitness(STRING chromosome$)

        LOCAL x, status

        ' Calculate the difference per individual character
        FOR x = 1 TO TLen
                DECR status, ABS(ASC(MID$(chromosome$, x, 1)) - ASC(MID$(Target$, x, 1)))
        NEXT

        RETURN status

END FUNCTION

' ----------------------------------------------------------------------------------

SUB Populate

        LOCAL x, y

        ' Generate purely random strings
        FOR x = 1 TO DomainSize
                Population$[x] = ""
                FOR y = 1 TO TLen
                        Population$[x] = CONCAT$(Population$[x], CHR$(RANDOM(94)+32))
                NEXT y
        NEXT x

END SUB

' ----------------------------------------------------------------------------------

SUB Generate

        LOCAL m1, m2, m3, m4, x, pos
        LOCAL mutant1$, mutant2$
                        
        FOR x = 1 TO DomainSize STEP 2

                m1 = RANDOM(DomainSize)+1
                m2 = RANDOM(DomainSize)+1
                m3 = RANDOM(DomainSize)+1
                m4 = RANDOM(DomainSize)+1

                ' Should we clone or breed?
                IF RANDOM(100)+1 < CloneRate THEN

                        ' Cloning
                        IF Fitness(Population$[m1]) > Fitness(Population$[m1]) THEN
                                Nextgen$[x] = Population$[m1]
                        ELSE
                                Nextgen$[x] = Population$[m2]
                        END IF
                        IF Fitness(Population$[m3]) > Fitness(Population$[m4]) THEN
                                Nextgen$[x+1] = Population$[m3]
                        ELSE
                                Nextgen$[x+1] = Population$[m4]
                        END IF
                ELSE
                        ' Breeding
                        pos = RANDOM(TLen-2)+2
                        Nextgen$[x] = CONCAT$(MID$(Population$[m1], 1, pos), MID$(Population$[m2], pos+1))
                        Nextgen$[x+1] = CONCAT$(MID$(Population$[m2], 1, pos), MID$(Population$[m1], pos+1))
                END IF

                ' Should we apply mutation?
                IF RANDOM(100)+1 < MutateRate THEN

                        ' Mutate both children
                        pos = RANDOM(TLen)+1
                        mutant1$ = "" : mutant2$ = ""

                        FOR y = 1 TO TLen
                                IF y = pos THEN
                                        ' Find current character and add/substract max 5
                                        m1 = ASC(MID$(Nextgen$[x], pos, 1)) + RANDOM(11) - 5
                                        IF m1 > 126 THEN m1 = m1 - 127 + 32
                                        IF m1 < 32 THEN m1 = m1 + 127 - 32 
                                        mutant1$ = CONCAT$(mutant1$, CHR$( m1 ))

                                        ' Find current character and add/substract max 5
                                        m2 = ASC(MID$(Nextgen$[x], pos, 1)) + RANDOM(11) - 5
                                        IF m2 > 126 THEN m2 = m2 - 127 + 32
                                        IF m2 < 32 THEN m2 = m2 + 127 - 32 
                                        mutant2$ = CONCAT$(mutant2$, CHR$( m2 ))
                                ELSE
                                        mutant1$ = CONCAT$(mutant1$, MID$(Nextgen$[x], y, 1))
                                        mutant2$ = CONCAT$(mutant2$, MID$(Nextgen$[x+1], y, 1))
                                END IF
                        NEXT
                        Nextgen$[x] = mutant1$
                        Nextgen$[x+1] = mutant2$
                END IF
        NEXT
        
        ' Now copy new generation to population
        FOR x = 1 TO DomainSize
                Population$[x] = Nextgen$[x]
        NEXT

END SUB

' ----------------------------------------------------------------------------------

FUNCTION FindMatch

        LOCAL x, closest = -127*TLen, ind
        
        ' Find closest match
        FOR x = 1 TO DomainSize
                IF Fitness(Population$[x]) > closest THEN
                        closest = Fitness(Population$[x])
                        ind = x
                END IF
        NEXT
        
        RETURN ind

END FUNCTION

' ----------------------------------------------------------------------------------

gen = 0
Populate

' Continue until a match is found
REPEAT
        Generate
        INCR gen
        ind = FindMatch()
        IF NOT(MOD(gen, 5)) THEN PRINT "Generation ", gen, " best: ", Population$[ind]
UNTIL Fitness(Population$[ind]) IS 0

' Print final result!
PRINT "-----------------------------------"
PRINT "Generation ", gen, " best: ", Population$[ind]
PRINT "-----------------------------------"