Lisp in Small Parts

Map

In this project we'll write a Lisp program to find the shortest route between two places. This program illustrates an important problem that needs to be solved by every car navigation system, and on Web sites such as the AA Route Planner. This version will enable you to create your own personal route planner; for example, you could use it to find the quickest cycle routes around your home town.

Complete listing

Example

Our map program will store the map as a list of roads, where each road interconnects two locations. Here's the map we'll use to test the program:

For simplicity each location has a one-letter name, such as "A", but in an actual application they could be "Home" "School" "Swimming Pool", etc.

The numbers show the time, in minutes, to get along the road between each pair of locations, and our goal is to get from "A" to "Z" by the quickest route possible.

Entering the data

The map data will be stored in a global variable called map-data, which we define as:

(defparameter map-data nil)

(from to time road)

where from and to are the locations at each end of the road, time is the time to get between the locations, and road is the optional name of the road. For example:

("Home" "Swimming Pool" 6 "High St.")

Here's the procedure add-road to add a road to the database:

(defun add-road (from to time &optional road)
  (setq map-data 
        (cons (list from to time road)
              (cons (list to from time road)
                    map-data))))

CL-USER > (add-road "Home" "Swimming Pool" 6 "High St.")

(("Home" "Swimming Pool" 6 "High St.") ("Swimming Pool" "Home" 6 "High St."))

Maintaining a queue

Now that we can enter the map, how is the program going to find the shortest route? The technique is called an "ink-blot" or "breadth-first" search. It is like pouring ink into the centre of the starting city, and watching it spread out uniformly along the road network, colouring each location as it reaches it. The shortest route to the destination location will be the route taken by the river of ink to arrive first.

To do this we will keep a list of the roads the ink is flowing along, arranged so the location reached first gets processed next. An ordered list of this sort is called a priority queue. We will store it in the global variable map-queue:

(defparameter map-queue nil)

We will store the entries on the queue as:

(time location from)

where time is the total time taken from the starting point, location is the location reached by the ink blot, and from is the location we've come from.

Here's the procedure add-item to add an item to the queue, and return the new queue:

(defun add-item (item queue)
  (if (null queue) 
      (cons item queue)
    (if (< (first item) (first (first queue)))
        (cons item queue)
      (cons (first queue) (add-item item (rest queue))))))

For convenience we also have the following procedure add-to-queue that updates the variable map-queue with the new value:

(defun add-to-queue (time location via)
  (setf map-queue (add-item (list time location via) map-queue)))

For example, if we want to add the road

(3 "E" "F")

to the queue:

((2 "A" "B") (4 "C" "D"))

we do:

CL-USER 45 > (add-to-queue 3 "E" "F")
((2 "A" "B") (3 "E" "F") (4 "C" "D"))

Processing a new location

When the ink reaches a new location we want to add all the roads extending from that location to the queue. This is done by the routine add-roads, which adds all the roads leading from our current location to the queue:

(defun add-roads (location start)
  (dolist (item map-data)
    (let* ((from (first item))
           (to (second item))
           (time (third item)))
      (if (string= from location)
          (add-to-queue (+ start time) to location)))))

It works as follows:

For every entry in the map data:

• If the from item in the map data matches our current location, add the road to the queue, with the time added to our starting time.

Growing the search

We are now ready to write the main procedure for spreading the ink from the starting location until we reach the destination. We will return a list of all the locations encountered as the ink spreads, and the location we came from:

(defun grow-search (here to)
   (if (string= here to)
      nil
     (let* ((best (first map-queue))
            (from (second best)))
      (setf map-queue (rest map-queue))
      (add-roads from (first best))
      (cons (list from (third best)) (grow-search from to)))))

To see how grow-search works let's set up a very simple map:

Clear the map data:

CL-USER > (setq map-data nil)
NIL

CL-USER > (add-road "A" "B" 2)
(("A" "B" 2 NIL) ("B" "A" 2 NIL))

Add the road between B and C:

CL-USER > (add-road "B" "C" 1)
(("B" "C" 1 NIL) ("C" "B" 1 NIL) ("A" "B" 2 NIL) ("B" "A" 2 NIL))

Clear the map queue:

CL-USER > (setq map-queue nil)
NIL

Add the starting location to the queue with a starting time of 0:

CL-USER > (add-to-queue 0 "A" nil)
((0 "A" NIL))

Then grow the ink blot until we reach the destination "C":

CL-USER > (grow-search "A" "C")
(("A" NIL) ("B" "A") ("C" "B"))

The procedure grow-search returns a list of the locations visited, and in each case the location we came from.

To complete the project we need to create the actual route from this list of locations visited.

Listing the route

Here are the procedures to list the route. First find-in-list finds the first item in the visited list with the specified location:

(defun find-in-list (item list)
  (if (null list) nil
    (if (string= (first (first list)) item) (first list)
      (find-in-list item (rest list)))))

Then list-route calls this to find the route in the visited list:

(defun list-route (from to visited)
  (if (string= from to) (list from)
     (cons to (list-route from (second (find-in-list to visited)) visited))))

Finally find-route calls grow-search and list-route to find the shortest route on a map:

(defun find-route (from to)
  (setq map-queue nil)
  (add-to-queue 0 from nil)
  (reverse
   (list-route from to 
               (grow-search from to))))

Example

Let's try out the route map program to find the shortest route through the map at the beginning of this section. Here's a procedure to define the map:

(defun make-map ()
  (add-road "A" "B" 2)
  (add-road "B" "C" 3)
  (add-road "A" "D" 9)
  (add-road "B" "E" 3)
  (add-road "C" "F" 7)
  (add-road "D" "E" 3)
  (add-road "E" "F" 6)
  (add-road "D" "G" 2)
  (add-road "E" "H" 8)
  (add-road "F" "Z" 6)
  (add-road "G" "H" 2)
  (add-road "H" "Z" 4))

So we execute:

(setq map-data nil)

(make-map)

(find-route "A" "Z")

The answer comes back:

("A" "B" "E" "D" "G" "H" "Z")

If you investigate you'll find that this is indeed the shortest route from A to Z.