Algorithm-Genetic-Diploid

 view release on metacpan or  search on metacpan

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

=over

=item new

Constructor takes named arguments. Creates a default list of genes and chromosome number.

=cut

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

=item genes

Sets and gets list of genes on the chromosome

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

=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,
		@_
	);
}

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

=over

=item new

Constructor takes named arguments, sets a default value of 1 for the weight

=cut

sub new {
	shift->SUPER::new(
		'weight' => 1,
		@_,
	);
}

=item function

The gene function is a subroutine ref that results in a gene product (representing some
component of fitness) based on environmental input

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

=over

=item new

Constructor takes named arguments, sets a default, empty list of chromosomes and
a default child count of zero

=cut

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

=item child_count

Getter for the number of children

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

=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

t/run.t  view on Meta::CPAN

Test::More::isa_ok( __PACKAGE__, 'Algorithm::Genetic::Diploid::Experiment' );

# whatever this number is, the algorithm will try to optimize towards it
sub optimum { 0 }

##########################################################################################
package MockGene;
use base 'Algorithm::Genetic::Diploid::Gene';
Test::More::isa_ok( __PACKAGE__, 'Algorithm::Genetic::Diploid::Gene' );

sub new { shift->SUPER::new( 'weight' => ( 1 + int rand 100 ) ) }

sub make_function {
	my $self = shift;
	
	# this function must return a value that the algorithm will try
	# to evolve towards MockExperiment::optimum. In this case the
	# difference between the "environment", which is a number that
	# is passed in, and the weight, which evolves.
	sub { my $env = shift; return abs( $env - $self->weight ) }
}

##########################################################################################
package MockFactory;
use base 'Algorithm::Genetic::Diploid::Factory';
Test::More::isa_ok( __PACKAGE__, 'Algorithm::Genetic::Diploid::Factory' );

# the factory needs to be configured thusly so that it instantiates the right
# subclass instances - in this case the mock objects
sub new { shift->SUPER::new( 'experiment' => 'MockExperiment', 'gene' => 'MockGene' ) }

##########################################################################################
package main;

# avoid divide-by-zero failures
my $value = 1 + int rand 100;

my $experiment = MockExperiment->new( 
	'factory' => MockFactory->new, 
	'env'     => $value,