CommonLispでダイクストラ法を解く

GWの前半は「プログラミングコンテストチャレンジブック」に捧げたのでその時の知見をブログにまとめていこうと思う。(4記事目)


問題文:

以下のグラフの最短経路を求めよ.

dykstra.jpg


ダイクストラ法を CommonLisp で実装するとこうなる:

(defparameter *max-integer* 100000)
(defparameter *vertexes* `(A B C D E F G))

(defparameter *nodes* '((A (B 2) (C 5))
                           (B (A 2) (C 4) (D 6) (E 10))
                           (C (A 5) (B 4) (D 2))
                           (D (B 6) (C 2) (F 1))
                           (E (B 10) (F 3) (G 5))
                           (F (D 1) (E 3) (G 9))
                           (G (E 5) (F 9))))

(defparameter *cost* `((A ,*max-integer*)
                          (B ,*max-integer*)
                          (C ,*max-integer*)
                          (D ,*max-integer*)
                          (E ,*max-integer*)
                          (F ,*max-integer*)
                          (G ,*max-integer*)))

(defparameter *used* `((A nil) (B nil) (C nil) (D nil) (E nil) (F nil) (G nil)))

(defmacro get-vertex-cost (vertex)
    "return: integer, test: (get-vertex-cost 'A)"
    `(cadr (assoc ,vertex *cost*)))

(defmacro set-vertex-cost (vertex cost)
    "return: nil, test: (set-vertex-cost 'A 100)"
    `(setf (get-vertex-cost ,vertex) ,cost))

(defmacro is-unuse-vertex (vertex)
    "return: boolean, test: (is-unuse-vertex 'A)"
    `(cadr (assoc ,vertex *used*)))

(defmacro set-used-vertex (vertex)
    "return: boolean, test: (set-used-vertex 'A)"
    `(setf (cadr (assoc ,vertex *used*)) t))

(defmacro get-unuse-vertexes ()
    "return: `(C D E F), test: (get-unuse-vertexes)"
    `(mapcar #'(lambda (v) (car v))
         (remove-if #'(lambda (v) (cadr v)) *used*)))

(defmacro get-min-cost-unuse-vertex ()
    "return: (NIL 100), test: (get-min-cost-unuse-vertex)"
    `(reduce #'(lambda (accum v)
                   (cond ((<= (cadr accum) (get-vertex-cost v)) accum)
                       (t (assoc v *cost*))))
         (get-unuse-vertexes)
         :initial-value `(nil ,*max-integer*)))

(defmacro get-distinct-between-nodes (now-vertex new-vertex)
    "return: Integer, test: (get-distinct-between-nodes)"
    `(let ((tmp (cadr (assoc ,new-vertex (cdr (assoc ,now-vertex *nodes*))))))
         (if tmp tmp ,*max-integer*)))

(defmacro is-all-used ()
    "return: boolean, test: (is-all-used)"
    `(reduce #'(lambda (accum v)
                   (and accum (is-unuse-vertex v)))
         *vertexes*
         :initial-value t))

(defun calc ()
    (if (not (is-all-used))
        (let ((min-cost (get-min-cost-unuse-vertex)))
            (set-used-vertex (car min-cost))
            (mapcar #'(lambda (v)
                          (set-vertex-cost v
                              (min (get-vertex-cost v)
                                  (+ (get-vertex-cost (car min-cost))
                                      (get-distinct-between-nodes v (car min-cost))))))
                *vertexes*)
            (calc))))

(defun solve ()
    (let ((first-vertex 'A)
             (last-vertex 'G))
        (set-vertex-cost first-vertex 0)
        (calc)
        (print (get-vertex-cost last-vertex))))

CommonLispでグラフを扱うの楽すぎて感動する.