r7rs.scm

(import (scheme base)
        (scheme write))

;; graph lib

(define-record-type <edge>
  (edge x y z)
  edge?
  (x from from-set!)
  (y to to-set!)
  (z cost cost-set!))

(define N 6)
(define graph (make-vector N '()))

(define (add-edge x y z)
  (vector-set! graph x
               (cons (edge x y z) (vector-ref graph x)))
  (vector-set! graph y
               (cons (edge y x z) (vector-ref graph y)))
  'done)

(define (edges-from x) (vector-ref graph x))

; this graph on http://ja.wikipedia.org/wiki/ダイクストラ法
(add-edge 0 1 7)
(add-edge 0 2 9)
(add-edge 0 5 14)
(add-edge 1 2 10)
(add-edge 1 3 15)
(add-edge 2 5 2)
(add-edge 2 3 11)
(add-edge 3 4 6)
(add-edge 4 5 9)

;; queue lib

(define queue '())
(define (q-push! x)
  (let ((ls (list x)))
    (if (null? queue)
      (set! queue (cons ls ls))
      (begin
        (set-cdr! (cdr queue) ls)
        (set-cdr! queue ls)))))
(define (q-pop!)
  (let ((ret (caar queue)))
    (set-car! queue (cdar queue))
    (if (null? (car queue)) (set! queue '()))
    ret))

(define (q-empty?) (null? queue))

;; Dijkstra

(define (Dijkstra)

  (define start 0) ; start vertex

  (define INF 1e20)
  (define memo (make-vector N INF))
  (vector-set! memo start 0)

  (call/cc (lambda (return)
    (q-push! start)
    (let loop ()
      (if (q-empty?) (return memo))
      (let* ((v (q-pop!))
             (es (edges-from v)))
        (for-each (lambda (e)
          (let ((u (to e)))
            (if (> (vector-ref memo u) (+ (vector-ref memo v) (cost e)))
              (begin
                (vector-set! memo u (+ (vector-ref memo v) (cost e)))
                (q-push! u) ))))
          es))
      (loop))))
  )

(display (Dijkstra)) (newline)