(Code form Paradigms of AI Programming, ;copyright (c) 1991 Peter Norvig.) ;
Source code: ;source code. ;
Find a state that satisfies goal-p. Start with states, ; and search according to successors and combiner. ;You won't get this yet till you look at a few examples.
(defconstant fail nil)
(defun tree-search (states goal-p successors combiner)
(blab :search "~&;; Search: ~a" states)
(cond ((null states) fail)
((funcall goal-p (first states)) (first states))
(t (tree-search
(funcall combiner
(funcall successors (first states))
(rest states))
goal-p successors combiner))))
;
;Search new states first until goal is reached.
(defun depth-first-search (start goal-p successors) (tree-search (list start) ; initially, our states are just "start" goal-p ; a function to recognize "success" successors ; a generator of states next to current #'append ; dfs= explore new before old )) ;;
Sample scucessors function:
(defun binary-tree (x) (print x) (print (list (* 2 x) (+ 1 (* 2 x))))) ;This generates:
; 1 ; | ; 2..................3 ; | | ; 4.........5 6........7 ; | | | | ; 8,9 10,11 12,13 14,15 ;
Sample goalp function:
(defun is (value) #'(lambda (x) (eql x value))) ;
Low level detail:
(defun blab (what str data) (declare (ignore what)) (format t str data)) ;
Lets give it a try..
(defun demo-dfs () (depth-first-search 1 (is 12) #'binary-tree)) ;
But the results are bad...
;(demo-dfs) ; ;; Search: (1) ;; Search: (2 3) ;; Search: (4 5 3) ;; Search: (8 9 5 3) ;; Search: (16 17 9 5 3) ;; Search: (32 33 17 9 5 3) ;; Search: (64 65 33 17 9 5 3) ;; Search: (128 129 65 33 17 9 5 3) ;; Search: (256 257 129 65 33 17 9 5 3) ;; Search: (512 513 257 129 65 33 17 9 5 3) ;; Search: (1024 1025 513 257 129 65 33 17 9 5 3) ;;... ;;boom! ;
D'oh! We went off into the left most sub-tree and never found 12> ;
(defun prepend (x y) "Prepend y to start of x" (append y x)) (defun breadth-first-search (start goal-p successors) "Search old states first until goal is reached." (tree-search (list start) goal-p successors #'prepend)) ;
Lets give it a try..
(defun demo-bfs () (breadth-first-search 1 (is 12) #'binary-tree)) ;
And the results are better
;(demo-bfs) ; ;; Search: (1) ;; Search: (2 3) ;; Search: (3 4 5) ;; Search: (4 5 6 7) ;; Search: (5 6 7 8 9) ;; Search: (6 7 8 9 10 11) ;; Search: (7 8 9 10 11 12 13) ;; Search: (8 9 10 11 12 13 14 15) ;; Search: (9 10 11 12 13 14 15 16 17) ;; Search: (10 11 12 13 14 15 16 17 18 19) ;; Search: (11 12 13 14 15 16 17 18 19 20 21) ;; Search: (12 13 14 15 16 17 18 19 20 21 22 23) ;;
(defun finite-binary-tree (n)
"Return a successor function that generates a binary tree
with n nodes."
#'(lambda (x)
(remove-if #'(lambda (child)
(> (log child 2) ; depth of search
n))
(binary-tree x))))
(defun dfid-search (start goal-p successors max &optional (now 1))
(unless (> now max)
(blab :dfid "~&;; Extending leash to : ~a" now)
(or (depth-first-search start
goal-p
(funcall successors now))
(dfid-search start goal-p successors max (1+ now)))))
(defun demo-dfid (&optional (max 5))
(dfid-search 1 (is 12) #'finite-binary-tree max))
;And, the winner is... ;(demo-dfid 5) ; ;; Extending leash to : 1 ;; Search: (1) ;; Search: (2) ;; Search: NIL ;; Extending leash to : 2 ;; Search: (1) ;; Search: (2 3) ;; Search: (4 3) ;; Search: (3) ;; Search: NIL ;; Extending leash to : 3 ;; Search: (1) ;; Search: (2 3) ;; Search: (4 5 3) ;; Search: (8 5 3) ;; Search: (5 3) ;; Search: (3) ;; Search: (6 7) ;; Search: (7) ;; Search: NIL ;; Extending leash to : 4 ;; Search: (1) ;; Search: (2 3) ;; Search: (4 5 3) ;; Search: (8 9 5 3) ;; Search: (16 9 5 3) ;; Search: (9 5 3) ;; Search: (5 3) ;; Search: (10 11 3) ;; Search: (11 3) ;; Search: (3) ;; Search: (6 7) ;; Search: (12 13 7) ;;
Lets give out search knowledge of how close the ; current state is to the goal state. ;
(defun diff (num) "Return the function that finds the difference from num." #'(lambda (x) (abs (- x num)))) ;
Lets sort the states by their distance to the goal ;and explore them nearest to furthest.
(defun sorter (cost-fn)
"Return a combiner function that sorts according to cost-fn."
#'(lambda (new old)
(sort (append new old) #'< :key cost-fn)))
(defun best-first-search (start goal-p successors cost-fn)
"Search lowest cost states first until goal is reached."
(tree-search (list start) goal-p successors (sorter cost-fn)))
(defun demo-bestfs1 (&optional (goal 12))
(best-first-search 1 (is goal) #'binary-tree (diff goal)))
;And if we give it a go....
;(demo-bestfs2) ; ;; Search: (1) ;; Search: (3 2) ;; Search: (7 6 2) ;; Search: (14 15 6 2) ;; Search: (15 6 2 28 29) ;; Search: (6 2 28 29 30 31) ;; Search: (12 13 2 28 29 30 31) ;;
As before, but now lets give a big penalty for ;jumping over the goal.
(defun price-is-right (price)
"Return a function that measures the difference from price,
but gives a big penalty for going over price."
#'(lambda (x) (if (> x price)
most-positive-fixnum
(- price x))))
(defun demo-bestfs2 (&optional (goal 12))
(best-first-search 1 (is goal) #'binary-tree (price-is-right goal)))
;And this gives us...
;(demo-bestfs2) ; ;; Search: (1) ;; Search: (3 2) ;; Search: (7 6 2) ;; Search: (6 2 14 15) ;; Search: (12 2 13 14 15) ;;
Beam-search is the same as best-search but we "lower the beam" ;and chop off anything not in the top beam-width ;items in the sorted set of successor states.
(defun beam-search (start goal-p successors cost-fn beam-width)
"Search highest scoring states first until goal is reached,
but never consider more than beam-width states at a time."
(tree-search (list start) goal-p successors
#'(lambda (old new)
(let ((sorted (funcall (sorter cost-fn) old new)))
(if (> beam-width (length sorted))
sorted
(subseq sorted 0 beam-width))))))
;Here's some knowledge on cities.
(defstruct (city (:type list)) name long lat)
(defparameter *cities*
'((Atlanta 84.23 33.45) (Los-Angeles 118.15 34.03)
(Boston 71.05 42.21) (Memphis 90.03 35.09)
(Chicago 87.37 41.50) (New-York 73.58 40.47)
(Denver 105.00 39.45) (Oklahoma-City 97.28 35.26)
(Eugene 123.05 44.03) (Pittsburgh 79.57 40.27)
(Flagstaff 111.41 35.13) (Quebec 71.11 46.49)
(Grand-Jct 108.37 39.05) (Reno 119.49 39.30)
(Houston 105.00 34.00) (San-Francisco 122.26 37.47)
(Indianapolis 86.10 39.46) (Tampa 82.27 27.57)
(Jacksonville 81.40 30.22) (Victoria 123.21 48.25)
(Kansas-City 94.35 39.06) (Wilmington 77.57 34.14)))
(defun neighbors (city)
"Find all cities within 1000 kilometers."
(remove-if-not #'(lambda (c)
(and (not (eq c city))
(< (air-distance c city) 1000.0)))
*cities*))
(defun city (name)
"Find the city with this name."
(assoc name *cities*))
(defun trip (start dest)
"Search for a way from the start to dest."
(beam-search start (is dest) #'neighbors
#'(lambda (c) (air-distance c dest))
1))
;Here's some distance details.
(defconstant earth-diameter 12765.0
"Diameter of planet earth in kilometers.")
(defun air-distance (city1 city2)
"The great circle distance between two cities."
(let ((d (distance (xyz-coords city1) (xyz-coords city2))))
;; d is the straight-line chord between the two cities,
;; The length of the subtending arc is given by:
(* earth-diameter (asin (/ d 2)))))
(defun xyz-coords (city)
"Returns the x,y,z coordinates of a point on a sphere.
The center is (0 0 0) and the north pole is (0 0 1)."
(let ((psi (deg->radians (city-lat city)))
(phi (deg->radians (city-long city))))
(list (* (cos psi) (cos phi))
(* (cos psi) (sin phi))
(sin psi))))
(defun distance (point1 point2)
"The Euclidean distance between two points.
The points are coordinates in n-dimensional space."
(sqrt (reduce #'+ (mapcar #'(lambda (a b) (expt (- a b) 2))
point1 point2))))
(defun deg->radians (deg)
"Convert degrees and minutes to radians."
(* (+ (truncate deg) (* (rem deg 1) 100/60)) pi 1/180))
;And here's our driver:
(defun demo-trip () (format t "one way...~%") (trip (city 'san-francisco) (city 'boston)) (format t "~%~%and the other way...~%") (trip (city 'boston) (city 'san-francisco) )) ;
Lets drive this both ways...
;(demo-trip) ; ;one way... ;; Search: (#<Path to (SAN-FRANCISCO 122.26 37.47) cost 0.0>) ;; Search: (#<Path to (RENO 119.49 39.3) cost 4355.0>) ;; Search: (#<Path to (GRAND-JCT 108.37 39.05) cost 4427.3>) ;; Search: (#<Path to (DENVER 105.0 39.45) cost 4428.3>) ;; Search: (#<Path to (KANSAS-CITY 94.35 39.06) cost 4492.0>) ;; Search: (#<Path to (INDIANAPOLIS 86.1 39.46) cost 4507.1>) ;; Search: (#<Path to (PITTSBURGH 79.57 40.27) cost 4514.8>) ;; Search: (#<Path to (BOSTON 71.05 42.21) cost 4514.8>) ;(BOSTON 71.05 42.21) ; ;and the other way... ;; Search: (#<Path to (BOSTON 71.05 42.21) cost 0.0>) ;; Search: (#<Path to (PITTSBURGH 79.57 40.27) cost 4418.4>) ;; Search: (#<Path to (CHICAGO 87.37 41.5) cost 4423.7>) ;; Search: (#<Path to (KANSAS-CITY 94.35 39.06) cost 4520.0>) ;; Search: (#<Path to (DENVER 105.0 39.45) cost 4521.4>) ;; Search: (#<Path to (GRAND-JCT 108.37 39.05) cost 4527.0>) ;; Search: (#<Path to (RENO 119.49 39.3) cost 4577.3>) ;; Search: (#<Path to (SAN-FRANCISCO 122.26 37.47) cost 4577.3>) ;(SAN-FRANCISCO 122.26 37.47) ;
Say what? One way is ;longer than the other? Why? ;
The problem is that a local search made a sub-optimal decision. ; Instead ; of minimizing the distance to the destimation, ; we should ; minimize the sum of the ; distance to the destination ; plus the distance already traveled. ; Note: this will be the core the A-star algorithm that ; we will discuss later in the subject.