#|---------------------------------------------------------------------------- Artificial Intelligence, Second Edition Elaine Rich and Kevin Knight McGraw Hill, 1991 This code may be freely copied and used for educational or research purposes. All software written by Kevin Knight. Comments, bugs, improvements to knight@cs.cmu.edu ----------------------------------------------------------------------------|# #|---------------------------------------------------------------------------- RTA-STAR SEARCH "rta.lisp" ----------------------------------------------------------------------------|# ;;------------------------------------------------------------------------- ;; Structure RTANODE contains information for a single search node for RTA*. ;; It records the projected distance to the goal (h), the distance so far ;; from the start table (g), and the immediate predecessor of the node ;; (parent). (defstruct rta-node h g parent) ;;------------------------------------------------------------------------- ;; Constant *HIGHEST-STATIC-VALUE* is used to initialize a variable to find ;; the best successor of a node. (defconstant *highest-static-value* *infinity*) ;; Variable *VISITED-STATES* is the hash table used by RTA* to remember ;; the states it has passed through. (defvar *visited-states* nil) (setq *visited-states* (make-array *hash-table-size*)) (defconstant *hash-table-size* 4000) ;; Variable *NUMBER-OF-STEPS-TAKEN* counts the number of real-time moves ;; made by RTA* during a search. Because RTA* can return to a previously ;; visited state (looping), *NUMBER-OF-STEPS-TAKEN* may be larger than the ;; number of steps in the solution path that is returned. (defvar *number-of-steps-taken* nil) ;;------------------------------------------------------------------------- ;; Function RTA-STAR searches for a solution path from start to goal. The ;; third parameter, horizon, tells RTA* how many moves it may look ahead ;; locally before deciding on an action to take. The longer the horizon, ;; the shorter the solution path will be; however, because the search is ;; exponential, shorter paths may take longer to compute. (defun rta-star (start horizon &optional verbose) (clear-hash) (setq *number-of-steps-taken* 0) (do ((node start) (prev nil)) ((goal-state? node) (adjust-parent-pointers prev node) (extract-rta-path node)) (adjust-parent-pointers prev node) (setq prev node) (setq node (best-local-step node horizon)) (when verbose (format t "~4d: h = ~2d. Move to ~d~%" *number-of-steps-taken* (heuristic node) node)) (setq *number-of-steps-taken* (1+ *number-of-steps-taken*)))) ;; Function EXTRACT-RTA-PATH returns a solution path by following parent ;; pointers from the goal state to the start state. (defun extract-rta-path (node) (do ((n node (get-rta-parent n)) (path nil)) ((null n) path) (setq path (cons n path)))) ;; Function ADJUST-PARENT-POINTERS is called by RTA-STAR after each move ;; is made. If the move was to a node already in the table, its parent ;; pointer is left undisturbed; otherwise its parent pointer is set to the ;; state before the move was made. Thus, a chain of parent pointers will not ;; include any loops, and RTA-STAR will keep track of the shortest path from ;; the start state to each of the states in the table. (defun adjust-parent-pointers (prev node) (cond ((null prev) (set-rta-g node 0) (set-rta-parent node nil)) (t (let ((possible-new-g (+ (cost-of-move prev node) (get-rta-g prev)))) (when (or (null (get-rta-g node)) (< possible-new-g (get-rta-g node))) (set-rta-g node possible-new-g) (set-rta-parent node prev)))))) ;;------------------------------------------------------------------------- ;; Function CLEAR-HASH clears the table of visited states. (defun clear-hash () (dotimes (x *hash-table-size*) (setf (aref *visited-states* x) nil))) ;; Function INSERT-TABLE-ENTRY inserts an rta-node into the table of visited ;; states. The hash key is the state itself. (defun insert-table-entry (s value) (let* ((hash-val (mod (hash-state s) *hash-table-size*)) (p (assoc s (aref *visited-states* hash-val) :test #'eq-states))) (cond ((null p) (setf (aref *visited-states* hash-val) (cons (cons s value) (aref *visited-states* hash-val)))) (t (setf (cdr p) value))))) ;; Function GET-TABLE-ENTRY retrieves from the hash table the rta-node ;; associated with state s. (defun get-table-entry (s) (cdr (assoc s (aref *visited-states* (mod (hash-state s) *hash-table-size*)) :test #'eq-states))) ;;------------------------------------------------------------------------- ;; Functions GET-RTA-G, GET-RTA-H, and GET-RTA-PARENT access fields of an ;; rta-node associated with a state s. ;; Functions SET-RTA-G, SET-RTA-H, and SET-RTA-PARENT modify those fields. (defun get-rta-g (s) (let ((entry (get-table-entry s))) (if (null entry) nil (rta-node-g entry)))) (defun get-rta-h (s) (let ((entry (get-table-entry s))) (if (null entry) nil (rta-node-h entry)))) (defun get-rta-parent (s) (let ((entry (get-table-entry s))) (if (null entry) nil (rta-node-parent entry)))) (defun set-rta-g (s val) (let ((entry (get-table-entry s))) (cond ((null entry) (insert-table-entry s (make-rta-node :g val))) (t (setf (rta-node-g entry) val))))) (defun set-rta-h (s val) (let ((entry (get-table-entry s))) (cond ((null entry) (insert-table-entry s (make-rta-node :h val))) (t (setf (rta-node-h entry) val))))) (defun set-rta-parent (s val) (let ((entry (get-table-entry s))) (cond ((null entry) (insert-table-entry s (make-rta-node :parent val))) (t (setf (rta-node-parent entry) val))))) ;;------------------------------------------------------------------------- ;; Function BEST-LOCAL-STEP chooses a single move from start towards goal, ;; looking horizon levels ahead. Following the RTA* algorithm, it sets the h ;; value of the current state to the heuristic score of the second best ;; successor. (defun best-local-step (start horizon) (let ((succs (expand start t))) (do ((s succs (cdr s)) (best-succ nil) (best-score *highest-static-value*) (second-best-score *highest-static-value*)) ((null s) (mapc #'(lambda (s1) (when (not (eq s1 best-succ)) (destroy-state s1))) succs) (set-rta-h start second-best-score) best-succ) (let* ((succ (car s)) (estimate (+ (cost-of-move start succ) (or (get-rta-h succ) (minimin-alpha succ horizon))))) (cond ((> best-score estimate) (setq second-best-score best-score) (setq best-score estimate) (setq best-succ succ)) ((> second-best-score estimate) (setq second-best-score estimate))))))) ;;------------------------------------------------------------------------- ;; Function MINIMIN-ALPHA performs a depth-first search with alpha-pruning. ;; The search is limited to horizon levels deep. Alpha-pruning requires that ;; heuristic values be computed for internal nodes as well as leaf nodes. ;; Duplicate nodes along any given path are not expanded. (defvar *alpha* nil) (defun minimin-alpha (start horizon) (setq *alpha* *highest-static-value*) (let ((depth 0) (cost-so-far 0)) (minimin-alpha-1 start horizon depth cost-so-far nil)) *alpha*) (defun minimin-alpha-1 (start horizon depth cost-so-far parents) (cond ((goal-state? start) (setq *alpha* (min *alpha* cost-so-far))) ((= horizon depth) (setq *alpha* (min *alpha* (+ cost-so-far (heuristic start))))) (t (let ((succs (expand start))) (do ((s succs (cdr s))) ((null s) (mapc #'destroy-state succs) *alpha*) (let ((succ (car s))) (when (not (member succ parents :test #'eq-states)) (let* ((estimate (heuristic succ)) (f-value (+ estimate cost-so-far))) (cond ((< f-value *alpha*) (setq *alpha* (min *alpha* (minimin-alpha-1 succ horizon (1+ depth) (+ cost-so-far (cost-of-move start succ)) (cons start parents)))))))))))))) ;;------------------------------------------------------------------------- ;; Function RTA-STATS takes a number of trials, a horizon, and a filename. ;; It performs RTA* a number of times and writes the average results out ;; to the file. Because of the large number of random decisions RTA* must ;; make, its performance can vary widely, even on the same problem. (defun rta-stats (trials horizon outfile) (let ((*problems* nil)) (dotimes (i trials) (setq *problems* (cons (generate-problem) *problems*))) (with-open-file (ofile outfile :direction :output :if-exists :append :if-does-not-exist :create) (do ((start-time (get-universal-time)) (n 0 (1+ n)) (avg-path-length 0) (avg-soln-length 0)) ((= n trials) (format ofile "Trials: ~d~%" trials) (format ofile "Search horizon: ~d~%" horizon) (let ((end-time (get-universal-time))) (format ofile "Time: ~d min. ~d sec.~%" (truncate (/ (- end-time start-time) 60)) (mod (- end-time start-time) 60))) (format ofile "Average number of steps: ~d~%" (coerce (/ avg-path-length trials) 'float)) (format ofile "Average solution length: ~d~%~%" (coerce (/ avg-soln-length trials) 'float))) (format t "Solving problem ~d of ~d ...~%" (1+ n) trials) (let* ((start (nth n *problems*)) (solution (rta-star start horizon))) (format t " Number of steps: ~d~%" *number-of-steps-taken*) (format t " Solution length: ~d~%" (1- (length solution))) (setq avg-path-length (+ avg-path-length *number-of-steps-taken*)) (setq avg-soln-length (+ avg-soln-length (1- (length solution)))))))))