Traveling Salesman: Minimum Spanning Tree

April 13, 2010

We represent the problem slightly differently than we have in the past; the input to the tsp function is a list of three-slot lists with the vertex name (a number from 0 to n-1) in the first slot, the x-coordinate in the second slot, and the y-coordinate in the third slot. Our make-tsp returns a random traveling salesman problem and fixes a bug in the earlier versions:

(define (make-tsp n)
  (let loop ((k n) (zs '()))
    (if (zero? k) zs
      (let ((z (list (- k 1) (randint (* n 10)) (randint (* n 10)))))
        (if (member (cdr z) (map cdr zs)) (loop k zs)
          (loop (- k 1) (cons z zs)))))))

Dist computes the euclidean distance between two points:

(define (dist a b)
  (define (square x) (* x x))
  (sqrt (+ (square (- (cadr a) (cadr b)))
           (square (- (caddr a) (caddr b))))))

Make-vertices extracts a list of vertices from a list of points; its implementation is trivial. Make-edges uses a list comprehension to form the list of edges that connect all the points to each other:

(define (make-vertices ps) (map car ps))

(define (make-edges ps)
  (list-of (list (dist a b) (car a) (car b))
    (a in ps) (b in ps) (< (car a) (car b))))

We’re ready now to compute the traveling salesman tour. We use Kruskal’s algorithm to compute the minimum spanning tree; Prim’s algorithm would work equally well. The basic algorithm is depth-first search starting from vertex 0:

(define (tsp ps)
  (let loop ((es (map cdr (kruskal (make-vertices ps) (make-edges ps))))
             (vs (list 0)) (zs (list 0)))
    (cond ((null? es) zs)
          ((find (car vs) es) =>
            (lambda (edge)
              (let ((v (if (equal? (car vs) (car edge)) (cadr edge) (car edge))))
                (loop (remove edge es) (cons v vs) (cons v zs)))))
          (else (loop es (cdr vs) zs)))))

Here, es is the list of edges that form the minimum spanning tree; an edge is removed when it is added to the tour. Vs is the stack of vertices that we accumulate as we move down the depth-first search, and zs is the list of vertices that form the tour. The find function returns the next edge in the depth-first search, or #f if the current vertex has no unvisited children:

(define (find x xs)
  (cond ((null? xs) #f)
        ((or (equal? x (caar xs)) (equal? x (cadar xs))) (car xs))
        (else (find x (cdr xs)))))

Here’s an example:

> (define ps '((0 88 24) (1 11 92) (2 58 26)
    (3 99 69) (4 14 28) (5 15 81) (6 47 15)
    (7 96 90) (8 78 11) (9 88 74)))
> (tsp ps)
(1 5 4 6 2 8 7 9 3 0)

We stole a lot of code to write this program. Random numbers, hash tables, list comprehensions and sorting come from the Standard Prelude, as do the remove and identity functions. We also used Kruskal’s algorithm, which in turn calls disjoint sets. You can run the assembled code at

Pages: 1 2

Leave a Reply

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

You are commenting using your 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 )

Connecting to %s

%d bloggers like this: