Algorithm::Genetic

$ rakupp install Algorithm::Genetic

use Algorithm::Genetic;
use Algorithm::Genetic::Genotype;   # for the `is mutable` trait

class Eq does Algorithm::Genetic::Genotype {
    has Int $.a is rw is mutable({ (^20).pick });
    has Int $.b is rw is mutable({ (^20).pick });
    method !calc-score { -(($!a + $!b - 17).abs) }
    method new-random { self.new(a => (^20).pick, b => (^20).pick) }
}

class Search does Algorithm::Genetic {
    method is-finished { self.population.max(*.score).score >= 0 }
    method selection-strategy(Int $selection = 2) {
        self.population.sort(*.score).tail($selection)
    }
}

my $ga = Search.new(
    population-size       => 40,
    crossover-probability => 7/10,
    mutation-probability  => 8/10,
    genotype              => Eq.new(a => 0, b => 0),
);
say 'generation before : ', $ga.generation;
say 'population before : ', $ga.population.elems;
$ga.evolve(generations => 200);
say '';
say 'after evolve:';
say '  generation        : ', 0 < $ga.generation <= 200;
say '  population size   : ', $ga.population.elems;
say '  every member is Eq: ', so $ga.population.all ~~ Eq;
say '  best score <= 0   : ', $ga.population.max(*.score).score <= 0;

use Algorithm::Genetic;
use Algorithm::Genetic::Genotype;

class Eq does Algorithm::Genetic::Genotype {
    has Int $.a is rw is mutable({ (^20).pick });
    method !calc-score { -(($!a - 9).abs) }
    method new-random { self.new(a => (^20).pick) }
}
class Search does Algorithm::Genetic {
    method is-finished { False }
    method selection-strategy(Int $selection = 2) {
        self.population.sort(*.score).tail($selection)
    }
}

my ($sorted, $tail-best) = 0, 0;
for ^30 {
    my $ga = Search.new(population-size => 20, crossover-probability => 7/10,
                        mutation-probability => 1/10, genotype => Eq.new(a => 0));
    $ga.evolve(generations => 5);
    my @p = $ga.population;
    $sorted++    if @p».score eqv @p».score.sort;
    $tail-best++ if @p.tail.score == @p.max(*.score).score;
}
say 'over 30 runs of 5 generations each:';
say '  population sorted afterwards : ', $sorted, ' of 30';
say '  .tail is the best-scoring    : sometimes, by luck — never rely on it';
say '';
say 'read the answer with .population.max(*.score), never with .tail.';

use Algorithm::Genetic;

say 'two things the examples above do deliberately.';
say '';
say 'first, `use Algorithm::Genetic::Genotype` as well — the `is mutable`';
say 'trait is exported from THAT unit, and Rakudo will not compile an';
say 'attribute carrying it without the second use line.';
say '';
say 'second, they supply selection-strategy directly rather than composing';
say 'Selection::Roulette. Composing both roles trips';
say 'Algorithm::Genetic`s own required-method check before Roulette has';
say 'supplied the method, whichever order you write them in.';
say '';
say 'Algorithm::Genetic and friends are ROLES, not classes — punning is';
say 'not usable, and only Rakudo tells you why ("Method is-finished must';
say 'be implemented").';
say '';
say '`is mutable` requires a Callable — `is mutable(42)` dies with the';
say 'module`s own message, spelling and all.';
say '';
say '.score CACHES on first call, so a mutated genotype keeps a stale';
say 'score until you call .re-score. crossover calls .?re-score on the';
say 'children; mutate does not.';
say '';
say '!sort-population sorts ASCENDING and Roulette selects from the top of';
say 'that order — so HIGHER score means fitter. The distribution`s own';
say 'example scores with a squared error, where lower is better, which';
say 'inverts the search. Negate your error.';
say '';
say 'and evolve only re-initialises when the population is EMPTY, so';
say 'calling it twice continues rather than restarts.';

use Algorithm::Genetic;

say 'the Array-gene path is unreachable. crossover claims to handle';
say 'Array-typed attributes recursively and calls self!crossover-nested,';
say 'but the method that exists is named !crossover-array — so any';
say 'genotype with an Array attribute dies on its first crossover.';
say '';
say '(and !crossover-array is itself broken even if it were reached:';
say '$a[$i], $b[$i] = $b[$i], $a[$i] does not swap.)';
say '';
say 'keep your genes scalar.';
say '';
say 'the second one is scoping rather than dead code: `my @mutators`';
say 'lives once per compunit of Genotype.rakumod, and the exported';
say '`is mutable` trait pushes into it — so EVERY genotype class in the';
say 'program shares one mutator list, and mutate runs other classes`';
say 'mutators against your object. Two genotype classes in one program is';
say 'fatal on Rakudo and silent on Raku++.';
say '';
say 'one genotype class per program.';