I got bored. I forgot how to solve it in some ways (like, leave 8
remaining with no possible jumps) so I made Perl do it for me. That was
fun. With Perl. (Get it?)
#!/usr/bin/perl -w
use strict;
use constant ONE_LEFT => 0x01;
use constant SAME_LEFT => 0x03;
use constant EIGHT_LEFT => 0x04;
use constant GAME => EIGHT_LEFT;
# $board[$empty_pos]{$jumpable} = $jumper
my @board = (
{ 1 => 3, 2 => 5, },
{ 3 => 6, 4 => 8, },
{ 4 => 7, 5 => 9, },
{ 1 => 0, 4 => 5, 6 => 10, 7 => 12, },
{ 7 => 11, 8 => 13, },
{ 2 => 0, 4 => 3, 8 => 12, 9 => 14, },
{ 3 => 1, 7 => 8, },
{ 4 => 2, 8 => 9, },
{ 4 => 1, 7 => 6, },
{ 5 => 2, 8 => 7, },
{ 6 => 3, 11 => 12, },
{ 7 => 4, 12 => 13, },
{ 7 => 3, 8 => 5, 11 => 10, 13 => 14, },
{ 8 => 4, 12 => 11, },
{ 9 => 5, 13 => 12, },
);
# 0 = empty, 1 = peg
my @state = (1) x 15;
# choosing a blank spot, one by one
# we only do five spots, since the board
# is made up of three sets of these five spots
# merely rotated -- there's no need to do extra work
for (0..4) {
print "Leaving ", $_ + 1, " empty.\n";
$state[$_] = 0;
jump(\@state, [], {}, $_);
$state[$_] = 1;
}
sub jump {
# state, history, repetitions, original blank spot
my ($st, $hist, $rep, $orig) = @_;
my $ok = 0;
return if GAME & EIGHT_LEFT and grep($_, @$st) < 8;
# we don't count permutations of movements
return if $rep->{ join "\n", sort map "@$_", @$hist }++;
# for each of the blank positions on the board...
for my $pos (grep !$st->[$_], 0 .. $#$st) {
# if there are two available pegs (one to jump, one to be jumped)...
for (grep $st->[$_] && $st->[$board[$pos]{$_}], keys %{ $board[$pos] }) {
# the empty place becomes pegged
# and the jumper and jumped become empty
$ok = $st->[$pos] = !($st->[$_] = $st->[$board[$pos]{$_}] = 0);
# add this event to our history
push @$hist, [ 1 + $board[$pos]{$_}, 1 + $pos ];
# and now jump again! (the meat of recursion)
jump($st, $hist, $rep, $orig);
# after we're done, remove the latest addition to the history
pop @$hist;
# and set the pegged place to empty again
# and the two empty places back to pegged
$st->[$pos] = !($st->[$_] = $st->[$board[$pos]{$_}] = 1);
}
}
if (GAME & ONE_LEFT) {
# if we have ONE peg left, and it's the where the blank spot was
# show the history to explain how we got here!
print map("$_->[0] to $_->[1]\n", @$hist), "\n"
if grep($_, @$st) == 1 and GAME & SAME_LEFT ? $st->[$orig] : 1;
}
if (GAME & EIGHT_LEFT) {
# if we have EIGHT pegs left, and no possible moves, we're
# geniuses (apparently), so show the history
print map("$_->[0] to $_->[1]\n", @$hist), "\n"
if grep($_, @$st) == 8 and !$ok;
}
}
__END__
--
Jeff "japhy" Pinyan [EMAIL PROTECTED] http://www.pobox.com/~japhy/
RPI Acacia brother #734 http://www.perlmonks.org/ http://www.cpan.org/
** Look for "Regular Expressions in Perl" published by Manning, in 2002 **
