Algorithm-MasterMind
view release on metacpan or search on metacpan
2012-05-21 Juan J. Merelo Guervós <jjmerelo@gmail.com>
* app/run_experiment_instances.pl: Adding monitoring of consistent
set to make experiments on its evolution.
Trying again after fixing crossover bug and but in monitoring.
2012-05-16 Juan J. Merelo Guervós <jjmerelo@gmail.com>
* lib/Algorithm/MasterMind/Secret.pm (check): This new class will
pre-compute part of the stuff needed for secret combinations,
speeding up (a bit) that critical part.
2012-05-15 Juan J. Merelo Guervós <jjmerelo@gmail.com>
* lib/Algorithm/MasterMind.pm (check_combination): this is the
worst routine for the time being, after eliminating Permutation
and improving Tournament as bottlenecks (I was going to say
sources of slowness :-)
* lib/Algorithm/MasterMind/Evo.pm (initialize): Eliminating
2009-10-10 <jmerelo@localhost.localdomain>
* lib/Algorithm/MasterMind.pm (check_combination): Saving around
30% of the CPU time via optimization of this subroutine. Still
some room for improvement, though:
[jmerelo@localhost app]$ dprofpp -u
Total Elapsed Time = 13.84292 Seconds
User Time = 12.07292 Seconds
Exclusive Times
%Time ExclSec CumulS #Calls sec/call Csec/c Name
85.4 10.31 10.310 500146 0.0000 0.0000 Algorithm::MasterMind::check_combi
nation
9.71 1.172 12.806 367 0.0032 0.0349 Algorithm::MasterMind::Random::iss
ue_next
6.16 0.744 11.625 138572 0.0000 0.0001 Algorithm::MasterMind::matches
5.06 0.611 10.881 499779 0.0000 0.0000 Algorithm::MasterMind::check_rule
0.58 0.070 0.090 1 0.0699 0.0897 YAML::Type::code::BEGIN
0.50 0.060 0.389 7 0.0085 0.0555 main::BEGIN
0.49 0.059 0.195 40252 0.0000 0.0000 YAML::Base::__ANON__
0.49 0.059 0.059 454 0.0001 0.0001 Params::Validate::_validate
app/mm-eda.cgi view on Meta::CPAN
mm-eda.cgi - CGI for playing an Mastermind using an Estimation of Distribution Algorithms
=head1 SYNOPSIS
http://localhost/cgi-bin/mm-eda.cgi
=head1 DESCRIPTION
This script uses L<Algorithm::Mastermind::EDA> for playing a basic
Mastermind game, with 6 colors and 4 pegs. When called without
parameters it shows a form for introducing the secret combination, if
called with parameter C<code> it will call the algorithm and produce
the solution. It usually takes less than a second, but your mileage
may vary depending on the server and Perl version.
=cut
use strict;
use warnings;
use lib qw(/home/jmerelo/proyectos/CPAN/Algorithm_Mastermind/lib
/home/jmerelo/proyectos/CPAN/Algorithm-Evolutionary/lib
app/run_experiment.pl view on Meta::CPAN
eval "require Algorithm::MasterMind::$method" || die "Can't load $method: $@\n";
my $io = IO::YAML->new($conf->{'ID'}."-$method-".DateTime->now().".yaml", ">");
my $method_options = $conf->{'Method_options'};
for my $i (1..$conf->{'tests'}) {
my $solver;
eval "\$solver = new Algorithm::MasterMind::$method \$method_options";
die "Can't instantiate $solver: $@\n" if !$solver;
my $secret_code = $solver->random_combination();
my $game = { code => $secret_code,
combinations => []};
my $first_string = $solver->issue_first;
my $response = check_combination( $secret_code, $first_string);
push @{$game->{'combinations'}}, [$first_string,$response] ;
$solver->feedback( $response );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
$response = check_combination( $secret_code, $played_string);
push @{$game->{'combinations'}}, [$played_string, $response] ;
$solver->feedback( $response );
$played_string = $solver->issue_next;
}
$game->{'evaluations'} = $solver->evaluated();
$io->print($game);
}
$io->close;
app/run_experiment_all.pl view on Meta::CPAN
my $method_options = $conf->{'Method_options'};
$io->print( $method, $method_options );
my $engine = variations_with_repetition($method_options->{'alphabet'},
$method_options->{'length'});
my $combination;
my $repeats = $conf->{'repeats'} || 10;
while ( $combination = $engine->next() ) {
my $secret_code = join("",@$combination);
for ( 1..$repeats ) {
print "Code $secret_code\n";
my $solver;
eval "\$solver = new Algorithm::MasterMind::$method \$method_options";
die "Can't instantiate $solver: $@\n" if !$solver;
my $game = { code => $secret_code,
combinations => []};
my $move = $solver->issue_first;
my $response = check_combination( $secret_code, $move);
push @{$game->{'combinations'}}, [$move,$response] ;
while ( $move ne $secret_code ) {
$solver->feedback( $response );
$move = $solver->issue_next;
print "Playing $move\n";
$response = check_combination( $secret_code, $move);
push @{$game->{'combinations'}}, [$move, $response] ;
$solver->feedback( $response );
if ( $solver->{'_consistent'} ) {
push @{$game->{'consistent_set'}}, [ keys %{$solver->{'_consistent'}} ] ;
} else {
my $partitions = $solver->{'_partitions'};
push @{$game->{'consistent_set'}},
[ map( $_->{'_string'}, @{$partitions->{'_combinations'}}) ];
if ( $partitions->{'_score'}->{'_most'} ) {
push @{$game->{'top_scorers'}}, [ $partitions->top_scorers('most') ];
lib/Algorithm/MasterMind.pm view on Meta::CPAN
}
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) = @_;
lib/Algorithm/MasterMind.pm view on Meta::CPAN
=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.
lib/Algorithm/MasterMind/CGA_Partitions.pm view on Meta::CPAN
__END__
=head1 NAME
Algorithm::MasterMind::CGA_Partitions - Solver using a Canonical GA
=head1 SYNOPSIS
use Algorithm::MasterMind::CGA_Partitions;
my $secret_code = 'EAFC';
my $population_size = 200;
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::CGA_Partitions { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size};
#The rest, same as the other solvers
=head1 DESCRIPTION
Uses L<Algorithm::Evolutionary> instance of canonical genetic algorithm to solve MM; as there
are two different fitness functions you can use; probably
C<fitness_orig> works better.
lib/Algorithm/MasterMind/CGA_Partitions.pm view on Meta::CPAN
=head2 fitness( $individual )
Computes fitness summing the number of correct black and whites plus
the number of rules the combination meets times the length
=head2 fitness_orig( $individual )
Fitness proposed in the Applied and Soft Computing paper, difference
between the number of blacks/whites obtained by rules against the
secret code and by the combination against the combination in the
rule.
=head1 SEE ALSO
Other solvers: L<Algorithm::MasterMind::Sequential> and
L<Algorithm::MasterMind::Random>. Don't work as well, really.
=head1 AUTHOR
lib/Algorithm/MasterMind/Consistent_Set.pm view on Meta::CPAN
../../../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;
}
lib/Algorithm/MasterMind/Consistent_Set.pm view on Meta::CPAN
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'} = {};
lib/Algorithm/MasterMind/Consistent_Set.pm view on Meta::CPAN
The consistent set in Mastermind contains the set of strings that
could possibly be a solution, that is, those that meet all partitions
made so far.
=head1 INTERFACE
=head2 new( @string_array )
Creates set and associated data structures
=head2 compute_partitions ( \@secrets )
Computes partitions for an array of secrets, returns a hashref to the
partition set.
=head2 is_in ( $string )
Checks whether the combination is in the consistent set already
=head2 add_combination ( $string )
Adds another combination checking it against previous combinations
lib/Algorithm/MasterMind/EDA.pm view on Meta::CPAN
my $half = @alphabet/2;
if ( $self->{'_first'} eq 'orig' ) {
for ( $i = 0; $i < $self->{'_length'}; $i ++ ) {
$string .= $alphabet[ $i % $half ]; # Recommendation Knuth
}
} elsif ( $self->{'_first'} eq 'half' ) {
for ( $i = 0; $i < $self->{'_length'}; $i ++ ) {
$string .= $alphabet[ $i /2 ]; # Recommendation first paper
}
}
$self->{'_first'} = 1; # Flag to know when the second is due
#Initialize population for next step
my @pop;
for ( 0..$self->{'_pop_size'} ) {
my $indi = Algorithm::Evolutionary::Individual::String->new( $self->{'_alphabet'},
$self->{'_length'} );
push( @pop, $indi );
}
$self->{'_pop'}= \@pop;
lib/Algorithm/MasterMind/EDA.pm view on Meta::CPAN
__END__
=head1 NAME
Algorithm::MasterMind::EDA - Solver using an Estimation of Distribution Algorithm
=head1 SYNOPSIS
use Algorithm::MasterMind::EDA;
my $secret_code = 'EAFC';
my $population_size = 200;
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::EDA { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size};
#The rest, same as the other solvers
=head1 DESCRIPTION
Uses L<Algorithm::Evolutionary> instance of EDAs to solve MM; as there
are two different fitness functions you can use; probably
C<fitness_orig> works better.
lib/Algorithm/MasterMind/EDA.pm view on Meta::CPAN
=head2 fitness( $individual )
Computes fitness summing the number of correct black and whites plus
the number of rules the combination meets times the length
=head2 fitness_orig( $individual )
Fitness proposed in the Applied and Soft Computing paper, difference
between the number of blacks/whites obtained by rules against the
secret code and by the combination against the combination in the
rule.
=head1 SEE ALSO
Other solvers: L<Algorithm::MasterMind::Sequential> and
L<Algorithm::MasterMind::Random>. Don't work as well, really.
=head1 AUTHOR
lib/Algorithm/MasterMind/EDA_Partitions.pm view on Meta::CPAN
__END__
=head1 NAME
Algorithm::MasterMind::EDA_Partitions - Solver using an EDA plus partitions
=head1 SYNOPSIS
use Algorithm::MasterMind::EDA;
my $secret_code = 'EAFC';
my $population_size = 200;
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::EDA { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size};
#The rest, same as the other solvers
=head1 DESCRIPTION
Uses L<Algorithm::Evolutionary> instance of EDAs to solve MM; as there
are two different fitness functions you can use; probably
C<fitness_orig> works better.
lib/Algorithm/MasterMind/EDA_Partitions.pm view on Meta::CPAN
=head2 fitness( $individual )
Computes fitness summing the number of correct black and whites plus
the number of rules the combination meets times the length
=head2 fitness_orig( $individual )
Fitness proposed in the Applied and Soft Computing paper, difference
between the number of blacks/whites obtained by rules against the
secret code and by the combination against the combination in the
rule.
=head1 SEE ALSO
Other solvers: L<Algorithm::MasterMind::Sequential> and
L<Algorithm::MasterMind::Random>. Don't work as well, really.
=head1 AUTHOR
lib/Algorithm/MasterMind/MOGA.pm view on Meta::CPAN
my $half = @alphabet/2;
if ( $self->{'_first'} eq 'orig' ) {
for ( $i = 0; $i < $self->{'_length'}; $i ++ ) {
$string .= $alphabet[ $i % $half ]; # Recommendation Knuth
}
} elsif ( $self->{'_first'} eq 'half' ) {
for ( $i = 0; $i < $self->{'_length'}; $i ++ ) {
$string .= $alphabet[ $i /2 ]; # Recommendation first paper
}
}
$self->{'_first'} = 1; # Flag to know when the second is due
#Initialize population for next step
my @pop;
for ( 0..$self->{'_pop_size'} ) {
my $indi = Algorithm::Evolutionary::Individual::String->new( $self->{'_alphabet'},
$self->{'_length'} );
push( @pop, $indi );
}
$self->{'_pop'}= \@pop;
lib/Algorithm/MasterMind/MOGA.pm view on Meta::CPAN
__END__
=head1 NAME
Algorithm::MasterMind::MOGA - Solver using an Estimation of Distribution Algorithm
=head1 SYNOPSIS
use Algorithm::MasterMind::MOGA;
my $secret_code = 'EAFC';
my $population_size = 200;
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::MOGA { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size};
#The rest, same as the other solvers
=head1 DESCRIPTION
Uses L<Algorithm::Evolutionary> instance of MOGAs to solve MM; as there
are two different fitness functions you can use; probably
C<fitness_orig> works better.
lib/Algorithm/MasterMind/MOGA.pm view on Meta::CPAN
=head2 fitness( $individual )
Computes fitness summing the number of correct black and whites plus
the number of rules the combination meets times the length
=head2 fitness_orig( $individual )
Fitness proposed in the Applied and Soft Computing paper, difference
between the number of blacks/whites obtained by rules against the
secret code and by the combination against the combination in the
rule.
=head1 SEE ALSO
Other solvers: L<Algorithm::MasterMind::Sequential> and
L<Algorithm::MasterMind::Random>. Don't work as well, really.
=head1 AUTHOR
lib/Algorithm/MasterMind/Partition/Most.pm view on Meta::CPAN
=head1 NAME
Algorithm::MasterMind::Partition::Most - Uses "most partitions"
criterium to play
=head1 SYNOPSIS
use Algorithm::MasterMind::Partition::Most;
my $secret_code = 'EAFC';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Partition::Most { alphabet => \@alphabet,
length => length( $secret_code ) };
=head1 DESCRIPTION
Solves the algorithm by issuing each time a combination with a
particular score; the computation of that score is delegated to
subclasses.
=head1 INTERFACE
lib/Algorithm/MasterMind/Partition_Most.pm view on Meta::CPAN
__END__
=head1 NAME
Algorithm::MasterMind::Partition_Most - Plays combination with the highest number of partitions
=head1 SYNOPSIS
use Algorithm::MasterMind::Partition_Worst;
my $secret_code = 'EAFC';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Partition_Worst { alphabet => \@alphabet,
length => length( $secret_code ) };
=head1 DESCRIPTION
Solves the algorithm by issuing each time a combination that maximizes
the number of non-null partitions. This intends to maximally reduce
the search space each time; I wouldn't advice using it for sizes over
4-6. In fact, it will probably take a lot of time (and use a lot of
memory) for 4-8 already, so use it carefully.
lib/Algorithm/MasterMind/Partition_Worst.pm view on Meta::CPAN
__END__
=head1 NAME
Algorithm::MasterMind::Partition_Worst - Plays by Knuth's playbook
=head1 SYNOPSIS
use Algorithm::MasterMind::Partition_Worst;
my $secret_code = 'EAFC';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Partition_Worst { alphabet => \@alphabet,
length => length( $secret_code ) };
=head1 DESCRIPTION
Solves the algorithm by issuing each time a combination that minimizes
the size of the worst partition. This intends to maximally reduce the
search space each time; it was the first algorithm used to play
mastermind, but it's no longer state of the art, and does not work
very well for spaces higher than 4-6. In fact, it will probably take a
lot of time (and use a lot of memory) for 5-9 already, so use it
lib/Algorithm/MasterMind/Random.pm view on Meta::CPAN
__END__
=head1 NAME
Algorithm::MasterMind::Random - Plays random consistent combinations
=head1 SYNOPSIS
use Algorithm::MasterMind::Random;
my $secret_code = 'EAFC';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Random { alphabet => \@alphabet,
length => length( $secret_code ) };
=head1 DESCRIPTION
Not very efficient, but memory footprint is null and works pretty well
for small spaces. Beware of big spaces, it could get stuck
=head1 INTERFACE
=head2 initialize()
lib/Algorithm/MasterMind/Secret.pm view on Meta::CPAN
@{$self->{'_alphabet'}} = keys %{$self->{'_hash'}};
bless $self, $class;
return $self;
}
sub string {
return shift->{'_string'};
}
sub check {
my %hash_secret = %{$_[0]->{'_hash'}};
my %hash_string ;
my $blacks = 0;
my $string = $_[1];
my ($c, $s);
for my $c (@{$_[0]->{'_chars'}} ) {
$s = chop( $string );
if ( $c ne $s ) {
$hash_string{ $s }++;
} else {
$blacks++;
$hash_secret{ $c }--;
}
}
my $whites = 0;
map( exists $hash_string{$_}
&& ( $whites += ($hash_secret{$_} > $hash_string{$_})
?$hash_string{$_}
:$hash_secret{$_} ), @{$_[0]->{'_alphabet'}} );
return{ blacks => $blacks,
whites => $whites } ;
}
sub check_secret {
my %hash_secret = %{$_[0]->{'_hash'}};
my %hash_other_secret = %{$_[1]->{'_hash'}};
# my $blacks = 0;
my $s;
my $string = $_[1]->{'_string'};
map( ($s = chop( $string ) )
&& ( $s eq $_ )
&& ( $_[2]->{'blacks'}++,
$hash_secret{ $s }--,
$hash_other_secret{ $s }-- ), @{$_[0]->{'_chars'}});
my $whites = 0;
map( exists $hash_other_secret{$_}
&& ( $_[2]->{'whites'} += ($hash_secret{$_} > $hash_other_secret{$_})
?$hash_other_secret{$_}
:$hash_secret{$_} ), @{$_[0]->{'_alphabet'}} );
return;
}
"Can't tell"; # Magic true value required at end of module
__END__
=head1 NAME
Algorithm::MasterMind::Secret - Minimal framework for MM secrets
=head1 SYNOPSIS
use Algorithm::MasterMind::Secret;
my $sikrit = new Algorithm::MasterMind::Secret 'ABCD';
my $blacks_whites = $sikrit->check('BBBB'}
lib/Algorithm/MasterMind/Secret.pm view on Meta::CPAN
=head1 INTERFACE
=head2 new ( $string )
A string in an arbitrary alphabet, but should be the same as the ones
you will use to solve
=head2 check( $string )
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). The string must be a variable. So don't count on the
variable after the call.
=head2 check_secret( $secret )
Same as above, but the argument must be a L<Algorithm::Mastermind::Secret>.
=head2 string()
Returns the string corresponding to this secret.
=head1 CONFIGURATION AND ENVIRONMENT
Algorithm::MasterMind requires no configuration files or environment variables.
=head1 DEPENDENCIES
L<Algorithm::Evolutionary>, but only for one of the
strategies. L<Algorithm::Combinatorics>, used to generate combinations
lib/Algorithm/MasterMind/Sequential.pm view on Meta::CPAN
=head1 NAME
Algorithm::MasterMind::Sequential - Tests each combination in turn.
=head1 SYNOPSIS
use Algorithm::MasterMind::Sequential;
my $secret_code = 'ADCB';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Sequential { alphabet => \@alphabet,
length => length( $secret_code ) };
=head1 DESCRIPTION
Test combinations in turn, starting by A x length. Should find the
solution, but complexity increases with size. Not very efficient.
=head1 INTERFACE
=head2 initialize()
lib/Algorithm/MasterMind/Sequential_Alt.pm view on Meta::CPAN
=head1 NAME
Algorithm::MasterMind::Sequential_Alt - Tests each combination in
turn, alternating with the beginning and end of the sequence.
=head1 SYNOPSIS
use Algorithm::MasterMind::Sequential_Alt;
my $secret_code = 'ADCB';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Sequential_Alt { alphabet => \@alphabet,
length => length( $secret_code ) };
=head1 DESCRIPTION
Test combinations in turn, starting by A x length. Should find the
solution, but complexity increases with size. Not very efficient, but
a bit better than L<Algorithm::MasterMind::Sequential>
=head1 INTERFACE
lib/Algorithm/MasterMind/Test_Solver.pm view on Meta::CPAN
use base 'Exporter';
use Algorithm::MasterMind qw(check_combination);
use Test::More;
our @EXPORT_OK = qw( solve_mastermind );
sub solve_mastermind {
my $solver = shift;
my $secret_code = shift;
my $length = length( $secret_code );
my %played;
my $first_string = $solver->issue_first;
$played{$first_string} = 1;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), $length, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
my $played_string = $solver->issue_next;
my $played = 2;
while ( $played_string ne $secret_code ) {
is( $played{ $played_string}, undef, 'Playing '. $played_string ) ;
$played{$played_string} = 1;
# my (%combinations, %fitness);
# map ( $combinations{$_->{'_str'}}++, @{$solver->{'_pop'}});
# map ( $fitness{$_->{'_str'}} = $_->Fitness(), @{$solver->{'_pop'}});
# for my $c ( sort {$combinations{$a} <=> $combinations{$b} } keys %combinations ) {
# print "$c => $combinations{$c} $fitness{$c}\n" if $combinations{$c}>1 ;
# }
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
$played ++;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
return [$solver->evaluated(), $played];
}
"some blacks, all white"; # Magic true value required at end of module
__END__
=head1 NAME
Algorithm::MasterMind::Test_Solver - Utility functions for testing solvers
=head1 SYNOPSIS
use Algorithm::MasterMind::Test_Solver;
my $secret_code = 'EAFC';
my $population_size = 256;
my $length = length( $secret_code );
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Canonical_GA { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size};
solve_mastermind( $solver, $secret_code );
=head1 DESCRIPTION
Used mainly in the test set, but useful for testing your own algorithms
=head1 INTERFACE
=head2 solve_mastermind($solver, $secret_code )
Tries to find the secret code via the issued solver, and performs
basic tests on the obtained combinations.
=head1 AUTHOR
JJ Merelo C<< <jj@merelo.net> >>
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2009, JJ Merelo C<< <jj@merelo.net> >>. All rights reserved.
t/00_functions.t view on Meta::CPAN
whites => 4 },
{ blacks => 2,
whites => 2 },
{ blacks => 0,
whites => 4 },
{ blacks => 4,
whites => 0 },
{ blacks => 0,
whites => 1} );
my @secrets;
while (@combinations ) {
my $combination = shift @combinations;
my $secret = new Algorithm::MasterMind::Secret $combination;
push @secrets, $secret;
my $string = shift @strings;
my $result = shift @results;
my $result_obtained = check_combination( $combination, $string );
my $other_result_obtained = $secret->check($string);
is( $secret->string, $combination, "Atributes");
is_deeply( $result_obtained, $result, "$string vs $combination");
is_deeply( $other_result_obtained, $result, "Secret $string vs $combination");
}
my $code = 'BCAD';
my $sikrit = new Algorithm::MasterMind::Secret $code;
for my $s (@secrets ) {
my $one_result = check_combination( $s->{'_string'}, $code );
my $the_other = { blacks => 0,
whites => 0};
$sikrit->check_secret( $s, $the_other );
is_deeply( $one_result, $the_other, "Checking secrets $s->{'_string'}");
}
#Mock play
my @played = qw( ABCA BCAE BBAD BCAD );
my $mm = new Algorithm::MasterMind::Test { options => ''};
my $number_of_rules = 0;
my @matches = qw( 0 1 0 3);
my @distances = qw( 0 0 -4 0 );
for my $p ( @played ) {
t/00_sequential.t view on Meta::CPAN
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::Sequential' );
}
my $secret_code = 'FAFA';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Sequential { alphabet => \@alphabet,
length => length( $secret_code ) };
isa_ok( $solver, 'Algorithm::MasterMind::Sequential', 'Instance OK' );
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), 4, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
is( scalar $solver->number_of_rules, 1, "Rules added" );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), 4, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
t/01_random.t view on Meta::CPAN
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::Random' );
}
my $secret_code = 'EAFC';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Random { alphabet => \@alphabet,
length => length( $secret_code ) };
isa_ok( $solver, 'Algorithm::MasterMind::Random', 'Instance OK' );
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), 4, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
is( scalar $solver->number_of_rules, 1, "Rules added" );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), 4, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ../Algorithm-Evolutionary/lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::EDA' );
}
my $secret_code = 'EAFC';
my $population_size = 200;
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::EDA { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size};
solve_mastermind( $solver, $secret_code );
$solver = new Algorithm::MasterMind::EDA { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size,
fitness => 'naive' };
solve_mastermind( $solver, $secret_code );
$solver = new Algorithm::MasterMind::EDA { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size,
fitness => 'compress' };
solve_mastermind( $solver, $secret_code );
$solver = new Algorithm::MasterMind::EDA { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size,
fitness => 'compress',
first => 'half'};
solve_mastermind( $solver, $secret_code );
sub solve_mastermind {
my $solver = shift;
my $secret_code = shift;
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), 4, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), 4, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
}
t/03_sequential_alt.t view on Meta::CPAN
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::Sequential_Alt' );
}
my $secret_code = 'ADCB';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Sequential_Alt { alphabet => \@alphabet,
length => length( $secret_code ) };
isa_ok( $solver, 'Algorithm::MasterMind::Sequential_Alt', 'Instance OK' );
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), 4, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
is( scalar $solver->number_of_rules, 1, "Rules added" );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), 4, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
t/04_consistent_set.t view on Meta::CPAN
ok( $c_set->is_in( $s ), 'Added');
}
$c_set->compute_entropy_score;
my @top_scorers = $c_set->top_scorers('entropy');
is( $top_scorers[0] ne '', 1, "Computing top scores");
$c_set->compute_most_score;
@top_scorers = $c_set->top_scorers('most');
my $one_string = splice( @top_scorers, rand( @top_scorers ), 1);
my $secret = new Algorithm::MasterMind::Secret $one_string; # to ensure non-zero partitions
my $other_string = $top_scorers[ rand( @top_scorers )];
my $result = $secret->check( $other_string ); # Another of the
$c_set->cull_inconsistent_with( $one_string, $result );
if (@{$c_set->{'_combinations'}} ) { # Check other ctor
my $rules = [ { combination => $one_string,
blacks => $result->{'blacks'},
whites => $result->{'whites'}} ];
my $other_c_set = Algorithm::MasterMind::Consistent_Set->create_consistent_with( \@strings, $rules );
is_deeply( $other_c_set->{'_combinations'}, $c_set->{'_combinations'}, 'Consistent creation' );
}
t/04_consistent_set.t view on Meta::CPAN
'CCCC' => { '0b-0w' => 2,
'1b-0w' => 1 } );
for my $s (@strings) {
is_deeply($c_set->partitions_for($s), $partitions{$s}, "Partitions for $s" );
}
$c_set->compute_most_score;
is( $c_set->score_most( 'ABCD' ), 1, 'Scoring OK');
is( $c_set->score_most( 'AAAA' ), 2, 'Scoring OK');
@top_scorers = $c_set->top_scorers('most');
is_deeply ( scalar(@top_scorers), 3, 'Top scorers' );
$secret = new Algorithm::MasterMind::Secret 'ABEE';
my $a_move = 'DDDD';
$result = $secret->check( $a_move); # Simulating move
$c_set->cull_inconsistent_with( 'DDDD', $result );
is_deeply($c_set->partitions_for('AAAA'), { '0b-0w' => 2 }, "New partitioning" );
t/05_partition_most.t view on Meta::CPAN
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::Partition_Most' );
}
my $secret_code = 'ADCB';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Partition_Most { alphabet => \@alphabet,
length => length( $secret_code ) };
isa_ok( $solver, 'Algorithm::MasterMind::Partition_Most', 'Instance OK' );
diag( "This might take a while while it finds the code $secret_code" );
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the second move" );
is( length( $first_string), 4, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
is( scalar $solver->number_of_rules, 1, "Rules added" );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), 4, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
isnt( $solver->{'_partitions'}->partitions_for('ADCB'), undef, 'Way to go' );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
t/05_partition_worst.t view on Meta::CPAN
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::Partition_Worst' );
}
my $secret_code = 'ADCB';
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Partition_Worst { alphabet => \@alphabet,
length => length( $secret_code ) };
isa_ok( $solver, 'Algorithm::MasterMind::Partition_Worst', 'Instance OK' );
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), 4, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
is( scalar $solver->number_of_rules, 1, "Rules added" );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), 4, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
t/06_moga.t view on Meta::CPAN
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ../Algorithm-Evolutionary/lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::Evolutionary_MO' );
}
my $secret_code = 'EAFC';
my $population_size = 300;
my $length = length( $secret_code );
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Evolutionary_MO { alphabet => \@alphabet,
length => $length,
pop_size => $population_size,
replacement_rate => 0.2};
isa_ok( $solver, 'Algorithm::MasterMind::Evolutionary_MO', 'Instance OK' );
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), $length, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
my $played_string = $solver->issue_next;
is( length( $played_string), $length, 'Playing '. $played_string ) ;
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ../Algorithm-Evolutionary/lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::Evolutionary' );
}
my $secret_code = 'EAFC';
my $population_size = 256;
my $length = length( $secret_code );
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::Evolutionary { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size};
solve_mastermind( $solver, $secret_code );
sub solve_mastermind {
my $solver = shift;
my $secret_code = shift;
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), $length, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), $length, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
}
t/08_cga_part.t view on Meta::CPAN
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ../Algorithm-Evolutionary/lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::CGA_Partitions' );
}
my @secret_codes = qw( AAAA ABCD CDEF ACAC BAFE FFFF);
for my $secret_code ( @secret_codes ) {
my $population_size = 256;
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::CGA_Partitions { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size,
replacement_rate => 0.2 };
solve_mastermind( $solver, $secret_code );
}
sub solve_mastermind {
my $solver = shift;
my $secret_code = shift;
my $length = length( $secret_code );
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), $length, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), $length, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
}
t/08_eda_part.t view on Meta::CPAN
use Test::More qw( no_plan ); #Random initial string...
use lib qw( lib ../lib ../../lib ../Algorithm-Evolutionary/lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(check_combination);
BEGIN {
use_ok( 'Algorithm::MasterMind::EDA_Partitions' );
}
my @secret_codes = qw( AAAA ABCD CDEF ACAC BAFE FFFF);
for my $secret_code ( @secret_codes ) {
my $population_size = 256;
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::EDA_Partitions { alphabet => \@alphabet,
length => length( $secret_code ),
pop_size => $population_size,
replacement_rate => 0.2 };
solve_mastermind( $solver, $secret_code );
}
sub solve_mastermind {
my $solver = shift;
my $secret_code = shift;
my $length = length( $secret_code );
my $first_string = $solver->issue_first;
diag( "This might take a while while it finds the code $secret_code" );
is( length( $first_string), $length, 'Issued first '. $first_string );
$solver->feedback( check_combination( $secret_code, $first_string) );
my $played_string = $solver->issue_next;
while ( $played_string ne $secret_code ) {
is( length( $played_string), $length, 'Playing '. $played_string ) ;
$solver->feedback( check_combination( $secret_code, $played_string) );
$played_string = $solver->issue_next;
}
is( $played_string, $secret_code, "Found code after ".$solver->evaluated()." combinations" );
}
( run in 1.024 second using v1.01-cache-2.11-cpan-39bf76dae61 )