view release on metacpan or  search on metacpan

lib/Algorithm/Evolutionary/Op/GeneralGeneration.pm  view on Meta::CPAN

use strict;
use warnings;

=head1 NAME

Algorithm::Evolutionary::Op::GeneralGeneration - Customizable single generation for an evolutionary algorithm.
                 
=head1 SYNOPSIS

  #Taken from the t/general.t file, verbatim
  my $m = new Algorithm::Evolutionary::Op::Bitflip; #Changes a single bit
  my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover
  my $replacementRate = 0.3; #Replacement rate
  use Algorithm::Evolutionary::Op::RouletteWheel;
  my $popSize = 20;
  my $selector = new Algorithm::Evolutionary::Op::RouletteWheel $popSize; #One of the possible selectors
  use Algorithm::Evolutionary::Op::GeneralGeneration;
  my $onemax = sub { 
    my $indi = shift;
    my $total = 0;
    for ( my $i = 0; $i < $indi->length(); $i ++ ) {
      $total += substr( $indi->{_str}, $i, 1 );
    }
    return $total;
  };
  my @pop;
  my $numBits = 10;
  for ( 0..$popSize ) {
    my $indi = new Algorithm::Evolutionary::Individual::BitString $numBits ; #Creates random individual
    my $fitness = $onemax->( $indi );
    $indi->Fitness( $fitness );
    push( @pop, $indi );
  }
  my $generation = 
    new Algorithm::Evolutionary::Op::GeneralGeneration( $onemax, $selector, [$m, $c], $replacementRate );
  my @sortPop = sort { $a->Fitness() <=> $b->Fitness() } @pop;
  my $bestIndi = $sortPop[0];
  $generation->apply( \@sortPop );
 
=head1 Base Class

L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>

=head1 DESCRIPTION

Genetic algorithm that uses the other component. Must take as input the operators thar are going to be
used, along with its priorities

=head1 METHODS

=cut

package Algorithm::Evolutionary::Op::GeneralGeneration;

use lib qw(../../..);

our $VERSION = '3.2';

use Carp;

use base 'Algorithm::Evolutionary::Op::Base';

use Algorithm::Evolutionary::Wheel;

# Class-wide constants
our $APPLIESTO =  'ARRAY';
our $ARITY = 1;

=head2 new( $evaluation_function, $selector, $ref_to_operator_array, $replacement_rate )

Creates an algorithm, with the usual operators. Includes a default mutation
and crossover, in case they are not passed as parameters

=cut

sub new {
  my $class = shift;
  my $self = {};
  $self->{'_eval'} = shift || croak "No eval function found";
  $self->{'_selector'} = shift || croak "No selector found";
  $self->{'_ops'} = shift || croak "No operator found";