File Coverage

lib/Algorithm/MasterMind/Partition_Worst.pm

Criterion	Covered	Total	%
statement	57	59	96.6
branch	8	10	80.0
condition			n/a
subroutine	9	9	100.0
pod	3	3	100.0
total	77	81	95.0

package Algorithm::MasterMind::Partition_Worst;

use warnings;
use strict;
use Carp;

use lib qw(../../lib ../../../lib);

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

use base 'Algorithm::MasterMind';

use Algorithm::MasterMind qw( partitions );

sub initialize {
  my $self = shift;
  my $options = shift;
  for my $o ( keys %$options ) {
    $self->{"_$o"} = $options->{$o};
  }
  $self->{'_partitions'} = {};
}

sub issue_first {
  my $self = shift;
  my @combinations = $self->all_combinations();
  $self->{'_consistent'} = \@combinations;
  return $self->{'_last'} = $self->issue_first_Knuth();

}

sub issue_next {
  my $self = shift;
  my $rules =  $self->number_of_rules();

  # Check consistency
  for ( my $i = 0; $i <= $#{$self->{'_consistent'}}; $i++ ) {
     my $match = $self->matches($self->{'_consistent'}->[$i]);
     $self->{'_evaluated'}++;
     if ( $match->{'matches'} < $rules ) {
       delete $self->{'_consistent'}->[$i];
     }
  }

  #Eliminate null
  @{$self->{'_consistent'}} = grep( $_, @{$self->{'_consistent'}} );

  if ( @{$self->{'_consistent'}}  > 1 ) {
    # Compute partitions
    my $partitions  = partitions( @{$self->{'_consistent'}} );

    # Obtain best
    my %min_c;
    my $min_max = keys %$partitions ;
    for my $c ( keys %$partitions ) {
      my $this_max = 0;
      for my $p ( keys %{$partitions->{$c}} ) {
	if ( $partitions->{$c}{$p} > $this_max ) {
	  $this_max = $partitions->{$c}{$p};
	}
      }
      $min_c{ $c } = $this_max;
      if ( $this_max < $min_max ) {
	$min_max = $this_max;
      }
    }

    # Find all partitions with that max
    my @minimal_c = grep( $min_c{$_} == $min_max, keys %min_c );

    # Break ties
    my $string = $minimal_c[ rand( @minimal_c )];
    # Obtain next
    if ( $string eq '' ) {
      warn "Something is wrong\n";
    }
    return  $self->{'_last'} = $string;
  } else {
    return  $self->{'_last'} = $self->{'_consistent'}->[0];
  }
}

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

__END__