;;============================================================== ;; RUSH HOUR CODE ;; CMSC 471 HOMEWORK #2 ;; PROVIDED BY PROF. MARIE desJARDINS ;; SEPTEMBER 2004 ;; ;;============================================================== ;; CONSTANTS AND GLOBAL VARIABLES (defconstant GOAL 'g "Name of car to move off board -- does not change") (defvar MAXX 0 "Maximum X dimension [1-based] of the current game") (defvar MAXY 0 "Maximum Y dimension [1-based] of the current game") (defvar DEPTH-LIMIT 20 "Default depth limit for search") ;;============================================================== ;; DEBUGGING AND LOGGING (defvar *DEBUG* t "Output stream for printing debugging and logging messages; default is stdout (T)") ;; Open a log file. ;; Use (format *DEBUG* FORMAT-STRING ARG ...) to record debugging ;; and logging information into the logging file. If no log file ;; is open, these messages will be written to the terminal screen. (defun open-debug (file) (setf *DEBUG* (open file :direction :output :if-exists :overwrite :if-does-not-exist :create))) ;; Close the log file, and reset *DEBUG* to standard output (T) (defun close-debug () (when (not (eq *DEBUG* t)) (close *DEBUG*) (setf *DEBUG* t))) ;;============================================================== ;; DATA STRUCTURES ;; A game (i.e., a node in the search tree) is a board (i.e., game ;; state) plus some bookkeeping information (defclass game () ((name :accessor game-name :initarg :name) ;; The board is a MAXXxMAXY array (x=0..MAXX-1, y=0..MAXY-1) ;; Each location on the board contains a symbol representing ;; a vehicle, or nil (board :accessor game-board :initarg :board :initform nil) ;; Parent of this node in the search tree (parent :accessor game-parent :initarg :parent :initform nil) ;; Depth of this node in the search tree (depth :accessor game-depth :initarg :depth :initform 0) )) ;;============================================================== ;; UTILITY FUNCTIONS (defmacro x-coord (loc) "Extract the x coordinate from an (x y) list" `(first ,loc)) (defmacro y-coord (loc) "Extract the y coordinate from an (x y) list" `(second ,loc)) ;; EMPTY: Check to see if an (x y) position on the board exists ;; and is empty. (defun empty (board x y) "Returns T if x,y is in range and the board position at x,y is empty" (and (not (< x 0)) (not (< y 0)) (not (>= x MAXX)) (not (>= y MAXY)) (not (aref board x y)))) ;; COPY-ARRAY: Make a copy of a 2-D array that is EQUAL but ;; not EQ to the original array. Will be used by EXPAND. (defun copy-array (a) "Copy a 2-D array" (let* ((dims (array-dimensions a)) (b (make-array dims))) (loop for x from 0 to (- (first dims) 1) do (loop for y from 0 to (- (second dims) 1) do (setf (aref b x y) (aref a x y)))) b)) ;; ARRAY-EQUAL: Return T if two 2-D arrays are EQUAL (that ;; is, if they are EQ at every array position). Will be used ;; in CHECK-REPEATED. (defun array-equal (a1 a2) "Check to see whether two 2-D arrays are EQUAL, i.e., are EQ at every array position" (let* ((dims1 (array-dimensions a1)) (dims2 (array-dimensions a2))) (when (equal dims1 dims2) (loop for x from 0 to (- (first dims1) 1) do (loop for y from 0 to (- (second dims1) 1) do ;; If any position isn't EQ, return nil (if (not (eq (aref a1 x y) (aref a2 x y))) (return-from array-equal nil)))) ;; If we got this far, then the array is EQ everywhere (return-from array-equal t))) ;; If we got here, the dimensions didn't match nil) ;;============================================================== ;; INITIALIZATION FUNCTION ;; LOAD-GAME: Load a game from a file, and create a game instance ;; to record all of the information. Also creates a new variable ;; that refers to the game structure; so, for example, when you load ;; the test file "test0", in which the first line specifies the ;; name "test0", after calling this function, the global variable ;; TEST0 will point to the new game structure. (defun load-game (file &aux token line array name) "Load a Rush Hour game from a file." (with-open-file ;; Inside this loop, STR reads from FILE (str file :direction :input :if-does-not-exist :error) ;; Read the game name (setf name (read str)) ;; Read the maximum X and Y values for the board, check for ;; legality, and set global MAXX and MAXY values (setf token (read str)) (if (integerp token) (setf MAXX token) (error "Illegal value of MAXX (~s) in file ~s~%" token file)) (setf token (read str)) (if (integerp token) (setf MAXY token) (error "Illegal value of MAXY (~s) in file ~s~%" token file)) ;; Initialize and read in the board array, line by line (setf array nil) (loop for i from 1 to MAXX do (setf line (read-token-line str)) (if (not (eql (length line) MAXY)) (error "Illegal line in ~s (should have ~s entries)~%: ~s~%" file MAXY line)) (setf array (nconc array (list line)))) ;; Create an instance, and a global variable with the name of the ;; instance. This value will also be returned from LOAD-GAME, since ;; it's the last line in the function. (set name (make-instance 'game :name name :board (make-array `(,MAXX ,MAXY) :initial-contents array))))) ;;============================================================== ;; I/O FUNCTIONS ;; Method for printing an object of class GAME to an output stream (defmethod print-object ((g game) str) "Print an object of class GAME to an output stream" (format str "Game ~s:~%" (game-name g)) (print-board (game-board g) str)) ;; Print a game board, neatly formatted with 4-space columns. ;; See ~< ~> formatting string and behold the power of FORMAT! (defun print-board (b str) "Print a formatted Rush Hour game board" (loop for x from 0 to (- MAXX 1) do (loop for y from 0 to (- MAXY 1) do (format str "~4<~s~>" (or (aref b x y) '-))) (format str "~%"))) ;; Read a line of tokens from an input stream (defun read-token-line (str &aux line (next t) (start 0) (tokens nil)) "Read a line of tokens into a list" ;; First input the line into a string (setf line (read-line str)) (loop while (not (eq next :done)) do (progn (multiple-value-setq (next start) ;; Loop, reading tokens sequentially from the string (read-from-string line nil :done :start start)) (if (not (eq next :done)) (setf tokens (nconc tokens (list next)))))) tokens) ;; PRINT-SEARCH-INFO: Given an argument GAME-RESULTS (a 4-tuple ;; list containing a result ('success or 'fail), the goal node if ;; one was found, the number of nodes created, and the number of ;; nodes expanded, print a summary of the search to STR (defun print-search-info (game-results str) "Print final search summary to an output stream" (let ((result (first game-results)) (last (second game-results)) (created (third game-results)) (expanded (fourth game-results))) (format str "~s~%~s nodes created~%~s nodes expanded~%~%" result created expanded) (when last (format str "Search path (depth ~s):~%" (game-depth last)) (print-path-recursive last str)))) ;; PRINT-PATH-RECURSIVE: Given a game node, print the path from ;; the root node to this node. Operates by recursively following ;; the PARENT slots up to the root, then printing each node as ;; the recursion unwinds. (defun print-path-recursive (node str) "Print the path from the root to the given node, recursing and then unwinding" (if (not (typep node 'game)) (error "~s is not a game node" node)) (if (game-parent node) (print-path-recursive (game-parent node) str)) (format *DEBUG* "~%") (print-board (game-board node) str))