view release on metacpan or  search on metacpan

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

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

sub check_rule {
  my $self = shift;
  my $rule = shift;
  my $string = shift;
  if ( ! $self->{'_rules_hash'}->{ $rule->{'combination'} }{ $string } ) {
    my $result = check_combination( $rule->{'combination'}, $string );

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

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

sub response_as_string {
  return $_[0]->{'blacks'}."b-".$_[0]->{'whites'}."w";
}
  

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

__END__

=head1 NAME

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

=head1 VERSION

This document describes Algorithm::MasterMind version 0.4.1 


=head1 SYNOPSIS

    use Algorithm::MasterMind;
    use Algorithm::MasterMind::Solver; # Change "solver" to your own.

    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
  
=head1 DESCRIPTION

Includes common functions used in Mastermind solvers; it should not be
used directly, but from derived classes. See examples in
L<Algorithm::MasterMind::Random>, for instance.

=head1 INTERFACE 

=head2 new ( $options )

Normally to be called from derived classes

=head2 add_rule( $combination, $result)

Adds a rule (set of combination and its result as a hash) to the set
of rules. These rules represent the information we've got on the
secret code. 

=head2 check_combination( $secret_code, $combination )

Checks a combination against the secret code, returning a hashref with
the number of blacks (correct in position) and whites (correct in
color, not position)

=head2 distance( $object )

Computes distance to a consistent combination, computed as the number
of blacks and whites that need change to become a consistent
combination. 


=head2 check_combination_old ( $secret_code,
$combination )

Old way of checking combinations, eliminated after profiling

=head2 check_rule ($rule, $combination) 

Same as C<check_combination>, except that a rule contains a
combination and how it scored against the secret code

=head2 issue_first ()

Issues the first combination, which might be generated in a particular
way 

=head2 start_from ()

Used when you want to create an solver once it's been partially
solved; it contains partial solutions. 

=head2 issue_first_Knuth

First combination looking like AABC for the normal
mastermind. Proposed by Knuth in one of his original papers. 

=head2 issue_next()

Issues the next combination

=head2 feedback()

Obtain the result to the last combination played

=head2 guesses()

Total number of guesses

=head2 evaluated()

Total number of combinations checked to issue result

=head2 number_of_rules ()

Returns the number of rules in the algorithm

=head2 rules()

Returns the rules (combinations, blacks, whites played so far) as a
reference to array

=head2 matches( $string ) 

Returns a hash with the number of matches, and whether it matches
every rule with the number of blacks and whites it obtains with each
of them

=head2 hashify ( $string )

Turns a string into a hash, to help with comparisons. Used internally,
mainly.

=head2 not_in_combination( $string)

Returns the letters from the alphabet that are _not_ in this
combination. Might be useful for certain strategies.

=head2 random_combination

Combines randomly the alphabet, issuing, you guessed it, a random