home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / CLDEC87.ZIP / AIEYE.LTG next >
Encoding:
Text File  |  1987-11-23  |  5.0 KB  |  184 lines
  1.  
  2. Aieye Listing 1
  3.  
  4.  
  5. ; hill climbing search
  6. ; in PC Scheme
  7. ; call: (hike-up 'o 'g)
  8.  
  9. (define hike-up
  10.   (lambda (origin goal)
  11.     (climb (list (list origin)) goal)))
  12.  
  13. (define climb
  14.   (lambda (path goal)
  15.     (cond ((eq? path '()) '())
  16.           ((eq? goal (caar path)) (reverse (car path)))
  17.           (else
  18.             (climb (append (sort-path   ;sort node's children
  19.                              (expand-node (car path)) ;by remaining distance
  20.                              (lambda (path1 path2)  ;children to front
  21.                                (nearest? path1 path2 goal)))
  22.                            (cdr path)) goal)))))
  23.  
  24. (define how-far          ;straightline distance   
  25.   (lambda (node1 node2)
  26.     (sqrt (+ (square (- (getprop node1 'x)
  27.                         (getprop node2 'x)))
  28.              (square (- (getprop node1 'y)
  29.                         (getprop node2 'y)))))))
  30.  
  31. (define (square x) (* x x))
  32.  
  33. (define nearest?      ;which is least distance from goal node
  34.   (lambda (path1 path2 goal)
  35.     (<? (how-far (car path1) goal)
  36.         (how-far (car path2) goal))))
  37.  
  38. (define (sort-path path by) 
  39.   (sort! path by))
  40.  
  41. (define expand-node  ;find node's offspring using
  42.   (lambda (path)     ;property list
  43.     (map (lambda (child) (cons child path))
  44.          (getprop (car path) 'children))))
  45. ;include property list from Listing 2
  46. ;end-of-hill-climbing-search
  47.  
  48.  
  49.  
  50. Aieye Listing 2
  51.  
  52.  
  53.  
  54. ; Property list describing net
  55. ; to be used with each search listing
  56. è; in Scheme.  Individual LISP implementations
  57. ; vary in property list structure and
  58. ; operations.
  59. ; 
  60. (putprop 'O '(A C)    'children)
  61. (putprop 'A '(O C B)  'children)
  62. (putprop 'B '(A E G)  'children)
  63. (putprop 'C '(O A D E)'children)
  64. (putprop 'D '(E C)    'children)
  65. (putprop 'E '(C B D G)'children)
  66. (putprop 'G '(B E)    'children)
  67. (putprop 'o '20 'x)
  68. (putprop 'o '50 'y)
  69. (putprop 'a '55 'x)
  70. (putprop 'a '55 'y)
  71. (putprop 'b '70 'x)
  72. (putprop 'b '40 'y)
  73. (putprop 'c '20 'x)
  74. (putprop 'c '30 'y)
  75. (putprop 'd '25 'x)
  76. (putprop 'd '10 'y)
  77. (putprop 'e '45 'x)
  78. (putprop 'e '45 'y)
  79. (putprop 'g '65 'x)
  80. (putprop 'g '20 'y)
  81. ; end-of-property-list
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89. Aieye Listing 3
  90.  
  91.  
  92.  
  93. ; best-first search
  94. ; in PC Scheme
  95. ; call: (best-first 'o 'g)
  96.  
  97. (define best-first
  98.   (lambda (origin goal)
  99.     (best (list (list origin)) goal)))
  100.  
  101. (define best
  102.   (lambda (path goal)
  103.     (cond ((eq? path '()) '())
  104.           ((eq? goal (caar path)) (reverse (car path)))
  105.           (else (best (sort-path  ;sort path by distance to goal
  106.                         (append (expand-node (car path))
  107.                                 (cdr path))
  108.                         (lambda (path1 path2)
  109.                           (nearest? path1 path2 goal))) goal)))))
  110.  
  111. è(define how-far  ;straightline distance using property list
  112.   (lambda (node1 node2)
  113.     (sqrt (+ (square (- (getprop node1 'x)
  114.                         (getprop node2 'x)))
  115.              (square (- (getprop node1 'y)
  116.                         (getprop node2 'y)))))))
  117.  
  118. (define (square x) (* x x))
  119.  
  120. (define nearest?   ;test for least distance to goal
  121.   (lambda (path1 path2 goal)
  122.     (<? (how-far (car path1) goal)
  123.         (how-far (car path2) goal))))
  124.  
  125. (define (sort-path path by)
  126.   (sort! path by))
  127.  
  128. (define expand-node ;get node's offspring using property list
  129.   (lambda (path)
  130.     (map (lambda (child) (cons child path))
  131.          (getprop (car path) 'children))))
  132.  
  133. ;include property list from Listing 2
  134. ;end-of-best-first
  135.  
  136.  
  137.  
  138. Aieye Listing 4
  139.  
  140.  
  141.  
  142. ; branch-and-bound search
  143. ; in PC Scheme
  144. ; call: (branch-and-bound 'o 'g)
  145.  
  146. (define branch-and-bound
  147.   (lambda (origin goal)
  148.     (bnb (list (list origin)) goal)))
  149.  
  150. (define bnb
  151.   (lambda (path goal)
  152.     (cond ((eq? path '()) '())
  153.           ((eq? goal (caar path)) (reverse (car path)))
  154.           (else (bnb (sort-path
  155.                        (append     ;sort by distance with
  156.                          (expand-node (car path))  ;shortest to front
  157.                          (cdr path)) shorter-path) goal)))))
  158.  
  159. (define how-long  ;length of path
  160.   (lambda (path)
  161.     (cond ((eq? (cdr path) '()) 0)
  162.           (else (+ (how-far (car path) (cadr path))
  163.                    (how-long (cdr path)))))))
  164.  
  165. (define shorter-path  ;test if shorter path is path1
  166. è  (lambda (path1 path2)  
  167.     (<? (how-long path1) (how-long path2))))
  168.  
  169. (define how-far  ;straightline distance using property list
  170.   (lambda (node1 node2)
  171.     (sqrt (+ (square (- (getprop node1 'x)
  172.                         (getprop node2 'x)))
  173.              (square (- (getprop node1 'y)
  174.                         (getprop node2 'y)))))))
  175.  
  176. (define (square x) (* x x))
  177.  
  178. (define (sort-path path by)
  179.   (sort! path by))
  180.  
  181. (define expand-node  ;get node's offspring using property list
  182.   (lambda (path)
  183.     (map (lambda (child) (cons child path))
  184.          (getprop (car path) 'children))))
  185. ; include property list from Listing 2
  186. ;end-of-branch-and-bound
  187.