Programming Praxis

We represent graphs as lists of lists; each vertex has a list with the vertex name in the car and a list of adjacent vertices in its cdr. The seven-bridge problem that Euler solved is represented like this:

(define seven '(
  (a b b c)     ; north shore to west island twice and east island once
  (b a a c d d) ; west island to north shore twice, east island once, and south shore twice
  (c a b d)     ; east island to north shore once, west island once, and south shore once
  (d b b c)))   ; south shore to west island twice and east island once

Here are two other graphs: the five-bridge graph of the modern bridges of Königsberg (the two redundant bridges from the west island to the north and south shores no longer exist) and an outline of an envelope (a box with two diagonals and a triangular flap):

(define five '(
  (a b c)   ; north shore to west island and east island
  (b a c d) ; west island to north shore, east island and south shore
  (c a b d) ; east island to north shore, west island and south shore
  (d b c))) ; south shore to west island and east island

(define envelope '(
  (a b c)     ; top to top-left, top-right
  (b a c d e) ; top-left to top, top-right, center, bottom-left
  (c a b d f) ; top-right to top, top-left, center, bottom-right
  (d b c e f) ; center to top-left, top-right, bottom-left, bottom-right
  (e b d f)   ; bottom-left to top-left, center, bottom-right
  (f c d e))) ; bottom-right to top-right, center, bottom-left

The two tests for eulerian paths and circuits are simple enough; just count the number of vertices with odd degree and compare to Euler’s theorem:

(define (euler-path? g) ; is there an eulerian path through graph g
  (define (odd-len-cdr? xs) (if (odd? (length (cdr xs))) 1 0))
  (let ((odd-count (apply + (map odd-len-cdr? g))))
    (or (= odd-count 0) (= odd-count 2))))

(define (euler-circuit? g) ; is there an eulerian circuit through graph g
  (define (odd-len-cdr? xs) (if (odd? (length (cdr xs))) 1 0))
  (zero? (apply + (map odd-len-cdr? g))))

Here are some examples:

> (euler-path? seven)
#f
> (euler-path? five)
#t
> (euler-circuit? five)
#f
> (euler-path? envelope)
#t
> (euler-circuit? envelope)
#f

The function that implements the pathfinding program is quite simple, moving all its complexity to auxiliary functions. We’ll start with the end result, then show the helpers:

(define (euler-path g)
  (if (not (euler-path? g)) (error 'euler-path "impossible")
    (let loop ((curr (start g)) (edges (edges g)) (stack (list)) (path (list)))
      (let ((neigh (neighbor curr edges)))
        (cond ((and (null? stack) (not neigh)) (cons curr path))
              ((not neigh) (loop (car stack) edges (cdr stack) (cons curr path)))
              (else (loop neigh (remove-edge edges curr neigh) (cons curr stack) path)))))))

Notice the pun on edges: in (edges g) it’s a call to the function that converts a graph in adjacency-list form on vertices to a list of edges, but other uses of edges refer to the list of edges. Programming like this can lead to confusion, so it is best avoided, but in this case nothing bad happened.

The start function finds the starting point, which is either the first odd-degree vertex found in the list of vertices or the last vertex in the list if none of them were odd:

(define (start g)
  (cond ((null? g) (error 'start "empty graph"))
        ((even? (length (car g))) (caar g)) ; odd-degree vertex
        ((null? (cdr g)) (caar g)) ; even-degree vertex
        (else (start (cdr g)))))

We are using symbols to represent vertices, and we need a way to compare them; unfortunately, Scheme provides no direct way to do so:

(define (lt? a b) (string<? (symbol->string a) (symbol->string b)))

As mentioned above, the edges function converts the adjacent-vertex representation of a graph to a list of edges; we are careful to write edges in a canonical form with the vertices in alphabetical order, which is how we prevent duplicates:

(define (edges g)
  (let g-loop ((g g) (es (list)))
    (if (null? g) es
      (let v-loop ((v (caar g)) (vs (cdar g)) (es es))
        (if (null? vs) (g-loop (cdr g) es)
          (if (lt? v (car vs))
              (v-loop v (cdr vs) (cons (sort lt? (list v (car vs))) es))
              (v-loop v (cdr vs) es)))))))

To find a neighbor, just cdr through the list of edges, checking both vertices, until you find one:

(define (neighbor curr edges)
  (let loop ((edges edges))
    (cond ((null? edges) #f)
          ((equal? curr (caar edges)) (cadar edges))
          ((equal? curr (cadar edges)) (caar edges))
          (else (loop (cdr edges))))))

The last auxiliary removes an edge from the edge list:

(define (remove-edge edges curr neigh)
  (let ((edge (sort lt? (list curr neigh))))
    (let loop ((edges edges) (result (list)))
      (if (null? edges) result
        (if (equal? (car edges) edge)
            (append (cdr edges) result)
            (loop (cdr edges) (cons (car edges) result)))))))

Here are some examples:

> (euler-path five)
(b d c a b c)
> (euler-path envelope)
(e f d e b d c a b c f)

You can run the program at http://programmingpraxis.codepad.org/TE084ryW.

Pages: 1 2