# lisp-random

committed a8eae7e

rainbow dosh solver

# rainbow-dosh.lisp

`+;;;; rainbow-dosh.lisp`
`+;;;; 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.`
`+`
`+;;; Representation`
`+`
`+(deftype move ()`
`+  `(cons (integer 0 2) (integer 0 2)))`
`+`
`+(defun make-move (a b)`
`+  "Make a new move."`
`+  (the move (cons a b)))`
`+`
`+(defun from-stack (move)`
`+  "Get the number of the stack to subtract from."`
`+  (declare (type move move))`
`+  (car move))`
`+`
`+(defun to-stack (move)`
`+  "Get the number of the stack to add to."`
`+  (declare (type move move))`
`+  (cdr move))`
`+`
`+(deftype state ()`
`+  `(simple-array fixnum (3)))`
`+`
`+(defun normalize-state! (state)`
`+  "Normalize the state STATE."`
`+  (declare (type state state))`
`+  (sort state #'<))`
`+`
`+(defun make-state (a b c)`
`+  "Make new state with piles of size A, B, and C. The piles will be`
`+normalized."`
`+  (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))`
`+  (copy-seq state))`
`+`
`+`
`+;;; Operations`
`+`
`+(defun valid-move-p (state move)`
`+  "Is it valid to move coins from the FROM-STACK to the TO-STACK?"`
`+  (declare (type state state)`
`+           (type move move))`
`+  (<= (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`
`+  numbered TO-STACK."`
`+  (declare (type state state)`
`+           (type move move))`
`+  (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)))`
`+`
`+`
`+;;; Solution`
`+`
`+(defun solvedp (state)`
`+  "Check if STATE is solved."`
`+  (declare (type state state))`
`+  (some #'zerop state))`
`+`
`+(defvar *moves* '((2 . 0) (2 . 1)`
`+                  (1 . 0) (1 . 2)`
`+                  (0 . 1) (0 . 2)))`
`+`
`+(defun solve (state)`
`+  (let ((table (make-hash-table :test 'equalp)))`
`+    (labels ((rec (state depth moves)`
`+               (declare (type fixnum depth))`
`+               (unless (gethash state table)`
`+                 (when (solvedp state)`
`+                   (return-from solve (values state depth (nreverse moves))))`
`+                 `
`+                 (setf (gethash state table) t)`
`+                 `
`+                 (dolist (m *moves*)`
`+                   (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)))))))`
`+      (rec state 1 nil))))`
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.