Rebol3 Code Examplex

Rebol [
    title: "Rosetta code: Evolutionary algorithm"
    file:  %Evolutionary_algorithm.r3
    url:   https://rosettacode.org/wiki/Evolutionary_algorithm
    note:  "Based on Red language solution"
]

evolve: function/with [
    target [string!]  "target phrase to evolve toward"
    childs [integer!] "number of offspring per generation"
    rate   [number!]  "per-character mutation probability (0.0..1.0)"
][
    trg: target
    ;; create initial random parent of same length as target
    parent: clear ""
    repeat i length? target [
        append parent random/only alphabet
    ]
    ;; main loop: generate children, select fittest, repeat until exact match
    mutations: 0
    while [parent != target] [
        clear children
        repeat i childs [
            append children mutate parent rate  ;; produce a mutated child from parent
        ]
        sort/compare children :sort-fitness     ;; sort children by fitness (best first)
        parent: first children                  ;; select best child as new parent
        ++ mutations
        prin #"^M"                              ;; carriage return to overwrite line
        prin parent
    ]
    prin #"^M"                                  ;; move to line start
    print parent                                ;; final perfect match
    mutations
][
    alphabet: "ABCDEFGHIJKLMNOPQRSTUVWXYZ "     ;; allowed gene pool (uppercase letters + space)
    children: copy []                           ;; reusable buffer for a generation's children
    trg: _

    ;; compute closeness of 'string' to 'target' as Hamming distance (lower is better)
    fitness: function [string] [
        sum: 0
        repeat i length? string [
            if string/:i <> trg/:i [ ++ sum ]   ;; count mismatched positions
        ]
        sum
    ]

    ;; return a mutated copy of 'string'; each position mutates with probability 'rate'
    mutate: function [string rate] [
        result: copy string
        repeat i length? result [
            if rate > random 1.0 [
                result/:i: random/only alphabet   ;; replace char with random from alphabet
            ]
        ]
        result
    ]

    ;; comparison function for sorting: a < b if fitness(a) < fitness(b)
    sort-fitness: function [a b] [lesser? fitness a fitness b]
]

;; run the evolution demo
random/seed 1
m: evolve "METHINKS IT IS LIKE A WEASEL" 20 0.05
print ["Target found using" as-yellow m "mutations."]

LSHVJWCMQQBTQZEHQPPRCQSAUUYP
LSHVJWCMQQBTQZEHQPPRCQPAUUYZ
LSHVJWCSQQBTQZEHQPPRCQPAUUYZ
LSHVJWCSQQBTQZEHQPPRCQWAUUYZ
LSFVJWCSQQBTQZEHQPPRCQWAUSYZ
LSFVJWQSQQBTQZEHQPPRCQWAUS Z
LRFVJWQSQQBTQZEHQPPRCQWAUSEZ
LNFVJWQSQQVTQZEHQPPR QWAUSEZ
LNFVJWQSQQVTQZRHQPPR QWAUSEZ
LNFVJWQSQIVTQZRHQPPR QWLUSEZ
LNFVJWQSQIVTQZRHZPPR QWLUSEZ
LNFVJWQSQIVTQZRHZPPR QWLESEZ
LNFVJWQSQIVTQZRHZPPR ZWLASEZ
LVFVJWQSQIVTQZRHZKPR ZWLASEZ
LVFVJWQSQIVTQZRHZKPR ZWLASEZ
MVFVJWQSQIVTQZRHZKPR ZWJASEZ
MVFRJWFSQIVTQZRHZKPR ZWJASEZ
M FRJWFSQIVTQZRHZKPR ZWJASEZ
M FRJLFSQIVTQZRHZKPR ZWJASEZ
M FRJLFSQIUTQFHHZKPR ZWJASEZ
M FRJLFSQIUTQFHHZKPR ZWJASEZ
M FQJLFSQIU QFHHZKPR ZWJASEZ
M FQJLFSQIU QFHHFKPRTZWJASEZ
M GQJLFSQIU QFHHFKPRTZWJASEZ
M GQJLFSQIU QFHHFKPRTZWJASEZ
M GQJLFSQIU QFHHFKP TZWJASEZ
M GQJLOSQIU GFHHFKP TSWOASEZ
M GQJLOSQIU IFHHFKP TSWOASEN
M GQJLOSQIS ISHHFKP TXWOASEN
M GQILOSQIS ISHHFKP TXWOASEN
M GQILOSQIS ISHHFKP TXWOASEN
M GQILOSQIS ISHHFKP TXWOASEN
M GQILOS IS ISHHFKP TXWOASEN
M GQILOS IS ISHHFKI TXWDASEN
M GQILOS IS ISHHFKI TXWDASEN
M GQILOS IS ISHHPKI TXWDASEN
M GQILOS IS ISHHPKE TXWDASEN
M GQILOS IS ISHHPKE TXWDASEN
M GQILOS IS ISHHPKE TXWDASEN
M GQILOS IS ISHHPKE TXWDASEX
M GQILOS IS ISHHPKE TXWDASEX
M CQILOS IS IS HPKE TXWDASEX
M CQILOS IH IS HPKE TXWEASEX
M CQILOS IH IS HPKE TXWEASEX
M CQILOS IH IS LPKE TDWEASEM
M CQILOS IH IS LPKE TDWEASEM
M CQILOS IH IS LPKE TDWEASEM
M CQIKOS IH IS LPKE TDWEASEM
M CQIKOS IH IS LPKE TDWEASEM
M CQIKOS IW IS LPKE TGWEASEM
M CQIKOS IW IS LPKE TGWEASEM
M CQIKOS IW IS LPKE TGWEASEM
M CQIKOS IW IS LPKE TGWEASEM
M CQIKOS IW IS LPKE TGWEASET
M CQIKOS IW IS LIKE XGWEASET
M CQIKOS IW IS LIKE XGWEASET
M CQIKOS IW IS LIKE XGWEASET
M CQIKOS IW IS LIKE X WEASET
M CQIKOS IW IS LIKE X WEASET
M CQIKOS IW IS LIKE X WEASET
M CQIKOS IW IS LIKE X WEASET
M CQIKOS IW IS LIKE X WEASET
M CQIKOS IW IS LIKE X WEASET
M CQIKOS IW IS LIKE H WEASET
M CQIFOS IW IS LIKE H WEASET
M CQIFOS IW IS LIKE H WEASET
MZCQIFOS IW IS LIKE H WEASET
MZCQIFOS IW IS LIKE H WEASET
MZCQIFOS IW IS LIKE H WEASET
MZCQIFOS IW IS LIKE H WEASET
MZCQIFOS IW IS LIKE H WEASET
MZCQIFOS IW IS LIKE H WEASET
MZTQIFOS IW IS LIKE H WEASET
MZTNIFOS IW IS LIKE H WEASET
MZTNIFOS IW IS LIKE H WEASET
MZTNIFOS IW IS LIKE H WEASET
MYTNIFOS IW IS LIKE H WEASEL
MYTNIFOS IW IS LIKE H WEASEL
MYTNIFOS IW IS LIKE H WEASEL
MYTNIFOS IT IS LIKE H WEASEL
MYTNIFOS IT IS LIKE H WEASEL
MYTNIFOS IT IS LIKE H WEASEL
MYTNIFOS IT IS LIKE H WEASEL
MPTNIFOS IT IS LIKE H WEASEL
MPTNIFOS IT IS LIKE H WEASEL
MPTNIFOS IT IS LIKE H WEASEL
MPTNIFOS IT IS LIKE H WEASEL
MPTNIFOS IT IS LIKE H WEASEL
MPTNIFOS IT IS LIKE H WEASEL
MPTNIFOS IT IS LIKE H WEASEL
MPTNIFOS IT IS LIKE H WEASEL
MRTNIFOS IT IS LIKE H WEASEL
MRTNIFOS IT IS LIKE H WEASEL
MRTDIFOS IT IS LIKE H WEASEL
MRTDIFOS IT IS LIKE H WEASEL
MNTDIMOS IT IS LIKE H WEASEL
MNTDIMOS IT IS LIKE R WEASEL
MNTDIM S IT IS LIKE R WEASEL
MNTDIM S IT IS LIKE R WEASEL
MNTDIM S IT IS LIKE R WEASEL
MNTDIM S IT IS LIKE R WEASEL
MNTDIM S IT IS LIKE R WEASEL
MNTDIN S IT IS LIKE R WEASEL
MNTDIN S IT IS LIKE R WEASEL
MNTDIN S IT IS LIKE R WEASEL
MNTDIN S IT IS LIKE R WEASEL
MNTDIN S IT IS LIKE R WEASEL
MNTDIN S IT IS LIKE R WEASEL
MNTDIN S IT IS LIKE R WEASEL
MSTDIN S IT IS LIKE R WEASEL
MSTDIN S IT IS LIKE R WEASEL
MSTDIN S IT IS LIKE R WEASEL
MSTDIN S IT IS LIKE R WEASEL
MSTDIN S IT IS LIKE R WEASEL
MSTDIN S IT IS LIKE R WEASEL
MSTDIN S IT IS LIKE R WEASEL
MSTDIN S IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE R WEASEL
MSTDINES IT IS LIKE A WEASEL
MSTDINES IT IS LIKE A WEASEL
MSTDINUS IT IS LIKE A WEASEL
MSTDINUS IT IS LIKE A WEASEL
MSTDINUS IT IS LIKE A WEASEL
MSTDINUS IT IS LIKE A WEASEL
MSTDINUS IT IS LIKE A WEASEL
MSTDINUS IT IS LIKE A WEASEL
MSTDINUS IT IS LIKE A WEASEL
MSTDINUS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTDINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINLS IT IS LIKE A WEASEL
MSTHINHS IT IS LIKE A WEASEL
MSTHINHS IT IS LIKE A WEASEL
MSTHINHS IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHIN S IT IS LIKE A WEASEL
MSTHINFS IT IS LIKE A WEASEL
MSTHINFS IT IS LIKE A WEASEL
MSTHINFS IT IS LIKE A WEASEL
MSTHINFS IT IS LIKE A WEASEL
MSTHINFS IT IS LIKE A WEASEL
MSTHINFS IT IS LIKE A WEASEL
MSTHINFS IT IS LIKE A WEASEL
MSTHINFS IT IS LIKE A WEASEL
MSTHINNS IT IS LIKE A WEASEL
MSTHINNS IT IS LIKE A WEASEL
MSTHINNS IT IS LIKE A WEASEL
MSTHINNS IT IS LIKE A WEASEL
METHINNS IT IS LIKE A WEASEL
METHINNS IT IS LIKE A WEASEL
METHINNS IT IS LIKE A WEASEL
METHINNS IT IS LIKE A WEASEL
METHINNS IT IS LIKE A WEASEL
METHINNS IT IS LIKE A WEASEL
METHINKS IT IS LIKE A WEASEL
METHINKS IT IS LIKE A WEASEL
Target found using 199 mutations.