; traveling salesman: brute force

(define (sum xs) (apply + xs))

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(define rand
  (let* ((a 3141592653) (c 2718281829)
         (m (expt 2 35)) (x 5772156649)
         (next (lambda ()
                 (let ((x-prime (modulo (+ (* a x) c) m)))
                   (set! x x-prime) x-prime)))
         (k 103)
         (v (list->vector (reverse
              (let loop ((i k) (vs (list x)))
                (if (= i 1) vs
                  (loop (- i 1) (cons (next) vs)))))))
         (y (next))
         (init (lambda (s)
                 (set! x s) (vector-set! v 0 x)
                 (do ((i 1 (+ i 1))) ((= i k))
                   (vector-set! v i (next))))))
    (lambda seed
      (cond ((null? seed)
              (let* ((j (quotient (* k y) m))
                     (q (vector-ref v j)))
                (set! y q)
                (vector-set! v j (next)) (/ y m)))
            ((eq? (car seed) 'get) (list a c m x y k v))
            ((eq? (car seed) 'set)
              (let ((state (cadr seed)))
                (set! a (list-ref state 0))
                (set! c (list-ref state 1))
                (set! m (list-ref state 2))
                (set! x (list-ref state 3))
                (set! y (list-ref state 4))
                (set! k (list-ref state 5))
                (set! v (list-ref state 6))))
            (else (init (modulo (numerator
                    (inexact->exact (car seed))) m))
                  (rand))))))

(define (randint . args)
  (cond ((null? (cdr args))
          (floor (* (rand) (car args))))
        ((< (car args) (cadr args))
          (+ (floor (* (rand) (- (cadr args) (car args)))) (car args)))
        (else (+ (ceiling (* (rand) (- (cadr args) (car args)))) (car args)))))

(define (fact n) (apply * (range n 0)))

(define (next-perm lt? zs)
  (if (null? zs) zs
    (let next ((xlist (list (car zs))) (ys (cdr zs)))
      (cond ((null? ys) (reverse zs))
            ((not (lt? (car ys) (car xlist)))
              (next (cons (car ys) xlist) (cdr ys)))
            (else
              (letrec ((swap
                        (lambda (xs)
                          (cond ((null? (cdr xs))
                                  (cons (car ys) (cons (car xs) (cdr ys))))
                                ((lt? (car ys) (cadr xs))
                                  (cons (car xs) (swap (cdr xs))))
                                (else (append (cons (car ys) (cons (cadr xs) (cddr xs)))
                                              (cons (car xs) (cdr ys))))))))
                (swap xlist)))))))

(define (make-tsp n)
  (let loop ((n n) (xs '()))
    (if (zero? n) (list->vector xs)
      (let ((x (cons (randint (* n 10)) (randint (* n 10)))))
        (if (member x xs) (loop n xs)
          (loop (- n 1) (cons x xs)))))))

(define (dist points a b)
  (define (point k) (vector-ref points k))
  (define (square x) (* x x))
  (sqrt (+ (square (- (car (point a)) (car (point b))))
           (square (- (cdr (point a)) (cdr (point b)))))))

(define (cost points tour)
  (if (or (null? tour) (null? (cdr tour))) 0
    (let ((start (car tour)))
      (let loop ((tour tour) (sum 0))
        (if (null? (cdr tour))
            (+ sum (dist points (car tour) start))
            (loop (cdr tour) (+ sum (dist points (car tour) (cadr tour)))))))))

(define (tsp ps)
  (let* ((len (vector-length ps))
         (k (fact len))
         (t (reverse (range len))))
    (let loop ((k k) (t t) (min-t '()) (min-c #f))
      (if (zero? k) min-t
        (let ((c (cost ps t)))
          (if (or (not min-c) (< c min-c))
              (loop (- k 1) (next-perm < t) t c)
              (loop (- k 1) (next-perm < t) min-t min-c)))))))

(define p (make-tsp 8))
(display p) (newline)
(display (tsp p)) (newline)

#((5 . 2) (19 . 13) (4 . 8) (6 . 32) (23 . 7) (57 . 54) (55 . 8) (70 . 59))
(3 2 0 1 4 6 7 5)