Algorithm::MasterMind - Framework for algorithms that solve the MasterMind game

    use Algorithm::MasterMind;

    my $solver = new Algorithm::MasterMind::Solver $options;

    my $first_string = $solver->issue_first();
    $solver->feedback( check_combination( $secret_code, $first_string) );

    my $played_string = $solver->issue_next;
    $solver->feedback( check_combination( $secret_code, $played_string) );

    #And so on until solution is found

 @article{merelo2010finding,
  title={{Finding Better Solutions to the Mastermind Puzzle Using Evolutionary Algorithms}},
  author={Merelo-Guerv{\'o}s, J. and Runarsson, T.},
  journal={Applications of Evolutionary Computation},
  pages={121--130},
  year={2010},
  publisher={Springer}
 }

package Algorithm::MasterMind;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv("v0.3.1");

use Algorithm::Combinatorics qw(variations_with_repetition);

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

our @ISA = qw(Exporter);

our @EXPORT_OK = qw( check_combination partitions entropy check_rule );

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 };

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

sub random_combination {
  my $self = shift;
  my $string_to_play;
  my @alphabet = @{ $self->{'_alphabet'} };
  for (my $i = 0; $i <  $self->{'_length'}; $i++ ) {
    $string_to_play .= $alphabet[ rand( @alphabet) ];
  }
  return $string_to_play;
}

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

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";
  for my $r ( @rules ) {    
    my $rule_result = check_rule( $r, $string );
    $result->{'matches'}++ if ( $rule_result->{'match'} );
    push @{ $result->{'result'} }, $rule_result;
  }
  $self->{'_evaluated'}++;
  return $result;
}

sub check_rule {
  my $rule = shift;
  my $string = shift;
  my $result = check_combination( $rule->{'combination'}, $string );
  if ( ( $rule->{'blacks'} == $result->{'blacks'} )
       && ( $rule->{'whites'} == $result->{'whites'} ) ) {
    $result->{'match'} = 1;
  } else {
    $result->{'match'} = 0;
  }
  return $result;
}

sub check_combination {
  my $combination = shift;
  my $string = shift;

  my ( %hash_combination, %hash_string );
  my $blacks = 0;
  my ($c, $s);
  while ( $c = chop( $combination ) ) {
    $s = chop( $string );
    if ( $c eq $s ) {
      $blacks++;
    } else {
      $hash_combination{ $c }++;
      $hash_string{ $s }++;
    }
  }
  my $whites = 0;
  for my $k ( keys %hash_combination ) {
    next if ! defined $hash_string{$k};
    $whites += ($hash_combination{$k} > $hash_string{$k})
      ?$hash_string{$k}
	:$hash_combination{$k};
  }
  return { blacks => $blacks,
	   whites => $whites };
}

sub distance_taxicab {
  my $self = shift;
  my $combination = shift || croak "Can't compute distance to nothing";
  my $matches = $self->matches( $combination );

  my $distance = 0;
  my @rules = @{$self->{'_rules'}};
  for ( my $r = 0; $r <= $#rules; $r++) {
    $distance -= abs( $rules[$r]->{'blacks'} - $matches->{'result'}->[$r]->{'blacks'} ) +
      abs( $rules[$r]->{'whites'} - $matches->{'result'}->[$r]->{'whites'} );
  }

  return [$distance, $matches->{'matches'}];
}

sub distance_chebyshev {
  my $self = shift;
  my $combination = shift || croak "Can't compute distance to nothing";
  my $rules =  $self->number_of_rules();
  my $matches = $self->matches( $combination );

  my $distance = 0;
  my @rules = @{$self->{'_rules'}};
  for ( my $r = 0; $r <= $#rules; $r++) {
    my $diff_black = abs( $rules[$r]->{'blacks'} - $matches->{'result'}->[$r]->{'blacks'});
    my $diff_white = abs( $rules[$r]->{'whites'} - $matches->{'result'}->[$r]->{'whites'} );
    my $this_distance = ($diff_black > $diff_white)?$diff_black:$diff_white;
    $distance -= $this_distance ;
  }

  return [$distance, $matches->{'matches'}];
}

sub check_combination_old {
  my $combination = shift;
  my $string = shift;

  my @combination_arr = split(//, $combination );
  my @string_arr = split(//, $string);
  my $blacks = 0;
  for ( my $i = 0; $i < length($combination); $i ++ ) {
    if ( $combination_arr[ $i ] eq $string_arr[ $i ] ) {
      $combination_arr[ $i ] = $string_arr[ $i ] = 0;
      $blacks++;
    }
  }
  my %hash_combination;
  map( $hash_combination{$_}++, @combination_arr);
  my %hash_string;
  map( $hash_string{$_}++, @string_arr);
  my $whites = 0;
  for my $k ( keys %hash_combination ) {
    next if $k eq '0'; # Mark for "already computed"
    next if ! defined $hash_string{$k};
    $whites += ($hash_combination{$k} > $hash_string{$k})
      ?$hash_string{$k}
	:$hash_combination{$k};
  }
  return { blacks => $blacks,
	   whites => $whites };
}

sub hashify {
  my $str = shift;
  my %hash;
  map( $hash{$_}++, split(//, $str));
  return %hash;
}

sub not_in_combination {
  my $self = shift;
  my $combination = shift;
  my @alphabet = @{$self->{'_alphabet'}};
  my %alphabet_hash;
  map( $alphabet_hash{$_}=1, @alphabet );
  for my $l ( split(//, $combination ) ) {
    delete $alphabet_hash{$l} if  $alphabet_hash{$l};
  }
  return keys %alphabet_hash;
}

sub partitions {
  my @combinations = @_;

  my %partitions;

  for my $c ( @combinations ) {
    for my $cc ( @combinations ) {
      next if $c eq $cc;
      my $result = check_combination ( $c, $cc );
      $partitions{$c}{$result->{'blacks'}."b-".$result->{'whites'}."w"}++;
    }
    
  }
  return \%partitions;
}

sub all_combinations {
  my $self = shift; 
  my @combinations_array = variations_with_repetition( $self->{'_alphabet'}, 
						       $self->{'_length'});
  my @combinations = map( join( "", @$_), @combinations_array );
  
}

sub all_responses {
    my $self = shift;
    my $length = $self->{'_length'};
    my @responses_array = variations_with_repetition( ['B', 'W', '-'], 
						      $length );
    my %responses;
    for my $r ( @responses_array ) {
      my %partial = ( W => 0,
		      B => 0 );
      for my $c (@$r) {
	$partial{$c}++;
      }
      
      $responses{$partial{'B'}."B-".$partial{'W'}."W"} = 1;
    }
    # Delete impossible
    my $impossible = ($length-1)."B-1W";
    delete $responses{$impossible};
    my @possible_responses = sort keys %responses;
    return @possible_responses;

}

sub entropy {
  my $combination = shift;
  my %freqs;
  map( $freqs{$_}++, split( //, $combination));
  my $entropy;
  for my $k (keys %freqs ) {
    my $probability = $freqs{$k}/length($combination);
    $entropy -= $probability * log ($probability);
  }
  return $entropy;
}

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

__END__