view release on metacpan or  search on metacpan

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

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;