home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e070 / 5.ddi / EXPLORER / VIEWER / SEARCHIN.P < prev    next >
Encoding:
Text File  |  1984-10-13  |  2.0 KB  |  71 lines
  1. ;;;; This file contains search procedures.
  2.  
  3. ;;; This is the node-expansion procedure.
  4.  
  5. (DEFUN EXPAND (PATH)
  6.   (LET ((REVERSED-PATH (REVERSE PATH)))
  7.     (MAPCAR 'REVERSE
  8.       (REMOVE-IF '(LAMBDA (NEW-PATH)
  9.                     (MEMBER (FIRST NEW-PATH) (REST NEW-PATH)))
  10.         (MAPCAR '(LAMBDA (NEIGHBOR) (CONS NEIGHBOR REVERSED-PATH))
  11.                 (GET (FIRST REVERSED-PATH) 'NEIGHBORS))))))
  12.  
  13. ;;; These are the depth-first search procedures.
  14.  
  15. (DEFUN START-DEPTH (START GOAL)
  16.   (DEPTH (LIST (LIST START))
  17.          GOAL))
  18.  
  19. (DEFUN DEPTH (QUEUE GOAL)
  20.   (IF (NULL QUEUE)
  21.       NIL
  22.       (IF (EQUAL GOAL (FIRST (LAST (FIRST QUEUE))))
  23.           (FIRST QUEUE)
  24.           (DEPTH (APPEND (EXPAND (FIRST QUEUE)) 
  25.                          (REST QUEUE))
  26.                  GOAL))))
  27.  
  28. ;;; These are the breadth-first search procedures.
  29.  
  30. (DEFUN START-BREADTH (START GOAL)
  31.   (BREADTH (LIST (LIST START))
  32.            GOAL))
  33.  
  34. (DEFUN BREADTH (QUEUE GOAL)
  35.   (IF (NULL QUEUE)
  36.       NIL
  37.       (IF (EQUAL GOAL (FIRST (LAST (FIRST QUEUE))))
  38.           (FIRST QUEUE)
  39.           (BREADTH (APPEND (REST QUEUE)
  40.                          (EXPAND (FIRST QUEUE)))
  41.                    GOAL))))
  42. ;;; These are the best-first search procedures.  They won't work
  43. ;;; until GC LISP gets SORT.
  44.  
  45. (DEFUN START-BEST (START GOAL)
  46.   (BEST (LIST (LIST START))
  47.               GOAL))
  48.  
  49. (DEFUN BEST (QUEUE GOAL)
  50.   (IF (NULL QUEUE)
  51.       NIL
  52.       (IF (EQUAL GOAL (FIRST (LAST (FIRST QUEUE))))
  53.           (FIRST QUEUE)
  54.           (BEST (SORT (APPEND (EXPAND (FIRST QUEUE))
  55.                               (REST QUEUE))
  56.                       '(LAMBDA (X Y) (CLOSERP X Y GOAL)))
  57.                 GOAL))))
  58.  
  59. (DEFUN CLOSERP (X Y WRT)
  60.   (< (DISTANCE2 (FIRST X) WRT)
  61.      (DISTANCE2 (FIRST Y) WRT)))
  62.  
  63. (DEFUN DISTANCE2 (A B)
  64.   (let* ((PA (GET A 'POSITION))
  65.          (PB (GET B 'POSITION)))
  66.      (+ (SQUARE (- (FIRST PA) (FIRST PB)))
  67.         (SQUARE (- (FIRST (REST PA)) (FIRST (REST PB)))))))
  68.  
  69. (DEFUN SQUARE (X) (* X X))
  70.  
  71.