[ << ] [ < ] [ Up ] [ > ] [ >> ]         [Top] [Contents] [Index] [ ? ]

2.5 Basic Search Code

(Code from Paradigms of AI Programming, copyright (c) 1991 Peter Norvig.)

Download source code: here.

Basic Tree Search

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))))

Example1: Depth-First Search

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>

Example2: Breadth-first search

(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)

Constrained Tree Search

Example3: Depth-first-iterative deepenning

(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)

Guided Tree Search

Example 4: Best-First Search

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)

Example 5: Best-Search (again)

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)

Example 6: Beam-Search

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.


[ << ] [ < ] [ Up ] [ > ] [ >> ]         [Top] [Contents] [Index] [ ? ]

This document was generated on March 1, 2011 using texi2html 5.0.