;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- ;;;; The 8-Puzzle Problem ;;; In this implementation of the 8-puzzle we have a mix of priorities ;;; between efficiency and simplicity. We restrict ourselves to the ;;; 8-puzzle, instead of the general n-puzzle. The representation of ;;; states is not the obvious one (a 3x3 array), but it is both ;;; efficient and fairly easy to manipulate. We represent each tile ;;; as an integer from 0 to 8 (0 for the blank). We also represent ;;; each square as an integer from 0 to 8, arranged as follows: ;;;
```;;;     0 1 2
;;;     3 4 5
;;;     6 7 8
;;; ```
;;; Finally, we represent a state (i.e., a complete puzzle) as the sum ;;; of the tile numbers times 9 to the power of the tile's square number. ;;; For example, the goal state from page 63: ;;;
```
;;;     1 2 3                          1*9^0 + 2*9^1 + 3*9^2
;;;     8 . 4  is represented by:    + 8*9^3 + 0*9^4 + 4*9^5
;;;     7 6 5                        + 7*9^6 + 6*9^7 + 5*9^8 = 247893796
;;; ```
;;; We represent actions with the four symbols <, >, ^, V to stand for ;;; moving the blank tile left, right, up and down, respectively. The ;;; heuristic functions implicitly refer to the goal, *8-puzzle-goal*. ;;; Call the function USE-8-PUZZLE-GOAL to change the goal state if ;;; you wish. (defvar *8-puzzle-goal* "To be defined later") (defstructure (8-puzzle-problem (:include problem (initial-state (random-8-puzzle-state)) (goal *8-puzzle-goal*))) "The sliding tile problem known as the 8-puzzle.") (defmethod successors ((problem 8-puzzle-problem) state) "Generate the possible moves from an 8-puzzle state." (let ((blank (blank-square state)) (result nil)) (for each (action destination) in (8-puzzle-legal-moves blank) do (push (cons action (move-blank state blank destination)) result)) result)) (defmethod h-cost ((problem 8-puzzle-problem) state) "Manhatten, or sum of city block distances. This is h_2 on [p 102]." (let ((sum 0)) (for square = 0 to 8 do (let ((tile (8-puzzle-ref state square))) (unless (= tile 0) (incf sum (x+y-distance (8-puzzle-location square) (8-puzzle-goal-location tile)))))) sum)) (defun move-blank (state from to) "Move the blank from one square to another and return the resulting state. The FROM square must contain the blank; this is not checked." (+ state (* (8-puzzle-ref state to) (- (9-power from) (9-power to))))) (defun blank-square (state) "Find the number of the square where the blank is." (for i = 0 to 8 do (when (= 0 (8-puzzle-ref state i)) (return i)))) (defun random-8-puzzle-state (&optional (num-moves 100) (state *8-puzzle-goal*)) "Return a random state of the 8 puzzle." (for i = 1 to num-moves do (setf state (random-move-blank state))) state) (defun random-move-blank (state) "Return a state derived from this one by a random move." (let ((blank (blank-square state))) (move-blank state blank (random-element (neighbors blank))))) ;;;; Representing the Board (defun neighbors (square) "The squares that can be reached from a given square." (svref '#((1 3) (0 2 4) (1 5) (0 4 6) (1 3 5 7) (2 4 8) (3 7) (4 6 8) (7 5)) square)) (defun 8-puzzle-legal-moves (square) "The moves that can be made when the blank is in a given square. This is a list of (direction destination-square) pairs." (svref '#(((> 1) (V 3)) ((< 0) (> 2) (V 4)) ((< 1) (V 5)) ((^ 0) (> 4) (V 6)) ((^ 1) (< 3) (> 5) (V 7)) ((^ 2) (< 4) (V 8)) ((^ 3) (> 7)) ((^ 4) (< 6) (> 8)) ((^ 5) (< 7))) square)) (defun 8-puzzle-location (square) "Return the (x y) location of a square number." (svref '#((0 2) (1 2) (2 2) (0 1) (1 1) (2 1) (0 0) (1 0) (2 0)) square)) ;;;; Representing States (defun 8-puzzle-state (&rest pieces) "Define a new state with the specified tiles." (assert (= 9 (length pieces))) (let ((sum 0)) (for i = 0 to 8 do (incf sum (* (elt pieces i) (expt 9 i)))) sum)) (defun 8-puzzle-ref (state square) "Return the tile that occupies the given square." (mod (floor state (9-power square)) 9)) (defun 8-puzzle-print (state &optional (stream t)) (for i = 0 to 8 do (if (= 0 (mod i 3)) (terpri stream)) (let ((tile (8-puzzle-ref state i))) (format stream " ~A" (if (= tile 0) "." tile)))) state) (defun 8-puzzle-display-fn (node problem) (declare (ignore problem)) (when *debugging* (format *debug-io* "~&Expanding:~%") (8-puzzle-print (node-state node) *debug-io*))) ;;;; Setting Up the Goal (defvar *8-puzzle-goal-locations* (make-array 9) "A vector indexed by tile numbers, saying where the tile should be.") (defun use-8-puzzle-goal (goal) "Define a new goal for the 8 puzzle." (setf *8-puzzle-goal* goal) (for square = 0 to 8 do (let ((tile (8-puzzle-ref goal square))) (setf (svref *8-puzzle-goal-locations* tile) (8-puzzle-location square)))) goal) (defun 8-puzzle-goal-location (tile) "Return the location where the tile should go." (svref *8-puzzle-goal-locations* tile)) (defun 9-power (n) "Raise 9 to the nth power, 0 <= n <= 9." ;; This measures about 8 times faster than (expt 9 i) (svref '#(1 9 81 729 6561 59049 531441 4782969 43046721 387420489) n)) (use-8-puzzle-goal (8-puzzle-state 1 2 3 8 0 4 ; The goal on [p 63]. 7 6 5)) ;;;; Alternative Heuristic Function (defun misplaced-tiles (state) "Number of misplaced tiles. This is h_1 on [p 102]." (let ((sum 0)) (for square = 0 to 8 do (when (misplaced-tile? state square) (incf sum))) sum)) (defun misplaced-tile? (state square) "Is the tile in SQUARE different from the corresponding goal tile? Don't count the blank." (let ((tile (8-puzzle-ref state square))) (and (/= tile 0) (/= tile (8-puzzle-ref *8-puzzle-goal* square)))))