| by Jason Kantz June 2005 |
Solving an 8-puzzle involves moving the puzzle from a starting state to a solution state with many options in between. This paper explores breadth-first search, depth-first search, hill-climbing, and the optimization of A* using the profiling tools provided with CMU Common Lisp.
Solving an 8-puzzle involves moving the puzzle from a starting state to a solution state, as pictured below.
----------- -----------
| 2 | 8 | 3 | | 1 | 2 | 3 |
------------ ------------
| 1 | 6 | 4 | | 4 | 5 | 6 |
----------- -----------
| 7 | | 5 | | 7 | 8 | |
----------- -----------
We can represent the board as a n-element list, the tiles as numbers in the list, and the empty space with the symbol X.
(defparameter *board-size* 9 "Number of squares in the puzzle. Must be a perfect square.") (defvar *space* 'X "The symbol representing the space other tiles can slide to.")
Everytime we go to move a tile we will have 2 to 4 possible moves.
With the list representation we can define simple accessor functions for moving up, down, left, and right, and we only have to deal with one index into the list. The board size is readily changed by updating the *board-size* parameter.
(defparameter *m* (floor (sqrt *board-size*)) "Modulus. The number of positions in a row or column of the puzzle.") (defun at-top-p (i) (< i *m*)) (defun at-bot-p (i) (>= i (- *board-size* *m*))) (defun at-rht-p (i) (= (mod i *m*) (1- *m*))) (defun at-lft-p (i) (= (mod i *m*) 0)) (defun iup1 (i) (if (not (at-top-p i)) (- i *m*) nil)) (defun idn1 (i) (if (not (at-bot-p i)) (+ i *m*) nil)) (defun irht (i) (if (not (at-rht-p i)) (1+ i) nil)) (defun ilft (i) (if (not (at-lft-p i)) (1- i) nil))
Given a board, we would like to know all the possible boards that can result from our next move. The accessors are used to find a list of all possible next board states.
(let ((fns (list #'ilft #'iup1 #'irht #'idn1)))
(defun next-boards (board)
"Given the current board, return a list of the next boards."
(let ((states nil)
(x (position *space* board))) (flet ((maybe-swap (move-fn)
(when-bind (p (funcall move-fn x))
(push (swap board x p) states))))
(declare (dynamic-extent maybe-swap))
(mapc #'maybe-swap fns))
states)))We can start by representing a path as a list of board states, and use a general tree-search algorithm (Norvig, 1991, p. 191) to explore the space of searching strategies:
(defun tree-search (open goal-p expand combine)
"Search a space of states starting from those in the list
OPEN. GOAL-P is a unary function that tests for a goal state
to be returned. EXPAND is a unary function called on a state
from OPEN to return successive states. COMBINE is a two
argument function called on the result of EXPAND and a list of
remaining states in OPEN. When no goal state is found return
NIL."
(cond ((null open) nil)
((funcall goal-p (first open)) (first open))
(t (tree-search
(funcall combine
(funcall expand (first open))
(rest open))
goal-p expand combine))))
(defun tree-search (open goal-p expand combiner)
"Find a state that satisfies goal-p. Start with the states in
the open list, and search according to an expansion function
and combiner function."
(cond ((null open) nil)
((funcall goal-p (first open)) (first open))
(t (tree-search
(funcall combiner
(funcall expand (first open))
(rest open))
goal-p expand combiner))))
The EXPAND function used for our 8-puzzle will have to take a path (a list of consecutive board states) and return a list of paths.
(defun next-paths (path)
"Expands path into a list of paths to the board's next possible
states. Cycles are avoided by expanding only if the expansion
leads to a state not already in the path."
(loop for next-board in (next-boards (car path))
if (not (member next-board path :test #'equal))
collect (cons next-board path)))
The following strategies are based on the order of the tree traversal.
A breadth-first search looks at all the nodes one ply at a time. It is guaranteed to find a minimal path to the solution. Algorithms that do this are described as being "admissible". Searching breadth-first for a solution to the 8-puzzle is only effective if the solution is only a few moves away. Otherwise, if the solution is too deep, the combinatorial explosion of states will take way too long to exhaustively search.
(defun 8breadth-first (start goal)
(let ((xcount 0))
(prog1 (nreverse
(tree-search (list (list start)) ;open
;; goal-p
#'(lambda (path)
(equal (car path) goal))
;; expand
#'(lambda (path)
(incf xcount) (next-paths path))
;; combiner
#'(lambda (successors fifo-queue)
(append fifo-queue successors))))
(format *standard-output*
"~&Search required ~A Expansions." xcount))))
Depth-first searching just dives down to the bottom of the tree. It is not always very successfull at finding sollutions that are only a few moves away. Say the solution is the right most node of the the fourth ply. Depth first dives down left and spends all it's time deep left, taking a long time to get to shallow right.
(defun 8depth-first (start goal)
(tree-search (list (list start)) ;open list
#'(lambda (path) ;goal-p
(equal (car path) goal))
#'next-paths ;expand
#'(lambda (successors lifo-queue) ;combiner
(append successors lifo-queue))))
A beam search with a width of 1 is even worse than depth-first; it will dive straight down the left-hand side of the tree, hit the left-most leaf and stop, because it does not maintain any information for backtracking.
(defun 8beam (start goal &optional (width 1))
(tree-search (list (list start)) ;states
#'(lambda (path) ;goal-p
(equal (car path) goal))
#'next-paths ;expand
#'(lambda (successors lifo-queue) ;beam combiner
(let ((q (append successors lifo-queue)))
(if (< (length q) width)
q
(subseq q 0 width))))))The following strategies direct the search by sorting the expansion based on some estimate of how close a board state is to the goal.
If we introduce some way to evaluate whether one board state is better than another (i.e. the cost of getting from there to the goal is lower), we can try to control the beam so that it doesn't just dive down the left side of the tree. Rather at every branch, we try to choose the next state that looks best out of the branches available in the current expansion. If the width of the beam is 1, the search is known as hill-climbing.
(defun 8directed-beam (start goal cost &key (width 1))
(let ((xcount 0))
(prog1 (nreverse
(tree-search (list (list start)) ;open
#'(lambda (path) ;goal-p
(equal (car path) goal))
#'(lambda (path) ;expand
(incf xcount)
(sort (funcall #'next-paths path)
#'<
:key cost))
#'(lambda (successors lifo) ;combiner
(let ((q (append successors lifo)))
(if (< (length q) width)
q
(subseq q 0 width))))))
(format *standard-output*
"~&Search required ~A Expansions." xcount))))
What are possible board evaluation functions? How do we measure which board states are closer to the goal?
One way of evaluating a board state is to count the number of tiles that are out of place.
(defun out-count (board)
"Retun the number of tiles out of place."
(let ((cost 0)
(n 1))
(dolist (val board cost)
(when (and (numberp val) (not (= n val)))
(incf cost))
(incf n))))
The problem with hill-climbing is that the best child is selected for expansion, and neither its siblings nor its parent are retained. So if hill-climbing produces a wrong turn down a branch that looks good locally, we will never be able to backtrack and get to the goal.
Best-first search maintains a priority queue to make it possible to recover from the local maxima that mislead the search down the wrong path.
(defun 8best-first (start goal cost)
(let ((xcount 0))
(prog1 (nreverse
(tree-search (list (list start)) ;open
;;goal-p
#'(lambda (path)
(equal (car path) goal))
;;expand
#'(lambda (path)
(incf xcount)
(sort (funcall #'next-paths path)
#'< :key cost))
;;combiner
#'(lambda (expansion priority-queue)
(delete-duplicates ;del dup paths
(merge 'list expansion
priority-queue
#'<
:key cost)
:from-end t
:key #'car
:test #'equal))))
(format *standard-output*
"~&Search required ~A Expansions." xcount))))
Admissible heuristics are evaluation functions that guarantee the search algorithm will find a minimal path to a solution when it exists. In order to come up with admissible heuristics we need to stay within a bounding evaluation function.
Suppose we knew of some function f*(n) that took a node and returned the _actual_ lowest cost from the start state to the goal state. Then at any node, n, that is on the shortest path between the start and goal states, we can separate it's cost into the cost to get to n, g*(n), and the cost to go from n to the goal, h*(n).
When picking a function to determine the cost from start to n, g(n), we know that g(n) always be >= to g*(n), because you can't do better than the optimal path to n. When picking a function to compute a heuristic estimate of the cost of going from n to the goal state, h(n), we need to be sure that it underestimates the cost: h(n)
<= h*(n). If we come up with an admissable heuristic for best-first search, where h(n) is always less than or equal to the actual cost of a minimal path, the search algorithm is known as A*.
(defun g (path) "Estimate of g*(n) which is the minimum distance from the start state to the current node." (length path))
out-count is guaranteed to be less than or equal to the number of moves required to move to a goal state. If we look at the problem from the perspective of, "How many moves does it take to get from the goal state to a state where n tiles are out of place?" we can look at the basic case of '(1 2 3 4 5 6 7 x 8) and see that the out-count is 1, and it took 1 move is to get one tile out of place. And we can see that we can get all 8 tiles out of place in no less than 8 moves. So if we use 8 moves to get all 8 tiles out of place, we know that we can get to a point where we will have between two and four possible moves into next states, and one of these moves will not put a tile back into place. Thus we have made out-count + 1 moves, and if we continue in this fasion, we see that out-count <= h*(n), where h*(n) is the minimum number of moves needed to reach the goal state.
(defun h (path) "Underestimator of the minimal cost of moving from current node to goal state if we take the minimal path." (out-count (car path)))
(defun f (path)
"A* evaluation function f(n) = g(n) + h(n)"
(+ (the fixnum (g path)) (the fixnum (h path))))
(defun 8A* (start goal)
(8best-first start goal #'f))
Using out-count to direct the beam search doesn't find the goal. This is hill-climbing because the width of the beam is 1.
* (8directed-beam '(2 8 3 1 6 4 7 x 5) '(1 2 3 8 x 4 7 6 5)
#'(lambda (path)
(out-count (car path)))
:width 1) ;Hill-climbing
Search required 182 Expansions.
NIL
Using out-count to direct the beam search with a width of three finds a path to the goal, but the solution path is a pathetic solution of 5,478 moves.
* (8directed-beam '(2 8 3 1 6 4 7 x 5) '(1 2 3 8 x 4 7 6 5)
#'(lambda (path)
(out-count (car path)))
:width 3)
Search required 5527 Expansions.
((2 8 3 1 6 4 7 X 5)
(2 8 3 1 X 4 7 6 5)
(2 8 3 1 4 X 7 6 5)
(2 8 3 1 4 5 7 6 X)
(2 8 3 1 4 5 7 X 6)
(2 8 3 1 X 5 7 4 6)
(2 8 3 1 5 X 7 4 6)
(2 8 3 1 5 6 7 4 X)
(2 8 3 1 5 6 7 X 4)
(2 8 3 1 X 6 7 5 4) ...)* (length *) 5478
Now I look at breadth-first search. Breadth first finds the minimal path in 48 expansions. As shown below, the a* evaluation function should enable best first to look at a subset of these 48 expansions.
* (8breadth-first '(2 8 3 1 6 4 7 x 5) '(1 2 3 8 x 4 7 6 5)) Search required 48 Expansions. ((2 8 3 1 6 4 7 X 5) (2 8 3 1 X 4 7 6 5) (2 X 3 1 8 4 7 6 5) (X 2 3 1 8 4 7 6 5) (1 2 3 X 8 4 7 6 5) (1 2 3 8 X 4 7 6 5))
Here I try best-first using out-count alone, i.e., g(n) = 0 ...
* (8best-first '(2 8 3 1 6 4 7 x 5) '(1 2 3 8 x 4 7 6 5)
#'(lambda (path)
(out-count (car path))))
Search required 39 Expansions.
((2 8 3 1 6 4 7 X 5) (2 8 3 1 6 4 7 5 X) (2 8 3 1 6 X 7 5 4)
(2 8 3 1 X 6 7 5 4) (2 X 3 1 8 6 7 5 4) (X 2 3 1 8 6 7 5 4)
(1 2 3 X 8 6 7 5 4) (1 2 3 8 X 6 7 5 4) (1 2 3 8 5 6 7 X 4)
(1 2 3 8 5 6 7 4 X) (1 2 3 8 5 X 7 4 6) (1 2 3 8 X 5 7 4 6)
(1 2 3 8 4 5 7 X 6) (1 2 3 8 4 5 7 6 X) (1 2 3 8 4 X 7 6 5)
(1 2 3 8 X 4 7 6 5))
Now try our a* algorithm on the same test case ...
* (8a* '(2 8 3 1 6 4 7 x 5) '(1 2 3 8 x 4 7 6 5)) Search required 19 Expansions. ((2 8 3 1 6 4 7 X 5) (2 8 3 1 X 4 7 6 5) (2 X 3 1 8 4 7 6 5) (X 2 3 1 8 4 7 6 5) (1 2 3 X 8 4 7 6 5) (1 2 3 8 X 4 7 6 5))
So from these two examples we can see that A* finds a minimal solution with fewer expansions. Now let's try the comparison on an even tougher test case:
* (8best-first '(2 7 3 1 6 4 8 x 5) '(1 2 3 4 5 6 7 8 x)
#'(lambda (path)
(out-count (car path))))
Search required 515 Expansions.
((2 7 3 1 6 4 8 X 5) (2 7 3 1 6 4 X 8 5) (2 7 3 X 6 4 1 8 5)
(2 7 3 6 X 4 1 8 5) (2 X 3 6 7 4 1 8 5) (X 2 3 6 7 4 1 8 5)
(6 2 3 X 7 4 1 8 5) (6 2 3 7 X 4 1 8 5) (6 2 3 7 4 X 1 8 5)
(6 2 3 7 4 5 1 8 X) ...)
* (length *)
128
It took quite awhile to get the 128 move solution. Now I try the a* alogrithm on the harder test case, and it comes up with the shortest path to the goal in less time.
* (8a* '(2 7 3 1 6 4 8 x 5) '(1 2 3 4 5 6 7 8 x))
Search required 122 Expansions.
((2 7 3 1 6 4 8 X 5) (2 7 3 1 X 4 8 6 5) (2 X 3 1 7 4 8 6 5)
(X 2 3 1 7 4 8 6 5) (1 2 3 X 7 4 8 6 5) (1 2 3 7 X 4 8 6 5)
(1 2 3 7 4 X 8 6 5) (1 2 3 7 4 5 8 6 X) (1 2 3 7 4 5 8 X 6)
(1 2 3 7 4 5 X 8 6) (1 2 3 X 4 5 7 8 6) (1 2 3 4 X 5 7 8 6)
(1 2 3 4 5 X 7 8 6) (1 2 3 4 5 6 7 8 X))
* (length *)
14
Now I check to see where the biggest bottleneck is ...
* (profile:profile-all) * (8a* '(2 7 3 1 6 4 8 x 5) '(1 2 3 4 5 6 7 8 x)) Search required 122 Expansions. * (profile:report-time) Seconds | Consed | Calls | Sec/Call | Name: ------------------------------------------------------ 0.093 | 0 | 11,710 | 0.00001 | F 0.009 | 0 | 166 | 0.00006 | AT-LFT-P 0.008 | 24,048 | 463 | 0.00002 | SWAP 0.000 | 0 | 166 | 0.00000 | AT-TOP-P 0.000 | 0 | 1 | 0.00000 | 8A*
0.000 | 0 | 166 | 0.00000 | AT-BOT-P 0.000 | 0 | 166 | 0.00000 | AT-RHT-P 0.000 | 8,192 | 166 | 0.00000 | NEXT-BOARDS 0.000 | 65,536 | 166 | 0.00000 | TREE-SEARCH ------------------------------------------------------ 0.111 | 97,776 | 13,170 | | Total Estimated total profiling overhead: 0.08 seconds
Looking at the profile output, I can see that the most time is spent calculating f, which is based on g and h.
Looking at my best-first search algorithm, I can see that this cost function is being used to sort the expansion, and to merge the expansion into the priority queue. So in effect every comparison in the sort and merge is going to require I recompute the heuristic evaluation. I can improve things and make this a static evaluation by changing my representation of paths.
(defstruct (path (:type vector)) state (previous nil) (g 0) (f 0))
As part of the path I can store the cost of traversing the path so far (g) and the total cost of the entire path (f = g + h).
This will save time because the path representation now caches these values for each partial path.
(defun path-member (state path)
(cond ((equal state (path-state path)))
(t (if (path-previous path)
(path-member state (path-previous path)) nil))))
(defun next-paths* (old-path cost-to-goal)
"Expands path into a list of paths to the board's next possible
states. Cycles are avoided by expanding only if the expansion
leads to a state not already in the path."
(loop for next-board in (next-boards (path-state old-path))
if (not (path-member next-board old-path))
collect (let ((g-val (+ (path-g old-path) 1)))
(make-path :state next-board
:previous old-path
:g g-val
:f (+ g-val
(funcall cost-to-goal
next-board))))))
(defun 8best-first* (start goal cost-to-goal)
(let ((xcount 0))
(prog1
(path-state
(tree-search (list (make-path :state start)) ;open
#'(lambda (path) ;goal-p
(equal (path-state path) goal))
#'(lambda (path) ;expand
(incf xcount)
(sort (next-paths* path cost-to-goal)
#'<
:key #'path-f))
#'(lambda (expansion priority-queue) ;combiner
(delete-duplicates (merge 'list
expansion
priority-queue
#'<
:key #'path-f)
:from-end t
:key #'path-state
:test #'equal))))
(format *standard-output*
"~&Search required ~A Expansions."
xcount))))
(defun 8A** (start goal)
(8best-first** start goal #'out-count))
With this change the overall time of computation improves, and I notice new bottle necks rising to the surface. So for example, if I really needed to go for more speed, I can see that swap is holding me up now. Since the board is represented as a list, swap has to traverse the list to find an element. Another speed increase could be obtained by representing the board as an array.
* (profile:report-time)
Seconds | Consed | Calls | Sec/Call | Name:
------------------------------------------------------
0.018 | 56,736 | 463 | 0.00004 | SWAP
0.007 | 0 | 166 | 0.00004 | NEXT-BOARDS
0.000 | 0 | 166 | 0.00000 | AT-LFT-P
0.000 | 0 | 166 | 0.00000 | AT-TOP-P
0.000 | 0 | 1 | 0.00000 | 8A*
0.000 | 0 | 166 | 0.00000 | AT-BOT-P
0.000 | 0 | 166 | 0.00000 | AT-RHT-P
0.000 | 0 | 298 | 0.00000 | MAKE-PATH
0.000 | 8,184 | 1 | 0.00000 | PRINT-PATH
0.000 | 0 | 11,710 | 0.00000 | PATH-F
0.000 | 0 | 961,490 | 0.00000 | PATH-STATE
0.000 | 0 | 298 | 0.00000 | OUT-COUNT
0.000 | 0 | 2,489 | 0.00000 | PATH-MEMBER
0.000 | 40,960 | 167 | 0.00000 | TREE-SEARCH
------------------------------------------------------
0.025 | 105,880 | 977,747 | | Total
Estimated total profiling overhead: 5.87 seconds
References
Norvig, P. (1992). Paradigms of artificial intelligence programming: Case studies in Common Lisp. San Francisco, CA: Morgan Kaufmann Publishers, Inc.
Russell, S.J, & Norvig, P & Canny, J. (2003). Artificial intelligence: A modern approach (2nd ed.). Upper Saddle River, N.J: Prentice Hall.
___
Copyright © Jason Kantz 2005