view release on metacpan or  search on metacpan

lib/Algorithm/Genetic/Diploid/Population.pm  view on Meta::CPAN

package Algorithm::Genetic::Diploid::Population;
use strict;
use List::Util qw'sum shuffle';
use Algorithm::Genetic::Diploid::Base;
use base 'Algorithm::Genetic::Diploid::Base';

my $log = __PACKAGE__->logger;

=head1 NAME

Algorithm::Genetic::Diploid::Population - A population of individuals that turns over

=head1 METHODS

=over

=item new

Constructor takes named arguments, creates a default, empty list of individuals

=cut

sub new {
	shift->SUPER::new(
		'individuals' => [],
		@_,
	);
}

=item individuals

Getter and setter for the list of individuals

=cut

sub individuals {
	my $self = shift;
	if ( @_ ) {
		$self->{'individuals'} = \@_;
		$log->debug("assigning ".scalar(@_)." individuals to population");
	}
	return @{ $self->{'individuals'} };
}

=item turnover

Moves the population on to the next generation, i.e.
1. compute fitness of all individuals
2. mate up to reproduction rate in proportion to fitness

=cut

sub turnover {
	my ( $self, $gen, $env, $optimum ) = @_;
	my $log = $self->logger;
	$log->debug("going to breed generation $gen against optimum $optimum");
	
	# sort all individuals by fitness, creates array refs 
	# where 0 element is Individual, 1 element is its fitness
	my @fittest = sort { $a->[1] <=> $b->[1] } 
	               map { [ $_, $_->fitness($optimum,$env) ] } 
	               $self->individuals;
	$log->debug("sorted current generation by fitness");
	$log->info("*** fittest at generation $gen: ".$fittest[0]->[0]->phenotype($env));
	               
	# get the highest index of Individual 
	# that still gets to reproduce
	my $maxidx = int( $self->experiment->reproduction_rate * $#fittest );
	$log->debug("individuals up to index $maxidx will breed");
	
	# take the slice of Individuals that get to reproduce
	my @breeders = @fittest[ 0 .. $maxidx ];
	$log->debug("number of breeders: ".scalar(@breeders));
	
	# compute the total fitness, to know how much each breeder gets to
	# contribute to the next generation
	my $total_fitness = sum map { $_->[1] } @breeders;
	$log->debug("total fitness is $total_fitness");
	
	# compute the population size, which we need to divide up over the
	# breeders in proportion of their fitness relative to total fitness
	my $popsize = scalar $self->individuals;
	$log->debug("population size will be $popsize");