home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
aijournl
/
1987_03
/
exprt2.mar
< prev
next >
Wrap
Lisp/Scheme
|
1987-02-21
|
3KB
|
74 lines
; STATE-SPACE SEARCH PROCEDURE
; These functions provide a general control structure for
; solving problems using heuristic search. In order to apply
; this method to a particular problem, you must write the
; functions: initial-state, goal, successors, and print-solution.
; See the "Expert's Toolbox" column in the March AI-Expert
; for a description of this algorithm and an example of its use.
;
; Algorithm given by Dr. Ralph Grishman, New York University,
; after Nils Nilsson, "Principles of Artificial Intelligence".
; Adapted for Xlisp by Marc Rettig (76703,1037).
(defun search ()
(prog (open closed n m successor-list same)
; Step 1. Put initial state on open.
(setq open (list (initial-state)))
; Step 2. If open is empty, exit with failure.
expand:
(cond ((null open) (print 'failure) (return nil)))
; Step 3. Remove state from open with minimum g + h and
; call it n. (open is sorted by increasing g + h, so
; this is first element.) Put n on closed.
; Exit with success if n is a goal node.
(setq n (car open))
(setq open (cdr open))
(setq closed (cons n closed))
(trace 'expanding n)
(cond ((goal n) (print-solution n) (return t)))
; For each m in successors(m):
(setq successor-list (successors n))
next-successor:
(cond ((null successor-list) (go expand:)))
(setq m (car successor-list))
(setq successor-list (cdr successor-list))
(trace 'successor m)
(cond ((setq same (find m open))
; if m is on open, reset g if new value is smaller
(cond
((< (get m 'g) (get same 'g))
(setq open (add m (remove same open))))))
((setq same (find m closed))
; If m is on closed and new value of g is smaller,
; remove state from closed and add it to open with new g.
(cond
((< (get m 'g) (get same 'g))
(setq closed (remove same closed))
(setq open (add m open)))))
(t
; else add m to open
(setq open (add m open))))
(go next-successor:)))
(defun add (state s-list)
; Inserts state into s-list so that list remains ordered
; by increasing g + h.
(cond ((null s-list) (list state))
((> (+ (get (car s-list) 'g) (get (car s-list) 'h))
(+ (get state 'g) (get state 'h)))
(cons state s-list))
(t (cons (car s-list) (add state (cdr s-list))))))
(defun find (state s-list)
; returns first entry on s-list whose position is same
; as that of state.
(cond ((null s-list) nil)
((equal (get state 'position)
(get (car s-list) 'position))
(car s-list))
(t (find state (cdr s-list)))))