Greedy and MinSpanTree based traveling salesman approximations

tsp.rkt

#lang racket

(require graph plot)

(define (distance a b)
  (sqrt (for/sum ([a a] [b b])
          (expt (- a b) 2))))

(define (every-edge l)
  (if (null? l)
      '()
      (append (map (lambda (v) (list (car l) v)) (cdr l))
              (every-edge (cdr l)))))

(define (greedy-tsp data #:start [start #f])
  (if (null? data)
      '()
      (if start
          (let ([next (car (sort data <
                                 #:key (lambda (p) (distance start p))
                                 #:cache-keys? #t))])
            (cons next (greedy-tsp (filter (lambda (v) (not (equal? v next))) data)
                                   #:start next)))
          (cons (car data) (greedy-tsp (cdr data) #:start (car data))))))

(define (tsp data)
  (define g
    (weighted-graph/undirected
     (map
      (lambda (e)
        (cons (distance (car e) (cadr e)) e))
      (every-edge data))))

  (define mst (time (unweighted-graph/undirected (mst-prim g (car data)))))

  (let-values (([discovery pred finish]
                (dfs mst)))
    (sort (hash-keys discovery) <
          #:key (lambda (k) (hash-ref discovery k)))))

(define data (build-list 500 (lambda (x) (vector (random) (random)))))

(define (path-length p)
  (for/sum ([a p]
            [b (cdr p)])
    (distance a b)))

(plot (list (points data)
            (lines (tsp data))))
(time (printf "mst->tsp: ~a~n" (path-length (tsp data))))

(plot (list (points data)
            (lines (greedy-tsp data))))
(time (printf "greedy: ~a~n" (path-length (greedy-tsp data))))