Permalink
Browse files

Import release 0.02 to GitHub.

  • Loading branch information...
0 parents commit e94e27bec865067d952a42292654b5833ef9a966 @mbarbon committed Oct 29, 2008
Showing with 468 additions and 0 deletions.
  1. +7 −0 .gitignore
  2. +16 −0 Build.PL
  3. +9 −0 Changes
  4. +14 −0 MANIFEST
  5. +41 −0 MANIFEST.SKIP
  6. +23 −0 examples/play.pl
  7. +127 −0 lib/Games/Mastermind/Solver.pm
  8. +100 −0 lib/Games/Mastermind/Solver/BruteForce.pm
  9. +7 −0 t/001_load.t
  10. +41 −0 t/002_internal.t
  11. +64 −0 t/003_public.t
  12. +11 −0 t/zzy_pod_coverage.t
  13. +8 −0 t/zzz_pod.t
@@ -0,0 +1,7 @@
+*~
+Build
+META.yml
+Makefile
+Makefile.PL
+_build
+blib
@@ -0,0 +1,16 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Module::Build;
+
+my $builder = Module::Build->new
+ ( module_name => 'Games::Mastermind::Solver',
+ license => 'perl',
+ dist_author => 'Mattia Barbon <mbarbon@cpan.org>',
+ requires => { 'Class::Accessor' => '0.27',
+ 'Games::Mastermind' => '0.01',
+ 'Test::More' => '0.48',
+ },
+ create_makefile_pl => 'passthrough',
+ );
+$builder->create_build_script;
@@ -0,0 +1,9 @@
+Revision history for Perl extension Games::Mastermind::Solver.
+
+0.02 Fri Sep 1 20:53:36 CEST 2006
+ - Renamed the implementation to Games::MasterMind::Solver::BruteForce
+ and left Games::Mastermind::Solver as an interface/documentation
+ module. (suggestion by Philippe "BooK" Bruhat)
+
+0.01 Fri Jun 19 21:24:20 CEST 2006
+ - Initial release.
@@ -0,0 +1,14 @@
+Build.PL
+Changes
+examples/play.pl
+lib/Games/Mastermind/Solver.pm
+lib/Games/Mastermind/Solver/BruteForce.pm
+MANIFEST
+MANIFEST.SKIP
+t/001_load.t
+t/002_internal.t
+t/003_public.t
+t/zzy_pod_coverage.t
+t/zzz_pod.t
+META.yml
+Makefile.PL
@@ -0,0 +1,41 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+\B\.cvsignore$
+^\.git/
+^\.gitignore$
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\bBuild.bat$
+\b_build
+
+# Avoid Devel::Cover generated files
+\bcover_db
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\.#
+\.rej$
+
+# Avoid OS-specific files/dirs
+# Mac OSX metadata
+\B\.DS_Store
+# Mac OSX SMB mount metadata files
+\B\._
+# Avoid archives of this distribution
+\bGames-Mastermind-Solver-[\d\.\_]+
@@ -0,0 +1,23 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use lib 'lib';
+
+use Games::Mastermind;
+use Games::Mastermind::Solver::BruteForce;
+
+my $player = Games::Mastermind::Solver::BruteForce
+ ->new( Games::Mastermind->new );
+my $try;
+
+print join( ' ', @{$player->game->code} ), "\n\n";
+
+until( $player->won || ++$try > 10 ) {
+ my( $win, $guess, $result ) = $player->move;
+
+ print join( ' ', @$guess ),
+ ' ',
+ 'B' x $result->[0], 'W' x $result->[1],
+ "\n";
+}
@@ -0,0 +1,127 @@
+package Games::Mastermind::Solver;
+
+use strict;
+use warnings;
+use base qw(Class::Accessor::Fast);
+
+our $VERSION = '0.02';
+
+__PACKAGE__->mk_ro_accessors( qw(game won) );
+
+sub new {
+ my( $class, $game ) = @_;
+ my $self = $class->SUPER::new( { game => $game } );
+ $self->reset;
+ return $self;
+}
+
+sub move {
+ my( $self, $guess ) = @_;
+ return ( 1, undef, undef ) if $self->won;
+
+ $guess ||= $self->guess;
+ my $result = $self->game->play( @$guess );
+ if( $result->[0] == $self->game->holes ) {
+ $self->{won} = 1;
+ } else {
+ $self->check( $guess, $result );
+ }
+
+ return ( $self->won, $guess, $result );
+}
+
+sub reset {
+ my( $self ) = @_;
+ $self->game->reset;
+ $self->{won} = 0;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Games::Mastermind::Solver - a Master Mind puzzle solver
+
+=head1 SYNOPSIS
+
+ # a trivial Mastermind solver
+
+ use Games::Mastermind;
+ use Games::Mastermind::Solver::BruteForce;
+
+ my $player = Games::Mastermind::Solver::BruteForce
+ ->new( Games::Mastermind->new );
+ my $try;
+
+ print join( ' ', @{$player->game->code} ), "\n\n";
+
+ until( $player->won || ++$try > 10 ) {
+ my( $win, $guess, $result ) = $player->move;
+
+ print join( ' ', @$guess ),
+ ' ',
+ 'B' x $result->[0], 'W' x $result->[1],
+ "\n";
+ }
+
+=head1 DESCRIPTION
+
+C<Games::Mastermind::Solver> is a base class for Master Mind solvers.
+
+=head1 METHODS
+
+=head2 new
+
+ $player = Games::Mastermind::Solver->new( $game );
+
+Constructor. Takes a C<Games::Mastermind> object as argument.
+
+=head2 move
+
+ ( $won, $guess, $result ) = $player->move;
+ ( $won, $guess, $result ) = $player->move( $guess );
+
+The player chooses a suitable move to continue the game, plays it
+against the game object passed as constructor and updates its knowledge
+of the solution. The C<$won> return value is a boolean, C<$guess> is
+an array reference holding the value passed to C<Games::Mastermind::play>
+and C<$result> is the value returned by C<play>.
+
+It is possible to pass an array reference as the move to make.
+
+=head2 remaining (optional)
+
+ $number = $player->remaining;
+
+The number of possible solutions given the knowledge the player has
+accumulated.
+
+=head2 reset
+
+ $player->reset;
+
+Resets the internal state of the player.
+
+=head2 guess
+
+ $guess = $player->guess;
+
+Guesses a solution (to be implemented in a subclass).
+
+=head2 check
+
+ $player->check( $guess, $result );
+
+Given a guess and the result for the guess, determines which positions
+are still possible solutions for the game (to be implemented in a subclass).
+
+=head2 AUTHOR
+
+Mattia Barbon <mbarbon@cpan.org>
+
+=head2 LICENSE
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
@@ -0,0 +1,100 @@
+package Games::Mastermind::Solver::BruteForce;
+
+use strict;
+use warnings;
+use base qw(Games::Mastermind::Solver);
+
+our $VERSION = '0.02';
+
+sub guess {
+ my( $self ) = @_;
+
+ return [ _from_number( $self->_guess, $self->_pegs, $self->_holes ) ];
+}
+
+sub _guess {
+ my( $self ) = @_;
+ die 'Cheat!' unless $self->remaining;
+ return $self->_possibility( rand $self->remaining );
+}
+
+sub remaining {
+ my $p = $_[0]->_possibility;
+ return $p ? scalar @$p : $_[0]->_peg_number ** $_[0]->_holes;
+}
+
+sub reset {
+ my( $self ) = @_;
+ $self->SUPER::reset;
+ $self->{possibility} = undef;
+}
+
+sub _possibility {
+ my( $self, $idx ) = @_;
+
+ return $self->{possibility} if @_ == 1;
+ return $self->{possibility} ? $self->{possibility}[$idx] : $idx;
+}
+
+sub check {
+ my( $self, $guess, $result ) = @_;
+ my $game = Games::Mastermind->new;
+ my( $pegs, $holes, @new ) = ( $self->_pegs, $self->_holes );
+
+ foreach my $try ( @{$self->_possibility || [0 .. $self->remaining - 1]} ) {
+ $game->code( [ _from_number( $try, $pegs, $holes ) ] );
+ my $try_res = $game->play( @$guess );
+ push @new, $try if $try_res->[0] == $result->[0]
+ && $try_res->[1] == $result->[1];
+ }
+
+ $self->{possibility} = \@new;
+}
+
+sub _from_number {
+ my( $number, $pegs, $holes ) = @_;
+ my $peg_number = @$pegs;
+ return map { my $peg = $number % $peg_number;
+ $number = int( $number / $peg_number );
+ $pegs->[$peg]
+ } ( 1 .. $holes );
+}
+
+sub _peg_number { scalar @{$_[0]->game->pegs} }
+sub _pegs { $_[0]->game->pegs }
+sub _holes { $_[0]->game->holes }
+
+1;
+
+__END__
+
+=head1 NAME
+
+Games::Mastermind::Solver::BruteForce - a Master Mind puzzle solver
+
+=head1 SYNOPSIS
+
+ # See Games::Mastermind::Solver
+
+=head1 DESCRIPTION
+
+C<Games::Mastermind::Solver::BruteForce> uses the classical
+brute-force algorithm for solving Master Mind puzzles.
+
+=head1 METHODS
+
+=head2 remaining
+
+ $number = $player->remaining;
+
+The number of possible solutions given the knowledge the player has
+accumulated.
+
+=head2 AUTHOR
+
+Mattia Barbon <mbarbon@cpan.org>
+
+=head2 LICENSE
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
@@ -0,0 +1,7 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 2;
+
+use_ok( 'Games::Mastermind::Solver' );
+use_ok( 'Games::Mastermind::Solver::BruteForce' );
@@ -0,0 +1,41 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 8;
+
+use Games::Mastermind;
+use Games::Mastermind::Solver::BruteForce;
+
+my $pegs = [ qw(B C G R Y W) ];
+my $holes = 4;
+
+my $game = Games::Mastermind->new
+ ( pegs => $pegs,
+ holes => $holes,
+ );
+my $player = Games::Mastermind::Solver::BruteForce->new( $game );
+
+is_deeply( [ Games::Mastermind::Solver::BruteForce::_from_number( 0, $pegs, $holes ) ],
+ [ qw(B B B B) ] );
+is_deeply( [ Games::Mastermind::Solver::BruteForce::_from_number( 1295, $pegs, $holes ) ],
+ [ qw(W W W W) ] );
+is_deeply( [ Games::Mastermind::Solver::BruteForce::_from_number( 1244, $pegs, $holes ) ],
+ [ qw(G R Y W) ] );
+
+is( $player->_peg_number, 6 );
+is_deeply( $player->_pegs, [ qw(B C G R Y W) ] );
+is( $player->_holes, 4 );
+
+srand( 123 );
+my $chosen = $player->_guess;
+srand( 123 );
+is( $player->_guess, $chosen );
+
+$player->{possibility} = [];
+
+eval {
+ my $chosen = $player->_guess;
+ ok( 0, 'Must not get there' );
+};
+ok( $@, 'Correctly dies' );
+
Oops, something went wrong.

0 comments on commit e94e27b

Please sign in to comment.