view release on metacpan or  search on metacpan

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

package Algorithm::MasterMind::EDA_Partitions;

use warnings;
use strict;
use Carp;

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

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

use base 'Algorithm::MasterMind::EDA';

use Algorithm::MasterMind qw(partitions);


sub issue_next {
  my $self = shift;
  my $rules =  $self->number_of_rules();
  my @alphabet = @{$self->{'_alphabet'}};
  my $length = $self->{'_length'};
  my $pop = $self->{'_pop'};
  my $eda = $self->{'_eda'};
  map( $_->evaluate( $self->{'_fitness'}), @$pop );
  my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;

  my %consistent;
#   print "Consistent in ", scalar keys %{$self->{'_consistent'}}, "\n";
  if (  $self->{'_consistent'} ) { #Check for consistency
    %consistent = %{$self->{'_consistent'}};
    for my $c (keys %consistent ) {
      my $match = $self->matches( $c );
      if ( $match->{'matches'} < $rules ) {
	delete $consistent{$c};
      }
    }
  } else {
    %consistent = ();
  }
#  print "Consistent out ", scalar keys %consistent, "\n";
  
  while ( $ranked_pop[0]->{'_matches'} == $rules ) {
    $consistent{$ranked_pop[0]->{'_str'}} = $ranked_pop[0];
    shift @ranked_pop;
  }
  my $generations_equal = 0;
  # The 20 was computed in NICSO paper, valid for normal mastermind
  my $number_of_consistent = keys %consistent;
  
#  print "Consistent new ", scalar keys %consistent, "\n";
  while (  $number_of_consistent < 20 ) {
    my $this_number_of_consistent = $number_of_consistent;
    $eda->apply( $pop );
    for my $p( @$pop ) { 
      my $matches = $self->matches( $p->{'_str'} );
#      print "* ", $p->{'_str'}, " ", $matches->{'matches'}, "\n";      
      if ( $matches->{'matches'} == $rules ) {
#	print "Combination  ", $p->{'_str'}, " matches ", $p->{'_matches'}, "\n";
	$consistent{$p->{'_str'}} = $p;
      }
    } 
    $number_of_consistent = keys %consistent;
    if ( $this_number_of_consistent == $number_of_consistent ) {
      $generations_equal++;