view release on metacpan or  search on metacpan

examples/rock_paper_scissors.pl  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;

## this example script has POD -- check it out!

use StringEvolver alphabet => [qw/R P S/], mutation_rate => 0.05;
our @ISA = ('StringEvolver');

use lib '../lib';
use Algorithm::Evolve;

sub compare {
    my ($class, $crit1, $crit2) = @_;

    my ($string1, $string2) = ($crit1->gene, $crit2->gene);
    my ($score1, $score2)   = (0, 0);
    my $length              = length($string1);
    my $offset1             = int rand $length;
    my $offset2             = int rand $length;

    ## .. and wrap around
    $string1 x= 2;
    $string2 x= 2;

    for (1 .. $length) {
        my $char1 = substr($string1, $offset1++, 1);
        my $char2 = substr($string2, $offset2++, 1);

        next if $char1 eq $char2; ## tie

        if (($char1 eq 'R' && $char2 eq 'S') or
            ($char1 eq 'S' && $char2 eq 'P') or
            ($char1 eq 'P' && $char2 eq 'R'))
        {
            $score1++;
        } else {
            $score2++;
        }
    }

    return $score1 <=> $score2;
}

sub callback {
    my $p = shift;
    my %occurences;

    for (@{$p->critters}) {
        my $gene = $_->gene;
        $occurences{R} += $gene =~ tr/R/R/;
        $occurences{P} += $gene =~ tr/P/P/;
        $occurences{S} += $gene =~ tr/S/S/;
    }
    print "$occurences{R} $occurences{P} $occurences{S}\n";

    $p->suspend if $p->generations >= 1000;
}

my $p = Algorithm::Evolve->new(
    critter_class    => 'main',
    selection        => 'gladitorial',
    parents_per_gen  => 10,
    size             => 80,
    callback         => \&callback,
    random_seed      => shift
);

$p->start;