1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
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);
}
|
