#!/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;
}