view release on metacpan or  search on metacpan

lib/Algorithm/MasterMind/Evo.pm  view on Meta::CPAN

package Algorithm::MasterMind::Evo;

use warnings;
use strict;
use Carp;

use lib qw(../../lib ../../../../Algorithm-Evolutionary/lib/ 
	   ../../Algorithm-Evolutionary/lib/
	   ../../../lib);

our $VERSION =   sprintf "%d.%03d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/g; 

use base 'Algorithm::MasterMind::Evolutionary_Base';
use Algorithm::MasterMind qw(partitions);

use Algorithm::Evolutionary qw(Op::String_Mutation
			       Op::Permutation
			       Op::Uniform_Crossover_Diff
			       Op::Breeder_Diverser
			       Op::Replace_Different
			       Op::Tournament_Selection
			       Individual::String );

use Algorithm::Combinatorics qw(permutations);
use Algorithm::MasterMind::Partition::Most;
use Clone qw(clone);

# ---------------------------------------------------------------------------
use constant { MAX_CONSISTENT_SET => 20, # This number 20 was computed in NICSO paper, valid for default 4-6 mastermind
	       MAX_GENERATIONS_RESET => 100,
	       MAX_GENERATIONS_EQUAL => 3} ;

sub factorial {
  my $value = shift;
  my $factorial = 1;
  $factorial *= $_ foreach 1..$value;
  return $factorial;
}


sub initialize {
  my $self = shift;
  my $options = shift;
  for my $o ( keys %$options ) {
    $self->{"_$o"} = clone($options->{$o});
  }
  croak "No population" if $self->{'_pop_size'} == 0;

  # Variation operators
  my $mutation_rate = $options->{'mutation_rate'} || 1;
  my $permutation_rate = $options->{'permutation_rate'} || 0;
  my $permutation_iters = $options->{'permutation_iterations'} || factorial($options->{'length'}) - 1 ;
  my $xover_rate = $options->{'xover_rate'} || 1;
  my $max_number_of_consistent = $options->{'consistent_set_card'} 
    || MAX_CONSISTENT_SET;  
  $self->{'_replacement_rate'}= $self->{'_replacement_rate'} || 0.25;
  my $m = new Algorithm::Evolutionary::Op::String_Mutation $mutation_rate ; # Rate = 1
  my $c = Algorithm::Evolutionary::Op::Uniform_Crossover_Diff->new( $options->{'length'}/2, $xover_rate ); 
  my $operators = [$m,$c];
  if ( $permutation_rate > 0 ) {
    my $p =  new Algorithm::Evolutionary::Op::Permutation $permutation_rate, $permutation_iters; 
    push @$operators, $p;
  }
  my $select = new Algorithm::Evolutionary::Op::Tournament_Selection $self->{'_tournament_size'} || 2;
  if (! $self->{'_ga'} ) { # Not given as an option
    $self->{'_ga'} = new Algorithm::Evolutionary::Op::Breeder_Diverser( $operators, $select );    
  }