xref: /inferno-os/appl/math/crackerbarrel.b (revision 37da2899f40661e3e9631e497da8dc59b971cbd0) 
1implement CBPuzzle;
2
3# Cracker Barrel Puzzle
4#
5# Holes are drilled in a triangular arrangement into which all but one
6# are seated pegs. A 6th order puzzle appears in the diagram below.
7# Note, the hole in the lower left corner of the triangle is empty.
8#
9#                 V
10#               V   V
11#             V   V   V
12#           V   V   V   V
13#         V   V   V   V   V
14#       O   V   V   V   V   V
15#
16# Pegs are moved by jumping over a neighboring peg thereby removing the
17# jumped peg. A peg can only be moved if a neighboring hole contains a
18# peg and the hole on the other side of the neighbor is empty. The last
19# peg cannot be removed.
20#
21# The object is to remove as many pegs as possible.
22
23include "sys.m";
24   sys: Sys;
25include "draw.m";
26
27CBPuzzle: module {
28   init: fn(nil: ref Draw->Context, args: list of string);
29};
30
31ORDER: con 6;
32
33Move: adt {
34   x, y: int;
35};
36
37valid:= array[] of {Move (1,0), (0,1), (-1,1), (-1,0), (0,-1), (1,-1)};
38
39board:= array[ORDER*ORDER] of int;
40pegs, minpegs: int;
41
42puzzle(): int
43{
44   if (pegs < minpegs)
45      minpegs = pegs;
46
47   if (pegs == 1)
48      return 1;
49
50   # Check each row of puzzle
51   for (r := 0; r < ORDER; r += 1)
52      # Check each column
53      for (c := 0; c < ORDER-r; c += 1) {
54         fromx := r*ORDER + c;
55         # Is a peg in this hole?
56         if (board[fromx])
57            # Check valid moves from this hole
58            for (m := 0; m < len valid; m += 1) {
59               tor := r + 2*valid[m].y;
60               toc := c + 2*valid[m].x;
61
62               # Is new location still on the board?
63               if (tor + toc < ORDER && tor >= 0 && toc >= 0) {
64                  jumpr := r + valid[m].y;
65                  jumpc := c + valid[m].x;
66                  jumpx := jumpr*ORDER + jumpc;
67
68                  # Is neighboring hole occupied?
69                  if (board[jumpx]) {
70                     # Is new location empty?
71                     tox := tor*ORDER + toc;
72
73                     if (! board[tox]) {
74                        # Jump neighboring hole
75                        board[fromx] = 0;
76                        board[jumpx] = 0;
77                        board[tox] = 1;
78                        pegs -= 1;
79
80                        # Try solving puzzle from here
81                        if (puzzle()) {
82                           #sys->print("(%d,%d) - (%d,%d)\n", r, c, tor, toc);
83                           return 1;
84                        }
85                        # Dead end, put pegs back and try another move
86                        board[fromx] = 1;
87                        board[jumpx] = 1;
88                        board[tox] = 0;
89                        pegs += 1;
90                     } # empty location
91                  } # occupied neighbor
92               } # still on board
93            } # valid moves
94      }
95   return 0;
96}
97
98solve(): int
99{
100   minpegs = pegs = (ORDER+1)*ORDER/2 - 1;
101
102   # Put pegs on board
103   for (r := 0; r < ORDER; r += 1)
104      for (c := 0; c < ORDER - r; c += 1)
105         board[r*ORDER + c] = 1;
106
107   # Remove one peg
108   board[0] = 0;
109
110   return puzzle();
111}
112
113init(nil: ref Draw->Context, args: list of string)
114{
115   sys = load Sys Sys->PATH;
116
117   TRIALS: int;
118   if (len args < 2)
119      TRIALS = 1;
120   else
121      TRIALS = int hd tl args;
122
123   start := sys->millisec();
124   for (trials := 0; trials < TRIALS; trials += 1)
125      solved := solve();
126   end := sys->millisec();
127
128   sys->print("%d ms\n", end - start);
129
130   if (! solved)
131      sys->print("No solution\n");
132   sys->print("Minimum pegs: %d\n", minpegs);
133}
134