home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / forum3.lzh / LISP / search.lsp < prev   
Encoding:
Lisp/Scheme  |  1987-11-19  |  4.8 KB  |  105 lines
  1. ; File SEARCH.LSP, by Christopher F. Chabris, October 1986
  2. ; This file contains XLisp 1.7 functions to implement basic breadth-first
  3. ;  and depth-first search algorithms, as well as a simple state-space for
  4. ;  the route-finding problem. (For ST XLisp-AI Conference #3, 10/6/86.)
  5.  
  6.  
  7. ; First, we define the state-space we will be searching through with a few
  8. ;  simple PUTPROP calls that specify for each state, or city, the other
  9. ;  states that can be reached from it with one operator. For pedagogical
  10. ;  purposes, we will not specify the operators themselves, just their effects.
  11. ;  Also note that there is one PUTPROP for each state in the state-space, and
  12. ;  that you can make such code quite readable despite all the parentheses!
  13.  
  14. (putprop 'hanover      '(cambridge ithaca)             'successors)
  15. (putprop 'cambridge    '(hanover providence)           'successors)
  16. (putprop 'providence   '(cambridge newhaven)           'successors)
  17. (putprop 'newhaven     '(providence newyork)           'successors)
  18. (putprop 'newyork      '(newhaven ithaca princeton)    'successors)
  19. (putprop 'ithaca       '(hanover newyork philadelphia) 'successors)
  20. (putprop 'princeton    '(newyork philadelphia)         'successors)
  21. (putprop 'philadelphia '(princeton ithaca)             'successors)
  22.  
  23.  
  24. ; Now we define the top level breadth-first and depth-first functions. Note
  25. ;  that the only difference between the two is how the OPEN list, which
  26. ;  contains the yet unexplored states at any given time, is formed (this is
  27. ;  done in the fourth line of the BFS and DFS function definitions). The
  28. ;  BFS algorithm adds new child states to the end of OPEN, while DFS adds
  29. ;  them to the beginning. I am always impressed by the way a small nuance
  30. ;  can control the behavior of a relatively complex algorithm. Later, we
  31. ;  will see how we can add "intelligence" to the basic algorithms given here
  32. ;  with just a few modifications. The same framework covers most of the
  33. ;  search strategies popular in AI programming.
  34.  
  35. (defun breadth-first-search (start goal)
  36.   (setq *goal-node* goal)
  37.   (bfs (list (list start nil)) nil))
  38.  
  39. (defun bfs (open closed)
  40.   (cond ((null open) nil)
  41.         ((goal (car open)) (findpath (cons (car open) closed) (caar open)))
  42.         (t (bfs (append (cdr open) (prune (children (car open)) open closed))
  43.                 (cons (car open) closed)))))
  44.  
  45. (defun depth-first-search (start goal)
  46.   (setq *goal-node* goal)
  47.   (dfs (list (list start nil)) nil))
  48.  
  49. (defun dfs (open closed)
  50.   (cond ((null open) nil)
  51.         ((goal (car open)) (findpath (cons (car open) closed) (caar open)))
  52.         (t (dfs (append (prune (children (car open)) open closed) (cdr open))
  53.                 (cons (car open) closed)))))
  54.  
  55.  
  56. ; Now we define the various supporting functions that were called by the
  57. ;  above functions: GOAL, which returns T if a given node is a goal node,
  58. ;  or NIL otherwise; CHILDREN, which returns a list of nodes that are the
  59. ;  successors of a given node; FINDPATH, which takes a node and the CLOSED
  60. ;  list and returns a path back to the start node; and PRUNE, which takes
  61. ;  a list of nodes (usually the generated successors) and the OPEN and
  62. ;  CLOSED lists and removes from the first nodes that are contained in the
  63. ;  other two (this has the effect of avoiding the cycling problem in search).
  64.  
  65. (defun goal (node)
  66.   (equal *goal-node* (car node)))
  67.  
  68. (defun children (node)
  69.   (let ((successors (get (car node) 'successors)))
  70.        (mapcar 'list successors (make-list (length successors) (car node)))))
  71.  
  72.  
  73. (defun findpath (nodelist state)
  74.   (cond ((null state) nil)
  75.         ((equal state (caar nodelist))
  76.          (append (findpath (cdr nodelist) (cadar nodelist)) (list state)))
  77.         (t (findpath (cdr nodelist) state))))
  78.  
  79.  
  80. (defun prune (nodelist open closed)
  81.   (cond ((null nodelist) nil)
  82.         ((or (member (caar nodelist) (mapcar 'car open))
  83.              (member (caar nodelist) (mapcar 'car closed)))
  84.          (prune (cdr nodelist) open closed))
  85.         (t (cons (car nodelist) (prune (cdr nodelist) open closed)))))
  86.  
  87.  
  88. ; A note on representation: the OPEN and CLOSED lists are represented as
  89. ;  "association lists", which are just Lisp lists where each member is a
  90. ;  two-element list itself. (Although XLisp has special functions to
  91. ;  manipulate A-lists, we do not use them here.) Our functions treat the
  92. ;  first element of each pair as a state (city) and the second element as
  93. ;  that state's parent (the state from which it was generated). This way,
  94. ;  we can use the pairs on the CLOSED list of explored states to trace the
  95. ;  path back to the start state.
  96.  
  97.  
  98. ; This final function, MAKE-LIST, takes a number n and any expression and
  99. ;  returns a list of length n, with each element being that expression. A
  100. ;  similar function is built into Common Lisp, but not XLisp 1.7.
  101.  
  102. (defun make-list (size expr)
  103.   (cond ((zerop size) nil)
  104.         (t (cons expr (make-list (1- size) expr)))))
  105.