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è; in Scheme.  Individual LISP implementations
  56. ; vary in property list structure and
  57. ; operations.
  58. ; 
  59. (putprop 'O '(A C)    'children)
  60. (putprop 'A '(O C B)  'children)
  61. (putprop 'B '(A E G)  'children)
  62. (putprop 'C '(O A D E)'children)
  63. (putprop 'D '(E C)    'children)
  64. (putprop 'E '(C B D G)'children)
  65. (putprop 'G '(B E)    'children)
  66. (putprop 'o '20 'x)
  67. (putprop 'o '50 'y)
  68. (putprop 'a '55 'x)
  69. (putprop 'a '55 'y)
  70. (putprop 'b '70 'x)
  71. (putprop 'b '40 'y)
  72. (putprop 'c '20 'x)
  73. (putprop 'c '30 'y)
  74. (putprop 'd '25 'x)
  75. (putprop 'd '10 'y)
  76. (putprop 'e '45 'x)
  77. (putprop 'e '45 'y)
  78. (putprop 'g '65 'x)
  79. (putprop 'g '20 'y)
  80. ; end-of-property-list
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88. Aieye Listing 3
  89.  
  90.  
  91.  
  92. ; best-first search
  93. ; in PC Scheme
  94. ; call: (best-first 'o 'g)
  95.  
  96. (define best-first
  97.   (lambda (origin goal)
  98.     (best (list (list origin)) goal)))
  99.  
  100. (define best
  101.   (lambda (path goal)
  102.     (cond ((eq? path '()) '())
  103.           ((eq? goal (caar path)) (reverse (car path)))
  104.           (else (best (sort-path  ;sort path by distance to goal
  105.                         (append (expand-node (car path))
  106.                                 (cdr path))
  107.                         (lambda (path1 path2)
  108.                           (nearest? path1 path2 goal))) goal)))))
  109. è(define how-far  ;straightline distance using property list
  110.   (lambda (node1 node2)
  111.     (sqrt (+ (square (- (getprop node1 'x)
  112.                         (getprop node2 'x)))
  113.              (square (- (getprop node1 'y)
  114.                         (getprop node2 'y)))))))
  115.  
  116. (define (square x) (* x x))
  117.  
  118. (define nearest?   ;test for least distance to goal
  119.   (lambda (path1 path2 goal)
  120.     (<? (how-far (car path1) goal)
  121.         (how-far (car path2) goal))))
  122.  
  123. (define (sort-path path by)
  124.   (sort! path by))
  125.  
  126. (define expand-node ;get node's offspring using property list
  127.   (lambda (path)
  128.     (map (lambda (child) (cons child path))
  129.          (getprop (car path) 'children))))
  130.  
  131. ;include property list from Listing 2
  132. ;end-of-best-first
  133.  
  134.  
  135.  
  136. Aieye Listing 4
  137.  
  138.  
  139.  
  140. ; branch-and-bound search
  141. ; in PC Scheme
  142. ; call: (branch-and-bound 'o 'g)
  143.  
  144. (define branch-and-bound
  145.   (lambda (origin goal)
  146.     (bnb (list (list origin)) goal)))
  147.  
  148. (define bnb
  149.   (lambda (path goal)
  150.     (cond ((eq? path '()) '())
  151.           ((eq? goal (caar path)) (reverse (car path)))
  152.           (else (bnb (sort-path
  153.                        (append     ;sort by distance with
  154.                          (expand-node (car path))  ;shortest to front
  155.                          (cdr path)) shorter-path) goal)))))
  156.  
  157. (define how-long  ;length of path
  158.   (lambda (path)
  159.     (cond ((eq? (cdr path) '()) 0)
  160.           (else (+ (how-far (car path) (cadr path))
  161.                    (how-long (cdr path)))))))
  162.  
  163. (define shorter-path  ;test if shorter path is path1è  (lambda (path1 path2)  
  164.     (<? (how-long path1) (how-long path2))))
  165.  
  166. (define how-far  ;straightline distance using property list
  167.   (lambda (node1 node2)
  168.     (sqrt (+ (square (- (getprop node1 'x)
  169.                         (getprop node2 'x)))
  170.              (square (- (getprop node1 'y)
  171.                         (getprop node2 'y)))))))
  172.  
  173. (define (square x) (* x x))
  174.  
  175. (define (sort-path path by)
  176.   (sort! path by))
  177.  
  178. (define expand-node  ;get node's offspring using property list
  179.   (lambda (path)
  180.     (map (lambda (child) (cons child path))
  181.          (getprop (car path) 'children))))
  182. ; include property list from Listing 2
  183. ;end-of-branch-and-bound
  184.