ref: a5cb451b299b03f44154fac5780b6a57ca130ce0
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); }