File Coverage

lib/Algorithm/MasterMind/Consistent_Set.pm

Criterion	Covered	Total	%
statement	133	137	97.0
branch	14	16	87.5
condition			n/a
subroutine	19	20	95.0
pod	14	14	100.0
total	180	187	96.2

package Algorithm::MasterMind::Consistent_Set;

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

use Algorithm::MasterMind qw(partitions);
use Algorithm::MasterMind::Secret;

sub new {
  my $class = shift;
  my $combinations = shift;
  my @secrets = map ( (new Algorithm::MasterMind::Secret $_), @$combinations );
  my $self = {  _combinations => \@secrets,
		_partitions => {}};
  bless $self, $class;
  $self->{'_partitions'} = compute_partitions( \@secrets );
  $self->{'_score'} = {}; # To store scores when they're available.
  return $self;
}

sub compute_partitions {
  my $secrets_ref = shift;
  my @secrets = @$secrets_ref;
  my %partitions;
  my %hash_results;
  for ( my $i = 0; $i <= $#secrets; $i ++ ) {
    for (my $j = 0; $j <= $#secrets; $j ++ ) {
      next if $i == $j;
      my $result = { blacks => 0,
		     whites => 0 } ;
      if ( $i < $j  ) {
	$secrets[$i]->check_secret ( $secrets[$j], $result );
	$hash_results{$secrets[$i]->{'_string'}}{$secrets[$j] ->{'_string'}} = $result;
      } else {
	$result = $hash_results{$secrets[$j]->{'_string'}}{$secrets[$i] ->{'_string'}}
      }
      $partitions{$secrets[$i]->{'_string'}}{result_as_string($result)}++;
    }
  }
  return \%partitions
}

sub create_consistent_with {
  my $class = shift;
  my $combinations = shift;
  my $rules = shift;
  my @secrets = map ( (new Algorithm::MasterMind::Secret $_), @$combinations );
  my $self = {  _combinations => [],
		_partitions => {}};
  bless $self, $class;
  my %rule_secrets;
  map( ($rule_secrets{$_->{'combination'}} = new Algorithm::MasterMind::Secret $_->{'combination'}),
       @$rules );
  for my $s (@secrets ) {
    my $matches;
    for my $r (@$rules ) {
      my $this_result = { blacks => 0,
			  whites => 0 };
      $s->check_secret( $rule_secrets{$r->{'combination'}}, $this_result);
      $matches +=  result_as_string( $this_result ) eq result_as_string( $r );
    }
    if ( $matches == @$rules ) {
      push @{$self->{'_combinations'}}, $s
    }
  }
  $self->{'_partitions'} = compute_partitions( $self->{'_combinations'} );
  $self->{'_score'} = {}; # To store scores when they're available.
  return $self;
}

sub is_in {
  my $self = shift;
  my $combination = shift;
  return exists $self->{'_partitions'}{$combination};
}

sub add_combination {
  my $self = shift;
  my $new_combination = shift;
  return if $self->is_in( $new_combination );
  my $new_secret = new Algorithm::MasterMind::Secret $new_combination;
  for (my $i = 0; $i < @{$self->{'_combinations'}}; $i ++ ) {
    my $result = { blacks => 0,
		   whites => 0 };
    $self->{'_combinations'}[$i]->check_secret ( $new_secret, $result );
    $self->{'_partitions'}{$self->{'_combinations'}[$i]->{'_string'}}{result_as_string($result)}++;
    $self->{'_partitions'}{$new_combination}{result_as_string($result)}++;
  }
  push @{$self->{'_combinations'}}, $new_secret;
}

sub result_as_string {
  my $result = shift;
  return $result->{'blacks'}."b-".$result->{'whites'}."w";
}

sub partitions_for {
  my $self = shift;
  my $string = shift;
  return $self->{'_partitions'}->{$string};
}

sub cull_inconsistent_with {
  my $self = shift;
  my $string = shift;
  my $result = shift;

  my $secret = new Algorithm::MasterMind::Secret $string;
  my $result_string = result_as_string( $result );
  my @new_set;
  for my $s (@{$self->{'_combinations'}} ) {
    my $this_result = { blacks => 0,
			whites => 0 };
    $secret->check_secret( $s, $this_result);
#    print "Checking ", $s->string, " result " , result_as_string( $this_result), " with $result_string\n";
    if ( $result_string eq result_as_string($this_result) ) {
#      print "Added\n";
      push @new_set, $s;
    }
  }
  #Compute new partitions
  $self->{'_partitions'} = compute_partitions( \@new_set );
  $self->{'_combinations'} = \@new_set;
  $self->{'_score'} = {};
}

sub compute_most_score {
  my $self = shift;
  $self->{'_score'}->{'_most'} = {};
  for my $s (keys %{$self->{'_partitions'}} ) {
    $self->{'_score'}->{'_most'}->{$s} = keys %{$self->{'_partitions'}->{$s}};
  }
}

sub compute_entropy_score {
  my $self = shift;
  $self->{'_score'}->{'_entropy'} = {};
  for my $s (keys %{$self->{'_partitions'}} ) {
    my $sum;
    map( ($sum += $self->{'_partitions'}->{$s}->{$_}), keys %{$self->{'_partitions'}->{$s}} );
    my $entropy = 0;
    for my $k ( keys %{$self->{'_partitions'}->{$s}} ) {
      my $fraction = $self->{'_partitions'}->{$s}->{$k}/ $sum;
      $entropy -= $fraction * log( $fraction );
    }
    $self->{'_score'}->{'_entropy'}->{$s} = $entropy;
  }
}

sub score_most {
  my $self = shift;
  my $str = shift;
  return $self->{'_score'}->{'_most'}->{ $str };
}

sub score_entropy {
  my $self = shift;
  my $str = shift;
  return $self->{'_score'}->{'_entropy'}->{ $str };
}

sub top_scorers {
  my $self = shift;
  my $score = "_".shift; # No checks
  my @keys = keys %{$self->{'_partitions'}};
  my @top_scorers;
  if ( $#keys > 1 ) {
    my $top_score = 0;
    for my $s ( @keys  ) {
      my $this_score = $self->{'_score'}->{$score}->{ $s } ;
      if ( $this_score > $top_score ) {
	$top_score = $this_score;
      }
    }
    for my $s ( @keys  ) {
      if ( $self->{'_score'}{$score}->{ $s }  == $top_score ) {
	push @top_scorers, $s;
      }
    }
  } else { # either 0 or 1
    @top_scorers = @keys;
  }
  return @top_scorers;
}

sub consistent_strings {
  return keys %{shift->{'_partitions'}};
}

"As Jack the Ripper said..."; # Magic true value required at end of module

__END__