Simple Network Search in Scheme

../img/winston-horn-network.png

I’ve been having fun translating some of the code in Winston and Horn’s Lisp into Scheme. This book is amazing – clearly written, with lots of motivating examples and applications. As SICP is to language implementation, Lisp is to application development, with chapters covering constraint propagation, forward and backward chaining, simulation, object-oriented programming, and so on. And it does include the obligatory Lisp interpreter in one chapter, if you’re into that sort of thing.

In this installment, based on Chapter 19, we will look at some simple strategies for searching for a path between two nodes on a network (a graph). The network we’ll be using is shown in the diagram above.

Here’s the same network, represented as an alist where each CAR:CDR pair represents a NODE:NEIGHBORS relationship:

'((f e)
  (e b d f)
  (d s a e)
  (c b)
  (b a c e)
  (a s b d)
  (s a d))

The high-level strategy the authors use is to traverse the network, building up a list of partial paths. If a partial path ever reaches the point where it describes a full path between the two network nodes we’re after, we’ve been successful.

As with trees, we can do either a breadth-first or depth-first traversal. Here’s what the intermediate partial paths will look like for a breadth-first traversal that builds a path between nodes S and F:

(s)
(s a)
(s d)
(s a b)
(s a d)
(s d a)
(s d e)
(s a b c)
(s a b e)
(s a d e)
(s d a b)
(s d e b)
'(s d e f)

Based on that output, we can deduce that every time we visit a node, we want to extend our partial paths list with that node. Here’s one option – its only problem is that it will happily build circular paths that keep us from ever finding the node we want:

(define (%buggy-extend path)             ;builds circular paths
  (map (lambda (new-node) 
         (cons new-node path))
       (%get-neighbor (first path))))

(Incidentally, I’ve become fond of the convention whereby internal procedures that aren’t part of a public-facing API are prefixed with the `%’ character. This can be found in some parts of the MIT Scheme sources, and I believe it’s used in Racket as well. I’ve started writing lots of my procedures using this notation to remind me that the code I’m writing is not the real `API’, that the design will need more work, and that the current code is just a first draft. I’m using that convention here.)

Here’s a better version that checks if we’ve already visited the node before adding it to the partial paths list – as a debugging aid it prints out the current path before extending it:

(define (%extend path)
  (display (reverse path))
  (newline)
  (map (lambda (new-node)
         (cons new-node path))
       (filter (lambda (neighbor)
                 (not (member neighbor path)))
               (%get-neighbor (first path)))))

You may have noticed the %GET-NEIGHBOR procedure; it’s just part of some silly data structure bookkeeping code. Please feel free to deride me in the comments for my use of a global variable. What can I say? I’m Scheming like it’s 1988 over here! Here’s the boilerplate:

(define *neighbors* '())

(define (%add-neighbor! k v)
  (let ((new-neighbor (cons k v)))
    (set! *neighbors*
          (cons new-neighbor *neighbors*))))

(define (%get-neighbor k)
  (let ((val (assoc k *neighbors*)))
    (if val
        (cdr val)
        '())))

(%add-neighbor! 's '(a d))
(%add-neighbor! 'a '(s b d))
(%add-neighbor! 'b '(a c e))
(%add-neighbor! 'c '(b))
(%add-neighbor! 'd '(s a e))
(%add-neighbor! 'e '(b d f))
(%add-neighbor! 'f '(e))

Now that we have our data structure and a way to extend our partial path list (non-circularly), we can write the main search procedure, %BREADTH-FIRST. The authors have a lovely way of explaining its operation:

BREADTH-FIRST is said to do a “breadth-first” search because it extends all partial paths out to uniform length before extending any to a greater length.

Here’s the code, translated to use a more Schemely, iterative named LET instead of the linear-recursive definition from the book 1:

(define (%breadth-first start finish network)
  (let ((queue (list (list start))))
    (let loop ((start start)
               (finish finish)
               (network network)
               (queue queue))
      (cond ((null? queue) '())                    ;Queue empty?
            ((equal? finish (first (first queue))) ;Finish found?
             (reverse (first queue)))              ;Return path.
            (else
             (loop start
                   finish               ;Try again.
                   network
                   (append
                    (rest queue)
                    (extend (first queue))))))))) ;New paths in front.

(A better way to write this procedure would be to implement a generic internal search procedure that takes its `breadthiness’ or `depthiness’ as a parameter. We could then wrap it with nicer public-facing search procedures specific names.)

Meanwhile, back at the REPL… we remind ourselves of what *neighbors* actually looks like, and then we search for a path between the nodes S and F.

> *neighbors*
'((f e) (e b d f) (d s a e) (c b) (b a c e) (a s b d) (s a d))
> (%breadth-first 's 'f *neighbors*)
(s)
(s a)
(s d)
(s a b)
(s a d)
(s d a)
(s d e)
(s a b c)
(s a b e)
(s a d e)
(s d a b)
(s d e b)
'(s d e f)

What fun! I can almost imagine using a three-dimensional variant of these searches for a space wargame with wormhole travel! Except, you know, they’d need to be much faster and more skillfully implemented. There’s also the tiny requirement to write the surrounding game…

Footnotes:

1 It shouldn’t need to be said, but: Of course the authors knew better; they were trying to hide that unnecessary complexity from the reader until later.

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s