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 );    
  }
  $self->{'_replacer'} = new Algorithm::Evolutionary::Op::Replace_Different;

  if (!$self->{'_distance'}) {
    $self->{'_distance'} = 'distance_taxicab';
  }

  $self->{'_max_consistent'} = $max_number_of_consistent;
}

sub compute_fitness {
  my $pop = shift;
  #Compute min
  my $min_distance = 0;
  for my $p ( @$pop ) {
    $min_distance = ( $p->{'_distance'} < $min_distance )?
      $p->{'_distance'}:
	$min_distance;
  }

  for my $p ( @$pop ) {
    $p->Fitness( $p->{'_distance'}+
		 ($p->{'_partitions'}?$p->{'_partitions'}:0)-
		 $min_distance + 1);
  }
}
#----------------------------------------------------------------------------
sub eliminate_last_played {
  my $self = shift;
  my $last_played = $self->{'_last'};

  for my $p ( @{$self->{'_pop'}} ) {
    if ($p->{'_str'} eq $last_played ) {
      $p =  new Algorithm::Evolutionary::Individual::String( $self->{'_alphabet'}, $self->{'_length'} );
    }
  }
}


#----------------------------------------------------------------------------

sub issue_next {
  my $self = shift;
  my @rules =  @{$self->{'_rules'}};
  my @alphabet = @{$self->{'_alphabet'}};
  my $length = $self->{'_length'};