#!/usr/bin/perl
use strict;

sub usage {
	print STDERR <<USAGE;

Usage: $0 <start>

Board:    0              Solves that pyramid peg game where you remove
        1   2            one peg and then jump pegs out of the game.
      3   4   5          (brute-force method)
    6   7   8   9
  10  11  12  13 14      Supply <start> as the first missing peg.

Output is one solution per line, showing list of jumps.
Ex: "3-1-0" means jump peg 3 over peg 1 to empty peg 0, removing peg 1.

A '!' at the beginning of the line means it's a super solution
(where the last peg lands in the same spot the first was removed)

Really just an example of a concise way to write such a program.
(Disregarding setup, it's something like under 30 lines of perl)

USAGE
	exit;
}

usage() unless @ARGV;
my $start = shift @ARGV;
usage() if $start =~ /\D/ || $start > 14;

# $lines[A] is a list of legal jumps we can make from A
# Since 0->1->3 and 0->2->5 are legal jumps, then:
# $lines[0] has 1,3 and 2,5 listed.  See below..
my @lines;
$lines[0]=[[1,3],[2,5]];
$lines[1]=[[3,6],[4,8]];
$lines[2]=[[5,9],[4,7]];
$lines[3]=[[1,0],[6,10],[7,12],[4,5]];
$lines[4]=[[7,11],[8,13]];
$lines[5]=[[2,0],[8,12],[3,4],[9,14]];
$lines[6]=[[3,1],[7,8]];
$lines[7]=[[4,2],[8,9]];
$lines[8]=[[1,4],[6,7]];
$lines[9]=[[2,5],[7,8]];
$lines[10]=[[6,3],[11,12]];
$lines[11]=[[7,4],[12,13]];
$lines[12]=[[7,3],[8,5],[10,11],[13,14]];
$lines[13]=[[11,12],[4,8]];
$lines[14]=[[5,9],[12,13]];

my @board=(1)x15;  $board[$start]=0;
my @solution;
my $bad=0;
my $good=0;
my $super=0;

sub pegs_left { grep($_,@_); }

choose_peg(\@board,\@solution);

sub show_solution {
  my (@solution) = @_;

  $good++;

  # Is the last open peg also the start peg?
  my $perfect=1 if ($solution[$#solution]->[0]==$start);
  $super++ if ($perfect);
  print $perfect ? "!" : " ";

  foreach my $jump ( @solution ) { print " ",join('-',reverse @$jump); }
  print "\n";
}

sub try_peg {
  my ($open,$close1,$close2,$board_L,$solution_L) = @_;

  # Make copies of the arrays and use those
  my @new_board=@$board_L;
  my @new_solution=@$solution_L;

#  print "$close2 jumps $close1 to $open\n";
  $new_board[$open]=1;
  $new_board[$close1]=0;
  $new_board[$close2]=0;

  push(@new_solution,[$open,$close1,$close2]);

  return show_solution(@new_solution) if (pegs_left(@new_board)==1);

  choose_peg(\@new_board,\@new_solution);
}

sub choose_peg {
  my ($board_L,$solution_L) = @_;

#print "LEFT: ",(scalar pegs_left(@$board_L)),"\n" if (pegs_left(@$board_L)>11);

  # Find all possible open pegs
  my @try;	# Possible lines to invert
  my @open=grep(!$board_L->[$_], 0..14);
  foreach my $open ( @open ) {
    foreach my $l ( @{$lines[$open]} ) {
      #push(@try,[$open,@$l]) if ($board_L->[$l->[0]] && $board_L->[$l->[1]]);
      try_peg($open,$l->[0],$l->[1],$board_L,$solution_L)
        if ($board_L->[$l->[0]] && $board_L->[$l->[1]]);
    }
  }

  # Print unwind stack, no possible jumps
  $bad++;
}

print "Bad/good/super:  $bad/$good/$super\n";