Algorithm-MasterMind
view release on metacpan or search on metacpan
app/evorank.yaml view on Meta::CPAN
ID: info-p400
Method: EvoRank
Method_options:
alphabet:
- A
- B
- C
- D
- E
- F
length: 4
pop_size: 400
app/mm-eda.cgi view on Meta::CPAN
-size=> 4),
end_form;
}
sub solve {
my $code = shift;
#Clean up
$code = uc( $code );
$code = substr( $code, 0, 4);
$code =~ s/[^A-F]/A/g;
if ( length( $code ) < 4 ) {
do {
$code .= 'A';
} until (length( $code ) == 4);
}
my @alphabet = qw( A B C D E F );
my $solver = new Algorithm::MasterMind::EDA { alphabet => \@alphabet,
length => length( $code ),
pop_size => 300};
print start_html("Trying to find the solution for $code"),
h1("Seeking $code");
my $first_string = $solver->issue_first;
my $response = check_combination( $code, $first_string);
print p(print_combination($first_string,$response)), "\n";
$solver->feedback( $response );
app/run_experiment_all.pl view on Meta::CPAN
my $method = $conf->{'Method'};
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'};
$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;
lib/Algorithm/MasterMind.pm view on Meta::CPAN
_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;
}
lib/Algorithm/MasterMind.pm view on Meta::CPAN
$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";
}
lib/Algorithm/MasterMind.pm view on Meta::CPAN
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;
lib/Algorithm/MasterMind.pm view on Meta::CPAN
$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;
}
sub response_as_string {
return $_[0]->{'blacks'}."b-".$_[0]->{'whites'}."w";
}
lib/Algorithm/MasterMind.pm view on Meta::CPAN
=head2 partitions
From a set of combinations, returns the "partitions", that is, the
number of combinations that would return every set of black and white
response. Inputs an array, returns a hash keyed to the combination,
each key containing a value corresponding to the number of elements in
each partition.
=head2 all_combinations
Returns all possible combinations of the current alphabet and length
in an array. Be careful with that, it could very easily fill up your
memory, depending on length and alphabet size.
=head2 entropy( $string )
Computes the string entropy
=head2 distance_taxicab( $string )
Computes the sums of taxicab distances to all combinations in the
game, and returns it as [$distance, $matches]
=head2 distance_chebyshev( $string )
Computes the Chebyshev distance, that is, the max of distances in all
dimensions. Returns as a arrayref with [$distance, matches]
=head2 all_responses()
Returns all possible responses (combination of black and white pegs)
for the combination length
=head2 random_string
Returns a random string in with the length and alphabet defined
=head2 response_as_string ( $response )
From a hash that uses keys C<blacks> and C<whites>, returns a string
"xb-yw" in a standard format that can be used for comparing.
=head1 CONFIGURATION AND ENVIRONMENT
Algorithm::MasterMind requires no configuration files or environment variables.
lib/Algorithm/MasterMind/CGA_Partitions.pm view on Meta::CPAN
use base 'Algorithm::MasterMind::Canonical_GA';
use Algorithm::MasterMind qw(partitions);
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
my $pop = $self->{'_pop'};
my $cga = $self->{'_ga'};
map( $_->evaluate( $self->{'_fitness'}), @$pop );
my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;
my %consistent;
# print "Consistent in ", scalar keys %{$self->{'_consistent'}}, "\n";
if ( $self->{'_consistent'} ) { #Check for consistency
%consistent = %{$self->{'_consistent'}};
for my $c (keys %consistent ) {
lib/Algorithm/MasterMind/CGA_Partitions.pm view on Meta::CPAN
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 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 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
lib/Algorithm/MasterMind/Canonical_GA.pm view on Meta::CPAN
$self->{'_fitness'} = $fitness;
$self->{'_ga'} = $ga;
}
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
my $pop = $self->{'_pop'};
my $ga = $self->{'_ga'};
map( $_->evaluate( $self->{'_fitness'}), @$pop );
my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;
if ( $ranked_pop[0]->{'_matches'} == $rules ) { #Already found!
return $self->{'_last'} = $ranked_pop[0]->{'_str'};
} else {
my @pop_by_matches;
my $best;
lib/Algorithm/MasterMind/EDA.pm view on Meta::CPAN
Op::EDA_step );
sub fitness {
my $self = shift;
my $object = shift;
my $combination = $object->{'_str'};
my $matches = $self->matches( $combination );
$object->{'_matches'} = $matches->{'matches'};
my $blacks_and_whites = 1;
for my $r (@{$matches->{'result'}} ) {
$blacks_and_whites += $r->{'blacks'} + $r->{'whites'}+ $self->{'_length'}*$r->{'match'};
}
return $blacks_and_whites;
}
sub initialize {
my $self = shift;
my $options = shift;
for my $o ( keys %$options ) {
$self->{"_$o"} = $options->{$o};
}
$self->{'_fitness'} = 'orig' if !$self->{'_fitness'};
$self->{'_first'} = 'orig' if !$self->{'_first'};
my $length = $options->{'length'};
#----------------------------------------------------------#
# #
my $fitness;
if ( $self->{'_fitness'} eq 'orig' ) {
$fitness = sub { $self->fitness_orig(@_) };
} elsif ( $self->{'_fitness'} eq 'naive' ) {
$fitness = sub { $self->fitness(@_) };
} elsif ( $self->{'_fitness'} eq 'compress' ) {
$fitness = sub { $self->fitness_compress(@_) };
lib/Algorithm/MasterMind/EDA.pm view on Meta::CPAN
}
sub issue_first {
my $self = shift;
my ( $i, $string);
my @alphabet = @{ $self->{'_alphabet'}};
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;
return $self->{'_last'} = $string;
}
sub issue_next {
my $self = shift;
lib/Algorithm/MasterMind/EDA.pm view on Meta::CPAN
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 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 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
lib/Algorithm/MasterMind/EDA_Partitions.pm view on Meta::CPAN
use base 'Algorithm::MasterMind::EDA';
use Algorithm::MasterMind qw(partitions);
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
my $pop = $self->{'_pop'};
my $eda = $self->{'_eda'};
map( $_->evaluate( $self->{'_fitness'}), @$pop );
my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;
my %consistent;
# print "Consistent in ", scalar keys %{$self->{'_consistent'}}, "\n";
if ( $self->{'_consistent'} ) { #Check for consistency
%consistent = %{$self->{'_consistent'}};
for my $c (keys %consistent ) {
lib/Algorithm/MasterMind/EDA_Partitions.pm view on Meta::CPAN
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 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 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
lib/Algorithm/MasterMind/Evo.pm view on Meta::CPAN
my $self = shift;
my $options = shift;
for my $o ( keys %$options ) {
$self->{"_$o"} = clone($options->{$o});
}
croak "No population" if $self->{'_pop_size'} == 0;
# Variation operators
my $mutation_rate = $options->{'mutation_rate'} || 1;
my $permutation_rate = $options->{'permutation_rate'} || 0;
my $permutation_iters = $options->{'permutation_iterations'} || factorial($options->{'length'}) - 1 ;
my $xover_rate = $options->{'xover_rate'} || 1;
my $max_number_of_consistent = $options->{'consistent_set_card'}
|| MAX_CONSISTENT_SET;
$self->{'_replacement_rate'}= $self->{'_replacement_rate'} || 0.25;
my $m = new Algorithm::Evolutionary::Op::String_Mutation $mutation_rate ; # Rate = 1
my $c = Algorithm::Evolutionary::Op::Uniform_Crossover_Diff->new( $options->{'length'}/2, $xover_rate );
my $operators = [$m,$c];
if ( $permutation_rate > 0 ) {
my $p = new Algorithm::Evolutionary::Op::Permutation $permutation_rate, $permutation_iters;
push @$operators, $p;
}
my $select = new Algorithm::Evolutionary::Op::Tournament_Selection $self->{'_tournament_size'} || 2;
if (! $self->{'_ga'} ) { # Not given as an option
$self->{'_ga'} = new Algorithm::Evolutionary::Op::Breeder_Diverser( $operators, $select );
}
$self->{'_replacer'} = new Algorithm::Evolutionary::Op::Replace_Different;
lib/Algorithm/MasterMind/Evo.pm view on Meta::CPAN
$min_distance + 1);
}
}
#----------------------------------------------------------------------------
sub eliminate_last_played {
my $self = shift;
my $last_played = $self->{'_last'};
for my $p ( @{$self->{'_pop'}} ) {
if ($p->{'_str'} eq $last_played ) {
$p = new Algorithm::Evolutionary::Individual::String( $self->{'_alphabet'}, $self->{'_length'} );
}
}
}
#----------------------------------------------------------------------------
sub issue_next {
my $self = shift;
my @rules = @{$self->{'_rules'}};
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
my $pop = $self->{'_pop'};
my $rules = $self->number_of_rules();
my $ga = $self->{'_ga'};
my $max_number_of_consistent = $self->{'_max_consistent'};
my $last_rule = $rules[$#rules];
my $alphabet_size = @{$self->{'_alphabet'}};
if ( $self->{'_played_out'} ) {
$self->eliminate_last_played;
}
#Check for combination guessed right except for permutation
if ($last_rule->{'blacks'}+$last_rule->{'whites'} == $length ) {
if ( ! $self->{'_consistent_endgame'} ) {
my %permutations;
map( $permutations{$_} = 1,
map(join("",@$_),
permutations([ split( //, $last_rule->{'combination'} ) ] ) ) );
my @permutations = keys %permutations;
$self->{'_endgame'} =
Algorithm::MasterMind::Partition::Most->start_from( { evaluated => $self->{'_evaluated'},
alphabet => \@alphabet,
rules => $self->{'_rules'},
lib/Algorithm/MasterMind/Evo.pm view on Meta::CPAN
if ($last_rule->{'blacks'}+$last_rule->{'whites'} == 0 ) {
my %these_colors;
map ( $these_colors{$_} = 1, split( //, $last_rule->{'combination'} ) );
for (my $i = 0; $i < @{$self->{'_alphabet'}}; $i++ ) {
if ($these_colors{$self->{'_alphabet'}->[$i]} ) {
delete $self->{'_alphabet'}->[$i] ;
}
}
@{$self->{'_alphabet'}} = grep( $_, @{$self->{'_alphabet'}} ); # Eliminate nulls
if ( @{$self->{'_alphabet'}} == 1 ) { # It could happen, and has happened
return $self->{'_alphabet'}->[0] x $length;
}
if ( @{$self->{'_alphabet'}} < $alphabet_size ) {
$self->realphabet;
if ( !$self->{'_noshrink'} ) {
my $shrinkage = @{$self->{'_alphabet'}} /$alphabet_size;
print "Shrinking to size ", @$pop * $shrinkage
," with alphabet ", join( " ", @{$self->{'_alphabet'}} ), "\n";
$self->shrink_to( (scalar @$pop) * $shrinkage );
}
}
lib/Algorithm/MasterMind/EvoRank.pm view on Meta::CPAN
$p->Fitness( $p->{'_distance'}+
($p->{'_partitions'}?$p->{'_partitions'}:0)-
$min_distance + 1);
}
}
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
my $pop = $self->{'_pop'};
my $ga = $self->{'_ga'};
my $max_number_of_consistent = $self->{'_max_consistent'};
#Recalculate distances, new game
my (%consistent );
my $partitions;
my $distance = $self->{'_distance'};
for my $p ( @$pop ) {
($p->{'_distance'}, $p->{'_matches'}) = @{$self->$distance( $p->{'_str'} )};
lib/Algorithm/MasterMind/Evolutionary.pm view on Meta::CPAN
$self->{'_fitness'} = $fitness;
$self->{'_ga'} = $ga;
}
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
my $pop = $self->{'_pop'};
my $ga = $self->{'_ga'};
map( $_->evaluate( $self->{'_fitness'}), @$pop );
my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;
if ( $ranked_pop[0]->{'_matches'} == $rules ) { #Already found!
return $self->{'_last'} = $ranked_pop[0]->{'_str'};
} else {
my @pop_by_matches;
my $best;
lib/Algorithm/MasterMind/Evolutionary_Base.pm view on Meta::CPAN
my $self = shift;
#Initialize population for next step
$self->reset();
$self->{'_first'} = 1; # flag for first
return $self->{'_last'} = $self->issue_first_Knuth();
}
sub reset {
my $self=shift;
my %pop;
if ( scalar( (@{$self->{'_alphabet'}})** $self->{'_length'} ) < $self->{'_pop_size'} ) {
croak( "Can't do, population bigger than space" );
}
while ( scalar ( keys %pop ) < $self->{'_pop_size'} ) {
my $indi = Algorithm::Evolutionary::Individual::String->new( $self->{'_alphabet'}, $self->{'_length'} );
$pop{ $indi->{'_str'}} = $indi;
}
my @pop = values %pop;
$self->{'_pop'}= \@pop;
}
sub reset_old {
my $self=shift;
my @pop;
for ( 0.. ($self->{'_pop_size'}-1) ) {
my $indi = Algorithm::Evolutionary::Individual::String->new( $self->{'_alphabet'},
$self->{'_length'} );
push( @pop, $indi );
}
$self->{'_pop'}= \@pop;
}
sub realphabet {
my $self = shift;
my $alphabet = $self->{'_alphabet'};
my $pop = $self->{'_pop'};
my %alphabet_hash;
map ( $alphabet_hash{$_} = 1, @$alphabet );
for my $p ( @$pop ) {
for ( my $i = 0; $i < length( $p->{'_str'} ); $i++ ) {
if ( !$alphabet_hash{substr($p->{'_str'},$i,1)} ) {
substr($p->{'_str'},$i,1, $alphabet->[rand( @$alphabet )]);
}
}
$p->{'_chars'} = $alphabet;
}
}
sub shrink_to {
my $self = shift;
lib/Algorithm/MasterMind/Evolutionary_MO.pm view on Meta::CPAN
}
sub issue_first {
my $self = shift;
#Initialize population for next step
my @pop;
for ( 0.. ($self->{'_pop_size'}-1) ) {
my $indi = Algorithm::Evolutionary::Individual::String->new( $self->{'_alphabet'},
$self->{'_length'} );
push( @pop, $indi );
}
$self->{'_pop'}= \@pop;
return $self->{'_last'} = $self->issue_first_Knuth();;
}
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
my $pop = $self->{'_pop'};
my $moga = $self->{'_moga'};
map( $_->evaluate( $self->{'_fitness'}), @$pop );
my @ranked_pop = sort { $a->{_fitness}[0] <=> $b->{_fitness}[0]; } @$pop;
if ( $ranked_pop[0]->{'_matches'} == $rules ) { #Already found!
return $self->{'_last'} = $ranked_pop[0]->{'_str'};
} else {
my @pop_by_matches;
my $best;
lib/Algorithm/MasterMind/Evolutionary_Partitions.pm view on Meta::CPAN
use Algorithm::Evolutionary::Op::Easy;
use Algorithm::Evolutionary::Individual::String;
# ---------------------------------------------------------------------------
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
my $pop = $self->{'_pop'};
my $ga = $self->{'_ga'};
map( $_->evaluate( $self->{'_fitness'}), @$pop );
my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;
my %consistent;
# print "Consistent in ", scalar keys %{$self->{'_consistent'}}, "\n";
if ( $self->{'_consistent'} ) { #Check for consistency
%consistent = %{$self->{'_consistent'}};
for my $c (keys %consistent ) {
lib/Algorithm/MasterMind/MOGA.pm view on Meta::CPAN
Op::Easy_MO );
sub fitness {
my $self = shift;
my $object = shift;
my $combination = $object->{'_str'};
my $matches = $self->matches( $combination );
$object->{'_matches'} = $matches->{'matches'};
my $blacks_and_whites = 1;
for my $r (@{$matches->{'result'}} ) {
$blacks_and_whites += $r->{'blacks'} + $r->{'whites'}+ $self->{'_length'}*$r->{'match'};
}
return $blacks_and_whites;
}
sub fitness_orig {
my $self = shift;
my $object = shift;
my $combination = $object->{'_str'};
my $matches = $self->matches( $combination );
lib/Algorithm/MasterMind/MOGA.pm view on Meta::CPAN
}
sub initialize {
my $self = shift;
my $options = shift;
for my $o ( keys %$options ) {
$self->{"_$o"} = $options->{$o};
}
$self->{'_fitness'} = 'orig' if !$self->{'_fitness'};
$self->{'_first'} = 'orig' if !$self->{'_first'};
my $length = $options->{'length'};
#----------------------------------------------------------#
#
my $fitness;
if ( $self->{'_fitness'} eq 'orig' ) {
$fitness = sub { $self->fitness_orig(@_) };
} elsif ( $self->{'_fitness'} eq 'naive' ) {
$fitness = sub { $self->fitness(@_) };
} elsif ( $self->{'_fitness'} eq 'compress' ) {
$fitness = sub { $self->fitness_compress(@_) };
lib/Algorithm/MasterMind/MOGA.pm view on Meta::CPAN
}
sub issue_first {
my $self = shift;
my ( $i, $string);
my @alphabet = @{ $self->{'_alphabet'}};
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;
return $self->{'_last'} = $string;
}
sub issue_next {
my $self = shift;
lib/Algorithm/MasterMind/MOGA.pm view on Meta::CPAN
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 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 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
lib/Algorithm/MasterMind/Partition/Most.pm view on Meta::CPAN
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
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
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
for my $o ( keys %$options ) {
$self->{"_$o"} = $options->{$o};
}
}
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my ($match, $string);
my @alphabet = @{$self->{'_alphabet'}};
my $length = $self->{'_length'};
do {
$string ='';
for ( my $i = 0; $i < $length; $i++ ) {
$string .= $alphabet[rand(@alphabet)];
}
$match = $self->matches($string);
$self->{'_evaluated'}++;
} while ( $match->{'matches'} < $rules );
return $self->{'_last'} = $string;
}
"some blacks, 0 white"; # Magic true value required at end of module
lib/Algorithm/MasterMind/Random.pm view on Meta::CPAN
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/Sequential.pm view on Meta::CPAN
use Algorithm::Combinatorics qw(variations_with_repetition);
sub initialize {
my $self = shift;
my $options = shift || croak "Need options here";
for my $o ( keys %$options ) {
$self->{"_$o"} = $options->{$o}
}
my @alphabet = @{$self->{'_alphabet'}};
$self->{'_engine'} = variations_with_repetition(\@alphabet, $options->{'length'});
$self->{'_range'} = $alphabet[0]."-".$alphabet[$#alphabet];
$self->{'_current_string'} = $alphabet[0] x $self->{'_length'};
$self->{'_last_string'} = $alphabet[$#alphabet]x $self->{'_length'};
}
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my ($match, $string, $combination);
while ( $combination = $self->{'_engine'}->next ) {
$string = join("", @$combination);
lib/Algorithm/MasterMind/Sequential.pm view on Meta::CPAN
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()
Called from base class, mainly
=head2 new ( $options )
lib/Algorithm/MasterMind/Sequential_Alt.pm view on Meta::CPAN
use Algorithm::Combinatorics qw(variations_with_repetition);
sub initialize {
my $self = shift;
my $options = shift || croak "Need options here";
for my $o ( keys %$options ) {
$self->{"_$o"} = $options->{$o}
}
my @alphabet = @{$self->{'_alphabet'}};
my @tebahpla = reverse @alphabet;
$self->{'_engine_fw'} = variations_with_repetition(\@alphabet, $options->{'length'});
$self->{'_engine_bw'} = variations_with_repetition(\@tebahpla, $options->{'length'});
$self->{'_current_min'} = $alphabet[0]x$options->{'length'};
$self->{'_current_max'} = $tebahpla[0]x$options->{'length'};
$self->{'_direction'} = 1; # Forward, 0 for backwards
}
sub issue_next {
my $self = shift;
my $rules = $self->number_of_rules();
my ($match, $string);
do {
if ( $self->{'_direction'} ) {
$string = join("",@{$self->{'_engine_fw'}->next});
lib/Algorithm/MasterMind/Sequential_Alt.pm view on Meta::CPAN
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
=head2 initialize()
Called from base class, mainly
=head2 new ( $options )
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 ) {
lib/Algorithm/MasterMind/Test_Solver.pm view on Meta::CPAN
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
t/00_sequential.t view on Meta::CPAN
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 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 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 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
use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(random_string);
use Algorithm::MasterMind::Secret;
BEGIN {
use_ok( 'Algorithm::MasterMind::Consistent_Set' );
}
my $size = 128;
my @alphabet = qw( A B C D E F );
my $length = 4;
my @strings;
for (1..$size) {
push @strings, random_string( \@alphabet, $length);
}
my $c_set = new Algorithm::MasterMind::Consistent_Set( \@strings );
my @sorted = sort @strings;
my @sorted_set = sort $c_set->consistent_strings;
is( $sorted_set[0], $sorted[0], 'Set OK' );
is( $sorted_set[$#sorted_set], $sorted[$#sorted], 'Set OK' );
for my $s (@strings ) {
ok( $c_set->is_in( $s ), 'Added');
t/04_consistent_set.t view on Meta::CPAN
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' );
}
my $new_random_string = ( random_string( \@alphabet, $length) );
$c_set->add_combination( $new_random_string );
ok( $c_set->is_in( $new_random_string ), 'Added');
@strings = qw(AAAA BBBB CCCC ABCD);
$c_set = new Algorithm::MasterMind::Consistent_Set( \@strings );
my %partitions = (
'AAAA' => { '0b-0w' => 2,
'1b-0w' => 1},
'ABCD' =>{ '1b-0w' => 3 },
'BBBB' => { '0b-0w' => 2,
t/04_partitions.t view on Meta::CPAN
use Test::More tests => 10;
use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place
use Algorithm::MasterMind qw(partitions);
use Algorithm::MasterMind::Test;
use Algorithm::Combinatorics qw(variations_with_repetition);
diag( "This could take a while \n" );
my $length= 3;
my @alphabet = qw( A B );
my $mastermind = new Algorithm::MasterMind::Test( {alphabet => \@alphabet,
length => $length} );
my @responses = $mastermind->all_responses();
is ( $#responses, 8, "Responses" );
my @combinations = $mastermind->all_combinations;
is ( $combinations[$#combinations], $alphabet[$#alphabet]x$length, "Combinations generated"),
my $partitions = partitions( @combinations ) ;
is( $partitions->{'AAA'}{'0b-0w'}, 1, "Partions computed" );
$length= 4;
@alphabet = qw( A B C D );
$mastermind = new Algorithm::MasterMind::Test( {alphabet => \@alphabet,
length => $length} );
@responses = $mastermind->all_responses();
is ( $#responses, 13, "Responses" );
@combinations = $mastermind->all_combinations;
is ( $combinations[$#combinations], $alphabet[$#alphabet]x$length, "Combinations generated"),
$partitions = partitions( @combinations ) ;
is( keys %$partitions, @combinations, "Number of partitions" );
my $engine = variations_with_repetition( \@alphabet, $length);
my $first_combo = join("",@{$engine->next()});
my $number_of_combos= 0;
for my $p ( keys %{$partitions->{$first_combo}} ) {
$number_of_combos += $partitions->{$first_combo}{$p}
}
is ( $number_of_combos, $#combinations, "Number of combinations" );
#Test responses
for my $length ( 5..7 ) {
$mastermind = new Algorithm::MasterMind::Test( { alphabet => \@alphabet,
length => $length } );
my @responses = $mastermind->all_responses();
is( $responses[$#responses-1], ($length-1)."B-0W", "Responses $length" );
}
t/05_partition_most.t view on Meta::CPAN
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 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" );
( run in 0.954 second using v1.01-cache-2.11-cpan-65fba6d93b7 )