shithub: purgatorio

ref: 3866717cbb020199d58171c1c0cdd7382a74ee82
dir: /appl/math/crackerbarrel.b/

implement CBPuzzle;

# Cracker Barrel Puzzle
#
# Holes are drilled in a triangular arrangement into which all but one
# are seated pegs. A 6th order puzzle appears in the diagram below.
# Note, the hole in the lower left corner of the triangle is empty.
#
#                 V
#               V   V
#             V   V   V
#           V   V   V   V
#         V   V   V   V   V
#       O   V   V   V   V   V
#
# Pegs are moved by jumping over a neighboring peg thereby removing the
# jumped peg. A peg can only be moved if a neighboring hole contains a
# peg and the hole on the other side of the neighbor is empty. The last
# peg cannot be removed.
#
# The object is to remove as many pegs as possible.

include "sys.m";
   sys: Sys;
include "draw.m";

CBPuzzle: module {
   init: fn(nil: ref Draw->Context, args: list of string);
};

ORDER: con 6;

Move: adt {
   x, y: int;
};

valid:= array[] of {Move (1,0), (0,1), (-1,1), (-1,0), (0,-1), (1,-1)};

board:= array[ORDER*ORDER] of int;
pegs, minpegs: int;

puzzle(): int
{
   if (pegs < minpegs)
      minpegs = pegs;

   if (pegs == 1)
      return 1;

   # Check each row of puzzle
   for (r := 0; r < ORDER; r += 1)
      # Check each column
      for (c := 0; c < ORDER-r; c += 1) {
         fromx := r*ORDER + c;
         # Is a peg in this hole?
         if (board[fromx])
            # Check valid moves from this hole
            for (m := 0; m < len valid; m += 1) {
               tor := r + 2*valid[m].y;
               toc := c + 2*valid[m].x;

               # Is new location still on the board?
               if (tor + toc < ORDER && tor >= 0 && toc >= 0) {
                  jumpr := r + valid[m].y;
                  jumpc := c + valid[m].x;
                  jumpx := jumpr*ORDER + jumpc;

                  # Is neighboring hole occupied?
                  if (board[jumpx]) {
                     # Is new location empty?
                     tox := tor*ORDER + toc;

                     if (! board[tox]) {
                        # Jump neighboring hole
                        board[fromx] = 0;
                        board[jumpx] = 0;
                        board[tox] = 1;
                        pegs -= 1;

                        # Try solving puzzle from here
                        if (puzzle()) {
                           #sys->print("(%d,%d) - (%d,%d)\n", r, c, tor, toc);
                           return 1;
                        }
                        # Dead end, put pegs back and try another move
                        board[fromx] = 1;
                        board[jumpx] = 1;
                        board[tox] = 0;
                        pegs += 1;
                     } # empty location
                  } # occupied neighbor
               } # still on board
            } # valid moves
      }
   return 0;
}

solve(): int
{
   minpegs = pegs = (ORDER+1)*ORDER/2 - 1;

   # Put pegs on board
   for (r := 0; r < ORDER; r += 1)
      for (c := 0; c < ORDER - r; c += 1)
         board[r*ORDER + c] = 1;

   # Remove one peg
   board[0] = 0;

   return puzzle();
}

init(nil: ref Draw->Context, args: list of string)
{
   sys = load Sys Sys->PATH;

   TRIALS: int;
   if (len args < 2)
      TRIALS = 1;
   else
      TRIALS = int hd tl args;

   start := sys->millisec();
   for (trials := 0; trials < TRIALS; trials += 1)
      solved := solve();
   end := sys->millisec();

   sys->print("%d ms\n", end - start);

   if (! solved)
      sys->print("No solution\n");
   sys->print("Minimum pegs: %d\n", minpegs);
}