File Coverage

lib/Algorithm/MasterMind/CGA_Partitions.pm

Criterion	Covered	Total	%
statement	15	15	100.0
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	20	20	100.0

package Algorithm::MasterMind::CGA_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::Canonical_GA';

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 $cga = $self->{'_ga'};
  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;
    $cga->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++;
    } else {
      $generations_equal = 0;
    }

#    print "G $generations_equal $number_of_consistent \n";
    last if ( ( $generations_equal >= 3 ) && ( $number_of_consistent >= 1 ) );
  }

#  print "After GA combinations ", join( " ", keys %consistent ), "\n";
  $self->{'_consistent'} = \%consistent; #This mainly for outside info
  if ( $number_of_consistent > 1 ) {
#    print "Consistent ", scalar keys %consistent, "\n";
    #Use whatever we've got to compute number of partitions
    my $partitions = partitions( keys %consistent );

    my $max_partitions = 0;
    my %max_c;
    for my $c ( keys %$partitions ) {
      my $this_max =  keys %{$partitions->{$c}};
      $max_c{$c} = $this_max;
      if ( $this_max > $max_partitions ) {
	$max_partitions = $this_max;
      }
    }
    # Find all partitions with that max
    my @max_c = grep( $max_c{$_} == $max_partitions, keys %max_c );
    # Break ties
    my $string = $max_c[ rand( @max_c )];
    # Obtain next
    return  $self->{'_last'} = $string;
  } else {
    return $self->{'_last'} = (keys %consistent)[0];
  }

}

"Many blacks, 0 white"; # Magic true value required at end of module

__END__