======================================================================== A Scheme Program to Find All Solutions to A Little Blue Cube Puzzle - or - What I Got From the Dot Com Boom ======================================================================== Try Your Hand at the Puzzle * Do it in under one minute? - here's some money -- go buy me a lottery ticket * How many distinct solutions? * What's a simple transformation to turn one solution into another? ======================================================================== McCarthy's Amb (amb exp ...) => exp nondeterminstically returns the value of one of its expressions (amb) => fails (amb tree exhausted) (amb 1 (amb) => 1 (amb (amb) 1) => 1 Amb must return a non-failing value, if at all possible. Amb must return that convergent value that makes the entire program converge (i.e. not fail with "amb tree exhausted" message). (Much of this is complements of Dorai Sitaram's TYSIFD, and private communication.) ======================================================================== Solving Logic Puzzle with Amb Traditional way of solving logic problems such as this: 1) Generate a bunch of potential top-level solutions ambiguously without regard to success. 2) Use assertions to prune away all absurdities. - Known in Prolog books as Generate and Test * * * A confession: this is actually my *second* Scheme program: (The first one was factorial -- but I've been reading a lot.) ======================================================================== Solving the Cube Puzzle the Prolog Way Complements of Dorai Sitaram 1) For each cube face, pick a piece in some orientation "out of whole cloth". Don't worry about keeping track of the growing state of the cube, the pieces already picked, etc. Don't even worry that you may be assigning the same piece to all faces! 2) Use amb in the form of an (ambiguous) "assert" to make assertions about the arbitrary choices made in (1). (define (amb-assert pred) (unless pred (amb))) *Declare* what *must* hold about choices made. - Pieces assigned to the faces must all be different (can be relaxed) - Pieces must fit together without bump clashes ======================================================================== Q: But doesn't Amb Overspecify Arity? A: In a word: No (define (choose-one choices) (if (null? choices) (amb) (amb (car choices) (choose-one (cdr choices))))) ======================================================================== A First Attempt at Specifying Constraints To Le Fr Ri Bo Bk One horizontal stripe: +- Fr - Ri - (R Bk) - Le -. | | +-------------------------+ Two vertical stripes: This This (or starting from the other side) +--+ +-----+ | | | | To | (R To) | | | | | Fr | Ri | | | | | Bo | (L Bo) | | | | | Bk | (I Le) | | | | | +--+ +-----+ Nothing is said about the corners! ======================================================================== The "Prolog" Solution (let ([To (choose-a-piece)] [Le (choose-a-piece)] [Fr A] [Ri (choose-a-piece)] [Bo (choose-a-piece)] [Bk (choose-a-piece)]) (begin (amb-assert (distinct? To Le Fr Ri Bo Bk)) (amb-assert (horizontal-edge-match Fr Ri (I Bk) Le)) (amb-assert (vertical-edge-match To Fr Bo Bk )) (amb-assert (vertical-edge-match (R To) Ri (L Bo) (I Le)))) (for-each display-piece (list To Le Fr Ri Bo Bk))) ======================================================================== A Disappointing First Attempt After 20 hours run time (on this 500MHz G3 iBook)... * not a single solution * back to the drawing board! ======================================================================== Large Numbers Don't Get No Respect (6 pieces) * (2 sides) * (4 orientations) = 48 possible choices for a face 6 faces to feed = 48 ^ 6 = 12,230,590,464 ======================================================================== But Wait! Can't We Salvage Something? * A DEGENERATE INBRED CUBE OF ALL "A" pieces * A variation on the above * Hard knock Horizontal and vertical strips constraints may not be enough * Mimick what a human does when solving the puzzle ======================================================================== Representing Puzzle Pieces (define-struct piece (name angle ; angle (0, 90, 180, 270) flip ; flipped code ("" or "'") n-edge ; list of six binary digits e-edge s-edge w-edge )) ======================================================================== Describing Puzzle Pieces (define A (def-piece "A" 0 0 1 1 0 0 1 0 0 1 0 1 1 0 0 1 0 0 1 0 )) (define B (def-piece "B" 1 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 )) ... * A macro could be used to improve this! ======================================================================== Displaying A Solution (define (display-cube cube) ; Displays a cube by listing its six pieces. Needs improvement. (printf "=============~n") (for-each (lambda (label face) (printf "~a:~n" label) (display-piece (face cube))) (list "Top" "Left" "Front" "Right" "Bottom" "Back") (list cube-to cube-le cube-fr cube-ri cube-bo cube-bk))) * Those generalized for-each and map forms are awesome! Form of resulting output: ============= Top: B L: 1 1 0 1 0 0 0 - - - - 0 1 - - - - 1 0 - - - - 1 1 - - - - 0 1 1 0 0 1 0 Left: C R: 0 1 0 1 0 0 1 - - - - 0 0 - - - - 1 0 - - - - 1 1 - - - - 0 1 1 0 0 1 1 Front: A: 0 0 1 1 0 0 1 - - - - 0 0 - - - - 1 0 - - - - 1 1 - - - - 0 0 1 0 0 1 0 Right: D I: 1 1 0 0 1 1 1 - - - - 1 0 - - - - 0 0 - - - - 0 1 - - - - 1 1 0 1 1 0 0 Bottom: E R: 0 0 1 1 0 0 0 - - - - 1 1 - - - - 0 1 - - - - 0 0 - - - - 1 0 0 1 1 0 0 Back: F R: 0 1 0 0 1 1 0 - - - - 0 1 - - - - 1 1 - - - - 1 0 - - - - 0 0 0 1 0 1 0 ======================================================================== Matching Edges (define (edge-match e1 e2) ; => Bool ; Determines whether two edges match. Two edges match if there are ; no bump clashes (but there may be "hole clashes"). (andmap (lambda (x y) (<= (+ x y) 1) ) e1 e2)) ======================================================================== Matching Corners (define (corner-match x y z) ; => Bool ; Determines whether the pieces x, y, and z match along their common ; edges and corner. The ordering of the pieces implies that the pieces ; when layed out flat look like this: ; ; c +---+ ; \ | z | ; +---o---+ b ; | x | y | ; +---+---+ ; a ; ; where the common corner is marked by "o" and the edges by "a", "b", "c". (let ([n-x (piece-n-edge x)] [e-x (piece-e-edge x)] [n-y (piece-n-edge y)] [w-y (piece-w-edge y)] [s-z (piece-s-edge z)] [w-z (piece-w-edge z)]) (and (edge-match e-x w-y) ; (edge a) (edge-match s-z n-y) ; (edge b) (edge-match n-x w-z) ; (edge c) (= 1 (+ (car e-x) (car n-y) (car s-z)))))) ======================================================================== Front Face +------+ +------+ | | | | | Fr | | A | | | | | +------+ +------+ * Constrained to piece A in normal orientation ======================================================================== Top Face +------+ | | | To | | | +------+ <== vertical edge match constraint | | | Fr | - South edge of Top must match North edge of Front | | +------+ ======================================================================== Left Face c +------+ \ | | \ | To | \ | | +------o------+ b <== one corner constraint | | | | Le | Fr | | | | +------+------+ a - (a) East edge of Left must match west edge of Front - (b) South edge of Top must match north edge of Front - (c) North edge of Left must match west edge of Top - The meeting corners must have only one "bump" ======================================================================== Right Face +------+ +------+ | | | | | To | | To R | | | | | +------+------o------+ +------o------+ | | | | | | | | Le | Fr | Ri | | Le | Fr | | | | | | | | +------+------+------+ +------+------+ one corner constraint ======================================================================== Bottom Face +------+ +------+ +------+ | | | | | | | To | | Fr | | Fr R | | | | | | | +------+------+------+ +------o------+ +------o------+ | | | | | | | | | | | Le | Fr | Ri | | Le L | Bo | | Bo | Ri R | | | | | | | | | | | +------o------o------+ +------+------+ +------+------+ | | | Bo | two corner constraints | | +------+ ======================================================================== Back Face +------+ +------+ +------+ | | | | | | | To | | Bo | | Bo R | | | | | | | +------+------+------+ +------o------+ +------o------+ | | | | | | | | | | | Le | Fr | Ri | | Le I | Bk | | Bk | Ri I | | | | | | | | | | | +------+------+------+ +------+------+ +------+------+ | | | Bo | +------+ +------+ | | | | | | o------o | Bk | | Bk R | | | | | | | | Bk | +------o------+ +------o------+ | | | | | | | | o------o | Le R | To | | To | Ri R | | | | | | | +------+------+ +------+------+ four corner constraints! ======================================================================== Spinning and Flipping A Piece (define (choose-orientation p) ; Ambiguously chooses an orientation for the piece p from the eight ; possible orientations of a piece. (define p* (H p)) (amb p (R p) (I p) (L p) p* (R p*) (I p*) (L p*))) ======================================================================== Choosing Pieces Without Duplication (define (choose-piece pieces) ; => piece / pieces* ; Ambiguously chooses a piece from the given list of pieces, ; returning the chosen piece and an updated pieces* list (which is ; the list pieces with the chosen piece removed). (unless (null? pieces) (let* ([piece (choose-one pieces)] [pieces* (remove piece pieces)]) (values piece pieces*)))) ======================================================================== The Northern Light (Cube) Search Engine -- Revealed! (define (search); => cube ; Searches a subset of all possible solutions and returns a cube representing ; a fully-formed solution. ; The continuation of this program is saved in the amb tree (a parameter ; allocated by amb), so the remaining solutions may be gotten. All solutions ; can be obtained using amb-collect. ; The complete list of pieces (for this puzzle) (define p6 (list A B C D E F)) ;; == Front == ; Fix the A piece onto the front face and leave the remaining ; five pieces in p5. (define-values (Fr p5) (values (car p6) (cdr p6))) ;; == Top == (let-values ([(To p4) (choose-piece-and-orientation p5)]) (amb-assert (v-edge-match To Fr)) ;; == Left == (let-values ([(Le p3) (choose-piece-and-orientation p4)]) (amb-assert (corner-match Le Fr To)) ;; == Right == (let-values ([(Ri p2) (choose-piece-and-orientation p3)]) (amb-assert (corner-match Fr Ri (R To))) ;; == Bottom == (let-values ([(Bo p1) (choose-piece-and-orientation p2)]) (amb-assert (corner-match (L Le) Bo Fr)) (amb-assert (corner-match Bo (R Ri) (R Fr))) ;; == Back == (let-values ([(Bk p0) (choose-piece-and-orientation p1)]) (amb-assert (corner-match (I Le) Bk Bo)) (amb-assert (corner-match Bk (I Ri) (R Bo))) (amb-assert (corner-match (R Le) To Bk)) (amb-assert (corner-match To (L Ri) (R Bk))) ;; Success: return this solution as a fully-formed cube (make-cube To Le Fr Ri Bo Bk) )))))) ======================================================================== Directions for Further "Research" (cough) * Allow duplication of pieces * Composite pieces (from multiple copies of the same or different puzzles) 2x2, 3x3, 1x2, 2x3 - Two-stage process 1) Find combinations of pieces in the shape required 2) "Weld" each piece combinations found into a single - Macro piece (with more bumps) * Now use the search algorithm described above, but use the Macro pieces - we can use same constraints for six-sided pieces! * Modularize the program * Solve the other puzzles on the Snafooze website www.snafooz.com Easiest is level 1 Maybe as many as 128 solutions? Hardest is level 6 Just two or four solutions? The little blue cube is level 4 * Multi-puzzle combinations * Make new puzzles for fun and profit! - out of any polyhedron made of congruent regular polygons - make a great stellated dodecahedron out of pentagrams (Keith Wright--private communication) + Do Christmas shoppping and Christmas cards ======================================================================== NEXT MONTH'S TOPIC Any volunteers? * Webit (Jim Bender) [miscredited to Noel Welsh initially] * Accessing SQL databases using Scheme * Building parsers using Scheme * Syntax-case