view release on metacpan or  search on metacpan

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

package Algorithm::Genetic::Diploid::Experiment;
use strict;
use Algorithm::Genetic::Diploid;
use base 'Algorithm::Genetic::Diploid::Base';

my $log = __PACKAGE__->logger;

=head1 NAME

Algorithm::Genetic::Diploid::Experiment - manages an evolutionary experiment

=head1 METHODS

=over

=item new

Constructor takes named arguments. Provides defaults for C<mutation_rate> (0.05), 
C<crossover_rate> (0.60), C<reproduction_rate> (0.35) and C<ngens> (50).

=cut

sub new {
	shift->SUPER::new(
		'mutation_rate'     => 0.05,
		'crossover_rate'    => 0.60,
		'reproduction_rate' => 0.35,
		'ngens'             => 50,
		'factory'           => Algorithm::Genetic::Diploid::Factory->new,
		'population'        => undef,
		'env'               => undef,
		@_
	);
}

=item initialize

Sets up the experiment based on the provided arguments:

 'individual_count' => number of individuals in the population, default is 50
 'chromosome_count' => number of chromosome pairs per individual, default is 1
 'gene_count'       => number of genes per chromosome, default is 1

=cut

sub initialize {
	my $self = shift;
	my %args = ( 
		'individual_count' => 50,
		'chromosome_count' => 1,
		'gene_count'       => 1,
		@_
	);
	my $fac = $self->factory;
	my $pop = $fac->create_population;
	
	# create individuals 
	my @individuals;
	for my $i ( 1 .. $args{'individual_count'} ) {
		push @individuals, $fac->create_individual( 'experiment' => $self );
		
		# create chromosomes in homologous pairs
		my @chromosomes;
		for my $j ( 1 .. $args{'chromosome_count'} ) {
			for ( 1 .. 2 ) {
				push @chromosomes, $fac->create_chromosome( 
					'number'     => $j,
					'experiment' => $self,
				);
			
				# create genes
				my @genes;
				for my $k ( 1 .. $args{'gene_count'} ) {
					push @genes, $fac->create_gene(
						'experiment' => $self,
					);
				}
				$chromosomes[-1]->genes(@genes);
			}
		}
		$individuals[-1]->chromosomes(@chromosomes);
	}
	$pop->individuals(@individuals);
	$self->population($pop);