view release on metacpan or  search on metacpan

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

    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;
        while (@parent_indices) {
            my @parents = @{$p->critters}[ splice(@parent_indices, 0, 2) ];
            
            push @children, $p->critter_class->crossover(@parents)
                for (1 .. $p->children_per_parent);
        }

        $_->mutate for @children;
    
        my @replace_indices
            = ("Algorithm::Evolve::replacement::" . $p->replacement)
                ->($p, $p->children_per_gen);

        ## place the new critters first, then sort. maybe fixme:
        
        @{$p->critters}[ @replace_indices ] = @children;
        @{$p->fitnesses}[ @replace_indices ] = () if $p->use_fitness;
        
        $p->_sort_critters;

        $p->{generations}++;    
        $p->callback->($p) if (ref $p->callback eq 'CODE');
    }
}

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

sub suspend {
    my $p = shift;
    $p->{is_suspended} = 1;
}

sub resume {
    my $p = shift;
    $p->{is_suspended} = 0;
    $p->start;
}

sub best_fit {
    my $p = shift;
    carp "It's hard to pick the most fit when fitness is relative!"
        unless ($p->use_fitness);
    $p->critters->[-1];
}

sub avg_fitness {
    my $p = shift;
    my $sum = 0;
    $sum += $_ for @{$p->fitnesses};
    return $sum / $p->size;
}

sub selection {
    my ($p, $method) = @_;
    return $p->{selection} unless defined $method;
    $p->{selection} = $method;
    $p->_validate_args;
    return $p->{selection};
}

sub replacement {
    my ($p, $method) = @_;
    return $p->{replacement} unless defined $method;
    $p->{replacement} = $method;
    $p->_validate_args;
    return $p->{replacement};
}

sub parents_children_per_gen {
    my ($p, $parents, $children) = @_;
    return unless defined $parents and defined $children;
    $p->{parents_per_gen} = $parents;
    $p->{children_per_gen} = $children;
    $p->_validate_args;
}

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

sub _initialize {
    my $p = shift;
    return if defined $p->critters;
    
    $p->{critters}    = [ map { $p->critter_class->new } 1 .. $p->size ];
    $p->{use_fitness} = !! $p->critters->[0]->can('fitness');
    $p->{fitnesses}   = [ map { $p->critters->[$_]->fitness } 0 .. $p->size-1 ]
        if ($p->use_fitness);

    $p->_sort_critters;
}


sub _sort_critters {
    my $p = shift;

    return unless $p->use_fitness;

    my $fitnesses = $p->fitnesses;
    my $critters = $p->critters;
    for (0 .. $p->size-1) {

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

B<tournament_size>, only required if you choose tournament 
selection/replacement. Should be at least 4 unless you know what you're doing.

B<max_gladitorial_attempts>: Because comparisons in gladitorial selection may
result in a tie, this is the number of ties permitted before giving up and
picking critters at random instead during that breeding event. The first time
this occurs, the module will C<carp> a message.

B<parents_per_gen> and B<children_per_gen> control the number of breedings per 
generation. children_per_gen must be a multiple of parents_per_gen. 
parents_per_gen must also be an even number. Each pair of parents selected in a 
generation will produce the same number of children, calling the crossover 
method in the critter class as many times as necessary. Basically, each 
selected parent gets a gene copy count of children_per_gen/parents_per_gen. 

You may omit children_per_gen, it will default to equal parents_per_gen. If
you omit both options, they will default to 2.

In tournament and gladitorial selection, children_per_gen must be equal to
parents_per_gen. The number of tournaments each generation is equal to
parents_per_gen/2.

B<size>, the number of critters to have in the population.

B<callback>, an optional (but highly recommended) reference to a function. It 
should expect one argument, the population object. It is called after each 
generation. You may find it useful for printing out current statistical 
information. You must also use it if you intend to stop the algorithm after a 
certain number of generations (or some other criteria).

B<random_seed>, an optional number that will be fed to C<srand> before the 
algorithm starts. Use this to reproduce previous results. If this is not given, 
Algorithm::Evolve will generate a random seed that you can retrieve.


=item C<$p-E<gt>size()>

Returns the size of the population, as given above. As of now, you cannot
change the population's size during the runtime of the evolutionary algorithm.

=item C<$p-E<gt>run()>

Begins execution of the algorithm, and returns when the population has been 
C<suspend>'ed.

=item C<$p-E<gt>suspend()>

Call this method from within the callback function to stop the algorithm's 
iterations and return from the C<run> method.

=item C<$p-E<gt>resume()>

Start up the algorithm again after being C<suspend>'ed.

=item C<$p-E<gt>generations()>

=item C<$p-E<gt>avg_fitness()>

=item C<$p-E<gt>best_fit()>

These return basic information about the current state of the population. You 
probably will use these methods from within the callback sub. The best_fit 
method returns the most-fit critter in the population.

=item C<$p-E<gt>critters()>

Returns a reference to an array containing all the critters in the population, 
sorted by increasing fitness. You can use this to iterate over the entire
population, but please don't modify the array.

=item C<$p-E<gt>fitnesses()>

Returns a reference to an array containing all the fitnesses of the
population (in increasing order), if appropriate. The order of this array
corresponds to the order of the critters array. You might use this if you
write your own seleciton and replacement methods. Please don't modify the
array.

=item C<$p-E<gt>random_seed()>

Returns the random seed that was used for this execution.

=item C<$p-E<gt>selection( [ $new_method ] )>

=item C<$p-E<gt>replacement( [ $new_method ] )>

Fetch or change the selection/replacement method while the algorithm is
running.

=item C<$p-E<gt>parents_children_per_gen($parents, $children)>

Changes the parents_per_gen and children_per_gen attributes of the population
while the algorithm is running. Both are changed at once because the latter
must always be a multiple of the former.

=back


=head2 Co-Evolution

When there is no absolute measure of fitness for a problem, and a critter's
fitness depends on the other memebers of the population, this is called
B<co-evolution>. A good example of such a problem is rock-paper-scissors. If
we were to evolve strategies for this game, any strategy's success would be
dependent on what the rest of the population is doing.

To perform such an evolutionary algorithm, implement the C<compare> method
in your critter class and choose gladitorial selection and replacement. 
Gladitorial selection/replacement chooses random pairs of critters and
C<compare>s them. If the result is not a tie, the winner receives reproduction
rights, and the loser is chosen for replacement. This happens until the
desired number of parents have been selected, or until a timeout occurs.

=head2 Adding Selection/Replacement Methods

To add your own selection and replacement methods, simply declare them in
the C<Algorithm::Evolve::selection> or C<Algorithm::Evolve::replacement> 
namespaces, respectively. The first argument will be the population object,
and the second will be the number of critters to choose for
selection/replacement. You should return a list of the I<indices> you chose.

    use Algorithm::Evolve;