view release on metacpan or  search on metacpan

lib/Algorithm/Evolve.pm  view on Meta::CPAN

package Algorithm::Evolve;

use strict;
use Carp qw/croak carp/;
use List::Util qw/shuffle/;

our (%SELECTION, %REPLACEMENT);
our $VERSION = '0.03';
our $DEBUG   = 0;

my $rand_max = (1 << 31); ## close enough

###########################

sub debug {
    print @_, "\n" if $DEBUG;
}

sub new {
    my $pkg = shift;

    my $p = bless {
        generations      => 0,
        parents_per_gen  => 2,
        @_
    }, $pkg;
   
    $p->{random_seed}      ||= int(rand $rand_max);
    srand( $p->random_seed );

    $p->{selection}        ||= $p->{replacement};
    $p->{replacement}      ||= $p->{selection};
    $p->{children_per_gen} ||= $p->{parents_per_gen};

    $p->_validate_args;

    return $p;
}

sub _validate_args {
    my $p = shift;
    
    {
        no strict 'refs';
        croak "Invalid selection/replacement criteria"
            unless *{"Algorithm::Evolve::selection::" . $p->selection}{CODE}
               and *{"Algorithm::Evolve::replacement::" . $p->replacement}{CODE};
    }

    croak "Please specify the size of the population" unless $p->size;
    croak "parents_per_gen must be even" if $p->parents_per_gen % 2;
    croak "parents_per_gen must divide children_per_gen"
        if $p->children_per_gen % $p->parents_per_gen;
    croak "parents_per_gen and children_per_gen must be no larger than size"
        if $p->children_per_gen > $p->size
        or $p->parents_per_gen  > $p->size;
        
    $p->{children_per_parent} = $p->children_per_gen / $p->parents_per_gen;

}

############################

sub start {
    my $p = shift;
    $p->_initialize;
        
    until ($p->is_suspended) {
        no strict 'refs';
        
        my @parent_indices
            = ("Algorithm::Evolve::selection::" . $p->selection)
                ->($p, $p->parents_per_gen);

        my @children;