fixedpoint.jp


Dijkstra's algorithm (2007-02-22)

Wikipedia の Dijkstra's algorithm の説明にある pseudocode から、リストで表現されたグラフの中の2つの頂点を結ぶ最短経路の1つを探すコードを書きました。繰り返しがネストしている部分をもっとシンプルにできるのではないかと考えています。また、副作用をうまく使うことでより速く処理するよう改善できると思います。

以下のコードには 2007/02/24 で修正されている不具合があります。
;; graph    ::= (<edge> ...)
;; edge     ::= (<vertex> . <vertex>) ; directed

(use srfi-1)
(use gauche.sequence)

(define (vertices-of graph)
  (fold
   (lambda (e temp)
     (let ((u (car e))
           (v (cdr e)))
       (if (memq u temp)
           (if (memq v temp)
               temp
               (cons v temp))
           (if (memq v temp)
               (cons u temp)
               (list* u v temp)))))
   '()
   graph))

(define (dijkstra graph weight s)
  (let lp0 ((dst `((,s . 0)))
            (prv '())
            (vst '())
            (ust (vertices-of graph)))
    (let ((udst (filter (lambda (x) (memq (car x) ust)) dst)))
      (if (null? udst)
          (values dst prv)
          (let ((u-and-d (car (sort udst (lambda (x y) (< (cdr x) (cdr y)))))))
            (let ((u (car u-and-d))
                  (d (cdr u-and-d)))
              (let lp1 ((out (map cdr (filter (lambda (e) (eq? u (car e))) graph)))
                        (dst dst)
                        (prv prv))
                (if (null? out)
                    (lp0 dst prv (cons u vst) (delete u ust eq?))
                    (let* ((v (car out))
                           (d+w (+ d (weight u v))))
                      (let lp2 ((rest dst)
                                (temp '()))
                        (if (null? rest)
                            (lp1 (cdr out) (cons (cons v d+w) dst) (cons (cons v u) prv))
                            (let ((v-and-d (car rest)))
                              (if (eq? v (car v-and-d))
                                  (if (< d+w (cdr v-and-d))
                                      (lp1 (cdr ouy)
                                           (append temp (cons v d+w) (cdr rest))
                                           (cons (cons v u) (remove (lambda (e) (eq? v (car e))) prv)))
                                      (lp1 (cdr out) dst prv))
                                  (lp2 (cdr rest) (cons v-and-d temp)))))))))))))))

(define (shortest-path graph weight x y)
  (receive (dst prv)
      (dijkstra graph weight x)
    (let lp ((u y)
             (s '()))
      (cond ((assq u prv) => (lambda (p) (lp (cdr p) (cons u s))))
            (else s)))))

;;; example
; (define graph '((a . b) (a . c) (a . d) (a . e) (d . f) (e . f) (f . g) (e . g) (b . g) (c . g)))
; (define (weight x y)
;   (case x
;   ((a) 1)
;   ((b) 7)
;   ((c) 6)
;   ((d) 4)
;   ((e) (case y ((f) 3) ((g) 4)))
;   ((f) 1)))
; (dijkstra graph weight 'a)
; (shortest-path graph weight 'a 'f)

注意


© 2006-2023 fixedpoint.jp