#!/usr/bin/perl -w use strict; # \$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 "Trying to make ", 1 + \$_, " the remaining peg...\n"; \$state[\$_] = 0; jump(\@state, [], {}, \$_); \$state[\$_] = 1; } sub jump { # state, history, repetitions, original blank spot my (\$st, \$hist, \$rep, \$orig) = @_; my \$ok = 0; # we don't count permutations of movements # update: sort @\$hist => sort map "@\$_", @\$hist 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 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 \$st->[\$orig] == 1; }