User Documentation | LISP code
A LISP program using the A* search algorithm to solve and 8 square puzzle. Uses a one dimensional array to represent the grid.
Test case:
Initial Position
| 2 | 8 | 3 |
| 1 | 6 | 4 |
| 7 | 5 |
Final Position
| 1 | 2 | 3 |
| 8 | 4 | |
| 7 | 6 | 5 |
;this program is based on the A* algorithm
;there are some differences
; 1 rather than sort the queue
; this program finds the node with the lowest f(n) value
; and evaluates the value
;set values to send to recursive function
; goal to be reached
(setf goal '(1 2 3 8 0 4 7 6 5))
;initial positions
(setf ip '( (5 5 0 (2 8 3 1 6 4 7 0 5) )) )
;the variable ip is in the form that all nodes
; are handled and evaluated
; the 5 5 0 are given hueristic values to start
; the stand for f(n) h(n) g(n) respectively
; the rest of the list contains the actual
; state
;the list of closed values -empty to start
(setf closed (list))
;initial level in search tree
(setf level '0)
;call to recursive function "build_tree
(print (build_tree ip closed level goal))
;----------functions start here----------
; function build_tree
; receives a queue of nodes, closed list of nodes,
; level, goal node,
(defun build_tree (queue closed_list level goal)
;since we are only interested in the node
;with the lowest f(n) value
;sorting the entire queue is more
;complicated than finding the node
;with the lowest f(n) value
(setf lowest (car queue)) ;put in a temp value to compare to
(dolist (w queue); goes through queue
;put node with lowest f value in lowest
(if (< (car w) (car lowest) ) (setf lowest w) )
);dolist
; lisp seems to have problems with if statement with
; multiple lines of code, so each line needs its own if-statement
; if current node is not the goal, remove from queue
;if current node is not the goal, remove from queue
(if (not (equal (nth 3 lowest) goal)) (setf queue (remove lowest queue)) )
;set the value of the node's positions to parent
;the positions are used to generate child states
(if (not (equal (nth 3 lowest) goal)) (setf parent (nth 3 lowest)) )
;add the node to the closed list
(if (not (equal (nth 3 lowest) goal)) (setf closed_list (cons lowest closed_list)))
; send the parent to function gen_descendants
; this function returns child states
; child states that may go backwards are eliminated from this list
(if (not (equal (nth 3 lowest) goal)) (setf children
(gen_descendants parent queue closed_list)))
;children are sent to function add_to_q to have f h g values added
;the list of children
(if (not (equal (nth 3 lowest) goal)) (setf queue (append(add_to_q children level goal) queue)) )
(setf level (+ level 1))
(if (not (equal (nth 3 lowest) goal)) (print parent) )
;recursive call to build tree
;this builds the search space
(if (not (equal (nth 3 lowest) goal))
(setf goal_path (append goal_path (build_tree queue closed_list level goal))) )
;if the current node is the goal
;return to caller
(if (equal (nth 3 lowest) goal) (setf goal_path (nth 3 lowest)) )
goal_path
);build-tree
;function gen_descendants
;this function receives a parent node, the current queue
;and the closed list (nodes removed from queue)
;it generates the children of the parent
(defun gen_descendants (parent queue closed)
;finds the location of '0' -the space
(setf l (length parent))
(dotimes (a l)
(setf temp (nth a parent))
(if (equal temp 0)
(setf loc a)
(setf a (- l 1))
);if
):dotimes
;with the position of the space known
; when generate a list of possible moves
(cond ( (equal loc 0) (setf moves '(r d)) )
( (equal loc 1) (setf moves '(l r d)) )
( (equal loc 2) (setf moves '(l d)) )
( (equal loc 3) (setf moves '(u d r)) )
( (equal loc 4) (setf moves '(l u d r)) )
( (equal loc 5) (setf moves '(l u d)) )
( (equal loc 6) (setf moves '(u r)) )
( (equal loc 7) (setf moves '(l r u)) )
( (equal loc 8) (setf moves '(l u)) )
(T 'move unknown)
);cond
;using moves found above, generate descendants
;create an empty list to hold descendants
(setf childlist (list))
;walk through list of moves, generating a child for each
;the actual moving is done by the function "swapper"
(dolist (x moves)
(cond ( (equal x 'u) (setf childlist (append childlist
(list (swapper loc parent -3)))) )
( (equal x 'd) (setf childlist (append childlist
(list (swapper loc parent 3)))) )
( (equal x 'l) (setf childlist (append childlist
(list (swapper loc parent -1)))) )
( (equal x 'r) (setf childlist (append childlist
(list (swapper loc parent 1)))) )
(T 'move_unknown)
);cond
);dolist
;the function loop_check eliminates child nodes that
;go backwards
(setf childlist (loop_check childlist queue closed))
;return list of descendants to caller
childlist
);gen_descendants
;function h_hueristic
; receives a child node, the goal
; adds the h value to the node
(defun h_hueristic (qlist goal)
(setf h 0) ;initialize h
(setf l (length qlist))
(dotimes (a l h) ;walks through list if
; values don't match, it adds 1 to h
;returns h when done
(if (not (equal (nth a qlist) (nth a goal))) (setf h (+ h 1)) )
) ;dotimes
) ;h_hueristic
;function swapper
;takes a location, alist and number of moves
;swaps the element at the location with
; the element a certain number of moves away
(defun swapper (loc alist move)
; since using setf would create identical list
; -(another lisp problem)-
; change to one list would change the other
; elements of the list have to be copied
; individually to an empty list
(setf blist (list)) ;create empty list
(dolist (x alist) ;loop through received list
(setf blist (cons x blist)) ;copy each element to empty list
);dolist
(setf blist (reverse blist)) ;list is backwards reverse to
;correct
(setf loc2 (+ loc move)) ;find out where to move to
(setf temp (nth loc alist)) ;put element in temp holder
(setf (nth loc blist) (nth loc2 blist)) ;put elemnent into
; 1st position
(setf (nth loc2 blist) temp) ;put temp into 2nd position
;return swapped list
blist
);swapper
;function add_to_q
;recieves a list of children
; adds hueristic values
; returns a list of state nodes
(defun add_to_q (children level goal)
;add h hueristic value to each child node
(setf tempchildren (list)) ;temp holder for list of children
; with h values added
(dolist (w children) ;walk through list
(setf temp_el (list w)) ;put child into list
(setf temp_el (cons level temp_el)) ;add g(n) value to
; child listnode
;put list with g value on a temp list
(setf tempchildren (cons temp_el tempchildren))
);dolist
;this dolist adds the h value onto each node
;by calling the function h_hueristic
(setf tempchildren2 (list))
(dolist (z tempchildren) ;walk through new list
(setf d (h_hueristic (cadr z) goal))
(setf hz z)
(setf hz (cons d hz) )
(setf hz (cons (+ (cadr hz) d) hz))
(setf tempchildren2 (cons hz tempchildren2))
);dolist
tempchildren2
);add_to_q
;function loop_check
;receives a list of children
;compares with nodes on the closed list
;removes duplicates from childist
(defun loop_check (childlist queue closedlist)
(dolist (j childlist)
(dolist (k closedlist)
(if (equal j (nth 3 k)) (setf childlist (remove j childlist)))
);dolist
);dolist
;return a clean list to caller
childlist
)
Back to top