view release on metacpan or  search on metacpan

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

package Algorithm::MasterMind;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv("v0.4.5");  #Quest for non-failing tests

use Algorithm::Combinatorics qw(variations_with_repetition);

#use Memoize;
#memoize( "check_rule" );

our @ISA = qw(Exporter);

our @EXPORT_OK = qw( check_combination partitions entropy random_string 
		     response_as_string);

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

# Module implementation here

sub new {

  my $class = shift;
  my $options = shift || croak "Need options here in Algorithm::MasterMind::New\n";

  my $self =  { _rules => [],
		_evaluated => 0,
		_hash_rules => {} };

  bless $self, $class;
  $self->initialize( $options );
  return $self;
}

sub random_combination {
  my $self = shift;
  return random_string( $self->{'_alphabet'}, $self->{'_length'});
}

sub random_string {
  my $alphabet = shift;
  my $length = shift;
  my $string;
  my @alphabet = @{$alphabet};
  for (my $i = 0; $i <  $length; $i++ ) {
    $string .= $alphabet[ rand( @alphabet) ];
  }
  return $string;
}

sub issue_first { #Default implementation
  my $self = shift;
  return $self->{'_last'} = $self->random_combination;
}

sub start_from {
  my $class = shift;
  my $options = shift || croak "Options needed to start!";

  my $self = {};
  bless $self, $class;
  for my $o ( qw( consistent alphabet rules evaluated ) ) {
    $self->{"_$o"} = $options->{$o};
  }
  return $self;
}

sub issue_first_Knuth {
  my $self = shift;
  my $string;
  my @alphabet = @{ $self->{'_alphabet'}};
  my $half = @alphabet/2;
  for ( my $i = 0; $i < $self->{'_length'}; $i ++ ) {
    $string .= $alphabet[ $i % $half ]; # Recommendation Knuth
  }
  $self->{'_first'} = 1; # Flag to know when the second is due
  return $self->{'_last_string'} = $string;
}

sub issue_next {
  croak "To be reimplemented in derived classes";
}

sub add_rule {
  my $self = shift;
  my ($combination, $result) = @_;
  my %new_rule = %$result;
  $new_rule{'combination'} = $combination;
  push @{ $self->{'_rules'} }, \%new_rule;

}

sub feedback {
  my $self = shift;
  my ($result) = @_;
  $self->add_rule( $self->{'_last'}, $result );
}

sub number_of_rules {
  my $self= shift;
  return scalar @{ $self->{'_rules'}};
}

sub rules {
  my $self= shift;
  return   $self->{'_rules'};
}

sub evaluated {
  my $self=shift;
  return $self->{'_evaluated'};
}

sub matches {

  my $self = shift;
  my $string = shift || croak "No string\n";
  my @rules = @{$self->{'_rules'}};
  my $result = { matches => 0,
		 result => [] };
#  print "Checking $string, ", $self->{'_evaluated'}, "\n";