+;;;; Copyright (c) 2012 Robert Smith

+;;; You are given 3 stacks of coins. The only operation you are

+;;; permitted to perform is doubling one stack by taking that many

+;;; from another. Prove (or devise an algorithm which you can show is

+;;; correct) that shows you can always empty one of the stacks.

+ `(cons (integer 0 2) (integer 0 2)))

+(defun from-stack (move)

+ "Get the number of the stack to subtract from."

+ (declare (type move move))

+ "Get the number of the stack to add to."

+ (declare (type move move))

+ `(simple-array fixnum (3)))

+(defun normalize-state! (state)

+ "Normalize the state STATE."

+ (declare (type state state))

+(defun make-state (a b c)

+ "Make new state with piles of size A, B, and C. The piles will be

+ (normalize-state! (make-array 3 :element-type 'fixnum

+ :initial-contents (list a b c))))

+(defun copy-state (state)

+ "Make a copy of STATE."

+ (declare (type state state))

+(defun valid-move-p (state move)

+ "Is it valid to move coins from the FROM-STACK to the TO-STACK?"

+ (declare (type state state)

+ (<= (aref state (to-stack move))

+ (aref state (from-stack move))))

+(defun do-move (state move)

+ "Move the coins from the stack numbered FROM-STACK to the stack

+ (declare (type state state)

+ (let* ((from-stack (from-stack move))

+ (to-stack (to-stack move))

+ (to (aref state to-stack))

+ (new-state (copy-state state)))

+ (decf (aref new-state from-stack) to)

+ (incf (aref new-state to-stack) to)

+ (normalize-state! new-state)))

+ "Check if STATE is solved."

+ (declare (type state state))

+(defvar *moves* '((2 . 0) (2 . 1)

+ (let ((table (make-hash-table :test 'equalp)))

+ (labels ((rec (state depth moves)

+ (declare (type fixnum depth))

+ (unless (gethash state table)

+ (return-from solve (values state depth (nreverse moves))))

+ (setf (gethash state table) t)

+ (when (valid-move-p state m)

+ (format t "~vT~D: ~S on ~A~%" (* 2 depth) depth m state)

+ (rec (do-move state m) (1+ depth) (cons m moves)))))))