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

CONST Target = "Brave New World!"

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

DECLARE Population[DomainSize+1] TYPE char*
DECLARE Nextgen[DomainSize+1] TYPE char*
INTEGER gen, ind

CONST TLen = LEN(Target)

REM ----------------------------------------------------------------------------------

FUNC Fitness(char* chromosome)

    INTEGER x, status

    REM 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

ENDFUNC

REM ----------------------------------------------------------------------------------

SUB Populate()

    INTEGER x, y

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

ENDSUB

REM ----------------------------------------------------------------------------------

SUB Generate()

    INTEGER m1, m2, m3, m4, x, pos, y
    STRING mutant1, mutant2

    FOR x = 1 TO DomainSize STEP 2

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

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

            REM Cloning
            IF Fitness(Population[m1]) > Fitness(Population[m2]) THEN
                LET Nextgen[x] = Population[m1]
            ELSE
                LET Nextgen[x] = Population[m2]
            ENDIF
            IF Fitness(Population[m3]) > Fitness(Population[m4]) THEN
                LET Nextgen[x+1] = Population[m3]
            ELSE
                LET Nextgen[x+1] = Population[m4]
            ENDIF
        ELSE
            REM Breeding
            LET pos = RANDOM(TLen-2)+2
            SET Nextgen[x] = CONCAT(MID(Population[m1], 1, pos), MID(Population[m2], pos+1, LEN(Population[m2])))
            SET Nextgen[x+1] = CONCAT(MID(Population[m2], 1, pos), MID(Population[m1], pos+1, LEN(Population[m1])))
        ENDIF

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

            REM Mutate both children
            LET pos = RANDOM(TLen)+1
            LET mutant1 = "" LET mutant2 = ""

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

                    REM Find current character and add/substract max 5
                    LET m2 = ASC(MID(Nextgen[x], pos, 1)) + RANDOM(11) - 5
                    IF m2 > 126 THEN LET m2 = m2 - 127 + 32 FI
                    IF m2 < 32 THEN LET m2 = m2 + 127 - 32 FI
                    SET mutant2 = CONCAT(mutant2, CHR( m2 ) )
                ELSE
                    SET mutant1 = CONCAT(mutant1, MID(Nextgen[x], y, 1))
                    SET mutant2 = CONCAT(mutant2, MID(Nextgen[x+1], y, 1))
                ENDIF
            NEXT
            SET Nextgen[x] = mutant1
            SET Nextgen[x+1] = mutant2
        ENDIF
    NEXT

    REM Now copy new generation to population
    FOR x = 1 TO DomainSize
        SET Population[x] = Nextgen[x]
    NEXT

ENDSUB

REM ----------------------------------------------------------------------------------

FUNC FindMatch()

    INTEGER x, closest, ind

    LET closest = TLen*-127

    REM Find closest match
    FOR x = 1 TO DomainSize
        IF Fitness(Population[x]) > closest THEN
            LET closest = Fitness(Population[x])
            LET ind = x
        ENDIF
    NEXT

    RETURN ind

ENDFUNC

REM ----------------------------------------------------------------------------------

LET gen = 0
CALL Populate()

REM Continue until a match is found
REPEAT
    CALL Generate()
    INCR gen
    LET ind = FindMatch()
    IF NOT(MOD(gen, 5)) THEN PRINT gen, Population[ind] FORMAT "Generation %ld best: %s\n" FI
UNTIL Fitness(Population[ind]) == 0

REM Print final result!
PRINT "-------------------------------------\n"
PRINT gen, Population[ind] FORMAT "Generation %ld best: %s\n"
PRINT "-------------------------------------\n"

Return to M4BASIC