;; This is the code that integrates the program with the AIMA code and ;; creates test-examples. (defparameter *test-battleship-game* (let ((newboard (make-battleship-struc :size '(12 12) :grid (create-blank-grid 12 12) :column-constraints '(0 0 1 1 1 4 2 5 1 1 4 0) :row-constraints '(0 2 0 4 1 2 3 1 3 2 2 0) :ship-list '(4 3 2 1)))) ; Create an actual sample game that appears in games magazine. ; By the end, this should be a solvable problem. ; We know that this has on unique solution ; The grid is really 10x10, but we always want to make it with ; edges of 0's to prevent having to deal with edges as a special case. (cross-off-squares newboard) ; this is sort of a hack. We have to cross off blank ; squares after creating any blank board because we need ; to get rid of the "0" rows (so that the move routine won't ; move there) newboard ; return the board that we just created )) ; 0 0 0 0 0 * * 0 0 0 ; 0 0 0 0 0 0 0 0 0 0 ; 0 0 * * * 0 * 0 0 0 ; 0 0 0 0 0 0 * 0 0 0 ; 0 * 0 0 0 0 0 0 0 * ; 0 0 0 0 0 * 0 * 0 * ; 0 0 0 0 0 0 0 0 0 * ; 0 0 0 0 * 0 * 0 0 * ; 0 0 0 0 * 0 * 0 0 0 ; 0 0 0 0 * 0 0 0 * 0 (defparameter *test-battleship-game2* (let ((newboard (make-battleship-struc :size '(5 5) :grid (create-blank-grid 5 5) :column-constraints '(0 3 0 1 0) :row-constraints '(0 1 1 2 0) :ship-list '(1 0 1 0) :ships-placed '(0 0 0 0)))) (cross-off-squares newboard) newboard ;return the board that we just created )) ;* 0 0 ;* 0 0 ;* 0 * (defparameter *test-battleship-game3* (let ((newboard (make-battleship-struc :size '(7 7) :grid (create-blank-grid 7 7) :column-constraints '(0 2 1 1 2 1 0) :row-constraints '(0 2 1 1 3 0 0) :ship-list '(2 1 1 0) :ships-placed '(0 0 0 0)))) (cross-off-squares newboard) newboard )) ; * * 0 0 0 ; 0 0 0 * 0 ; * 0 0 0 0 ; 0 0 * * * ; 0 0 0 0 0 (defparameter *test-battleship-game4* (let ((newboard (make-battleship-struc :size '(6 6) :grid (create-blank-grid 6 6) :column-constraints '(0 2 0 1 2 0) :row-constraints '(0 1 2 1 1 0) :ship-list '(3 1 0 0) :ships-placed '(0 0 0 0)))) (cross-off-squares newboard) newboard )) ; * 0 0 0 ; 0 0 * * ; * 0 0 0 ; 0 0 0 * (defparameter *test-battleship-game5* (let ((newboard (make-battleship-struc :size '(10 10) :grid (create-blank-grid 10 10) :column-constraints '(0 5 1 4 0 4 1 4 4 0) :row-constraints '(0 3 3 1 5 2 4 2 3 0) :ship-list '(4 3 2 1) :ships-placed '(0 0 0 0)))) (cross-off-squares newboard) newboard )) ; * * * 0 0 0 0 0 ; 0 0 0 0 * 0 * * ; * 0 0 0 0 0 0 0 ; * 0 0 0 * * * * ; * 0 * 0 0 0 0 0 ; 0 0 * 0 * 0 * * ; * 0 * 0 0 0 0 0 ; 0 0 0 0 * 0 * * (defparameter *test-battleship-game6* (let ((newboard (make-battleship-struc :size '(8 8) :grid (create-blank-grid 8 8) :column-constraints '(0 3 3 2 2 1 3 0) :row-constraints '(0 5 1 3 1 2 2 0) :ship-list '(3 2 1 1) :ships-placed '(0 0 0 0)))) (cross-off-squares newboard) newboard )) ; * * * * 0 * ; 0 0 0 0 0 * ; * * * 0 0 0 ; 0 0 0 0 * 0 ; * * 0 0 0 0 ; 0 0 0 * 0 * (defstructure (battleships-game (:include problem (initial-state *TEST-BATTLESHIP-GAME4*)))) ; we would have to pass a specific problems in (setf p1 (make-battleships-game :initial-state *TEST-BATTLESHIP-GAME*)) ; 10x10 (setf p2 (make-battleships-game :initial-state *test-battleship-game2*)) ; 3x3 (setf p3 (make-battleships-game :initial-state *test-battleship-game3*)) ; 5x5 (setf p4 (make-battleships-game :initial-state *test-battleship-game4*)) ; 4x4 (setf p5 (make-battleships-game :initial-state *test-battleship-game5*)) ; this is an 8x8 board that has the standard ship set for the 10x10 board (defmethod goal-test ((problem battleships-game) state) "The goal is to have all the ships placed" (game-over-p state)) (defmethod successors ((problem battleships-game) state) "We want to return a list of (action . state) pairs. An action is simply " (let ((move-list (legal-battleship-moves state))) ; get a list of possible moves (mapcar #'(lambda (x) (get-move-pair state x)) move-list))) (defun get-move-pair (b-board move) "Make a pair of move.state from the move and the state before the move. This function is important becuase I wrote all the functions of the battleship game destructively for efficiency." (let ((new-state (copy-battleship-environment b-board))) ; we will destructive modify this state to make it the new state (make-battleship-move move new-state) (cons move new-state) ; return the pair )) (defun copy-array (oldarray) "I think it's actually offensive that LISP can be filled with jillions of stupid functions and not an array-copy function, which could be implemented at a lower level than I can do it. This function copies a dimensional array" (let* ((a (array-dimension oldarray 0)) (b (array-dimension oldarray 1)) (newarray (make-array (list a b)))) (dotimes (x a) (dotimes (y b) (setf (aref newarray x y) (aref oldarray x y)))) newarray)) (defun copy-battleship-environment (b-board) "Since the current structure ISN'T copied when using a 'let', we need to write our own copy function" (let ((new-state (make-battleship-struc :size (copy-list (battleship-struc-size b-board)) :grid (copy-array (battleship-struc-grid b-board)) :column-constraints (copy-list (battleship-struc-column-constraints b-board)) :row-constraints (copy-list (battleship-struc-row-constraints b-board)) :ship-list (copy-list (battleship-struc-ship-list b-board)) :ships-placed (copy-list (battleship-struc-ships-placed b-board)) ))) new-state))