originally written late august ’06
Earlier this week, I decided to write the CS4 project in Lisp (again), but this time using CLOS and keeping things as parallel between the C++ implementation and the Common-Lisp implementation. Before, the puzzles were represented as property lists of functions to call for getting the initial state, getting neighbors of a state, and checking a state for “done”ness. Now, the puzzles are classes, and what were previously functions are now generic methods.
For those of you who aren’t really familiar with CLOS, the end result the object-orientedness that you are used to: objects have state and methods. The difference, comparing Lisp to languages like C++, Java, C#, and Smalltalk, is that the methods on classes are really freestanding, generic functions, in the simplest sense.
Below you’ll find “slide.lisp”, which is one of the harder puzzles the CS4 students have done in the past. Just a few things to note:
“(in-package …)” – in Lisp, things are organized by package, which is similar to namespaces/modules/whatever in other languages. Things are slightly different, in that you declare (on a package level) what packages you use and what things you make available (i.e. public) to the outside word.
“(defclass …)” – this is you class declaration – note that it only contains the state information for the class (in Lisp, they are called “slots”), along with how to initialize them (“:initarg”), what the default initialization is (“:initform”), any documentation (“:documentation”), and (not shown here) getters/setters you want automatically declared (“:reader”, “:writer”, “:accessor”).
“(defmethod …)” – these are the implementations of generic methods (defined with “(defgeneric …)”, and, in this case, in another file), for which any number of arguments can be scoped to specific types. In this case, the methods expect an argument of type “slide” (also named slide, but that isn’t a requirement). Generic methods can be genericized on any number of parameters and/or types, can be combined in numerous ways, and can specify in what order they should be run in relation to any other implementations of the same generic method (things like “:before” and “:after”, but it gets a bit complicated).
You’ll also notice, at the bottom of the file, that unit testing is included with this file. The macros used in declaring the unit tests (“deftest” and “check”) are also found in another file, but you should be able to guess their usage. Here is the output created by evaluating “(test-slide)” (WP killed the spacing, so I apologize):
COM.NOAHSMARK.CS4PROJECT[3]> (test-slide)
pass … (TEST-SLIDE):
(EQUALP
(SOLVE
(MAKE-INSTANCE ‘SLIDE START ‘((1 2 3) (. . .)) GOAL ‘((. 2 3) (1 . .))))
‘(#(1 2 3 . . .) #(. 2 3 1 . .)))
pass … (TEST-SLIDE):
(EQUAL
(LENGTH
(SOLVE
(MAKE-INSTANCE ‘SLIDE START ‘((. . .) (a b c) (. . .)) GOAL
‘((. . .) (c b a) (. . .)))))
9)
pass … (TEST-SLIDE):
(EQUAL
(LENGTH
(SOLVE
(MAKE-INSTANCE ‘SLIDE START ‘((. 8 9) (4 5 6)) GOAL ‘((6 5 4) (. 9 8)))))
14)
T
The only part you really care about is that the lines start with “pass…” and the return value of the whole thing is “T”. Any tests defined with “deftest” can also be aggregated. The macros used for this are taken from Practical Common Lisp, which I highly recommend.
And, finally, here is the code. Forgive the lack of commenting: there was more before the change, but some of it made its way into :documentation properties on the defgeneric and defclass declarations. Others (like explanations of how each puzzle worked) still need to find a home, either as a comment, a documentation string, or a documentation property (whatever is most appropriate, starting from the last moving towards “just a lowly comment”). As always, bug me with any questions, or “God, you suck at Lisp.” I know I suck at Lisp, but it always helps to know how I suck so I can improve.
Also, for those of you familiar with this part of the CS4 project, I haven’t implemented the file reader portion yet, hence the strange looking declarations in the unit test (for those unfamiliar with Lisp: #\a is the character ‘a’, #\. is the character ‘.’, etc.). Like the project, #\. is used as the empty space.
(in-package :com.noahsmark.cs4project) (defun getxy (width row col) (+ (* row width) col)) (defclass slide () ((start :initarg :start :initform (error "Must specify starting matrix.") :documentation "Starting matrix, as a list of rows (list of cols).") (goal :initarg :goal :initform (error "Must specify goal matrix.") :documentation "Goal matrix, as a list of rows (list of cols).") (start-arr :documentation "Internal array representation of start.") (goal-arr :documentation "Internal array representation of goal.") (width :documentation "Width of the slide puzzle state.") (height :documentation "Height of the slide puzzle state."))) (defmethod initialize-instance :after ((slide slide) &key) (with-slots (start goal start-arr goal-arr width height) slide (let ((flatstart (apply #'append start)) (flatgoal (apply #'append goal))) (setf height (length start)) (setf width (length (car start))) (setf start-arr (make-array (length flatstart) :initial-contents flatstart)) (setf goal-arr (make-array (length flatgoal) :initial-contents flatgoal))))) (defmethod init-state ((slide slide)) (slot-value slide 'start-arr)) (defmethod is-end? ((slide slide) state) (equalp (slot-value slide 'goal-arr) state)) (defmethod get-neighbors ((slide slide) state) (with-slots (width height) slide (labels ((can-move? (newrow newcol) (not (or (< newrow 0) (< newcol 0) (>= newcol width) (>= newrow height)))) (move (arr row col newrow newcol) (let ((fromix (getxy width row col)) (toix (getxy width newrow newcol)) (newarr (copy-seq arr))) (rotatef (elt newarr toix) (elt newarr fromix)) newarr)) (moveall (arr index) (let* ((newlist nil) (row (floor (/ index width))) (col (mod index width))) (if (can-move? (1- row) col) (push (move arr row col (1- row) col) newlist)) (if (can-move? row (1- col)) (push (move arr row col row (1- col)) newlist)) (if (can-move? (1+ row) col) (push (move arr row col (1+ row) col) newlist)) (if (can-move? row (1+ col)) (push (move arr row col row (1+ col)) newlist)) newlist)) (findfrom (arr start) (let ((pos (position #. arr :start start))) (if (not pos) nil (append (moveall arr pos) (findfrom arr (1+ pos))))))) (findfrom state 0)))) (deftest test-slide () (check (equalp (solve (make-instance 'slide :start '((#1 #2 #3) (#. #. #.)) :goal '((#. #2 #3) (#1 #. #.)))) '(#(#1 #2 #3 #. #. #.) #(#. #2 #3 #1 #. #.))) (equal (length (solve (make-instance 'slide :start '((#. #. #.) (#a #b #c) (#. #. #.)) :goal '((#. #. #.) (#c #b #a) (#. #. #.))))) 9) (equal (length (solve (make-instance 'slide :start '((#. #8 #9) (#4 #5 #6)) :goal '((#6 #5 #4) (#. #9 #8))))) 14)))
Just for fun, here is the code for the unit testing framework, from Practical Common Lisp:
;GNU Common Lisp has EX:WITH-GENSYMS, the difference being that the first ;expected argument is a string to use to preface each symbol in gensyms ; ;(defmacro with-gensyms ((&rest names) &body body) ; `(let ,(loop for n in names collect `(,n (gensym))) ; ,@body)) (defvar *test-name* nil) (defmacro deftest (name parameters &body body) "Define a test function. Within a test function we can call other test functions or use 'check' to run individual test cases." `(defun ,name ,parameters (let ((*test-name* (append *test-name* (list ',name)))) ,@body))) (defmacro check (&body forms) "Run each expression in 'forms' as a test case." `(combine-results ,@(loop for f in forms collect `(report-result ,f ',f)))) (defmacro combine-results (&body forms) "Combine the results (as booleans) of evaluating 'forms' in order." (with-gensyms ("COMBINE-RESULTS-" result) `(let ((,result t)) ,@(loop for f in forms collect `(unless ,f (setf ,result nil))) ,result))) (defun report-result (result form) "Report the results of a single test case. Called by 'check'." (format t "~:[FAIL~;pass~] ... ~a: ~%~vt~a~%" result *test-name* 9 form) result)