view release on metacpan or  search on metacpan

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

package Algorithm::MasterMind::EvoRank;

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.15 $ =~ /(\d+)\.(\d+)/g; 

use base 'Algorithm::MasterMind::Evolutionary_Base';

use Algorithm::MasterMind qw(partitions);

use Algorithm::Evolutionary qw(Op::QuadXOver
			       Op::String_Mutation
			       Op::Permutation
			       Op::Crossover
			       Op::Canonical_GA_NN
			       Individual::String );

use Clone::Fast 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 => 50,
	       MAX_GENERATIONS_EQUAL => 3} ;

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 $xover_rate = $options->{'xover_rate'} || 2;
  my $permutation_rate = $options->{'permutation_rate'} || 0;
  my $max_number_of_consistent = $options->{'consistent_set_card'} || MAX_CONSISTENT_SET;   
  my $m = new Algorithm::Evolutionary::Op::String_Mutation $mutation_rate ; # Rate = 1
  my $c = Algorithm::Evolutionary::Op::QuadXOver->new( 1, $xover_rate ); 
  my $operators = [$m,$c];
  if ( $permutation_rate > 0 ) {
    my $p =  new Algorithm::Evolutionary::Op::Permutation $permutation_rate; 
    push @$operators, $p;
  }
  if (! $self->{'_ga'} ) { # Not given as an option
    $self->{'_ga'} = new Algorithm::Evolutionary::Op::Canonical_GA_NN( $options->{'replacement_rate'},
								       $operators );    
  }

  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'}: