1. この記事で学べること・学べないこと

学べること

ダイクストラ法についてのおぼろげな概要。
Lisp による実装の例。
リファクタリングして遊べる。

学べないこと

Lisp の美しいコード。
Lisp の崇高なる理念。
ダイクストラ法の良い例。

2. 実際のコード

以前，括弧の山と戦ってみた：ダイクストラ法って何だよ，分かんねぇよ。という記事を書いたが，とうとうわかったのでコードを掲載。多分分かっている人からすれば余りに冗長なコードなのかもしれないけれど，とにかくわかって嬉しいので載せる。

dijkstra.lisp

(defparameter *nodes* '(tokyo takasaki nagano nagoya niigata hukui kyoto))
(defparameter *edges* '((tokyo takasaki 110) (takasaki tokyo 110) (tokyo nagano 230) (nagano tokyo 230) (tokyo nagoya 350) (nagoya tokyo 350) (takasaki nagano 130) (nagano takasaki 130) (nagano nagoya 280) (nagoya nagano 280) (takasaki niigata 210) (niigata takasaki 210) (nagano hukui 330) (hukui nagano 330) (nagoya kyoto 160) (kyoto nagoya 160) (niigata hukui 250) (hukui niigata 250) (hukui kyoto 190) (kyoto hukui 190)))

; Node is not nil and is a symbol.
; ex. 'tokyo
(defun nodep (obj)
  (and obj (symbolp obj)))

; Edge is a list composed of two nodes and a number.
; ex. '(tokyo takasaki 110)
(defun edgep (seq)
  (and (listp seq)
       (eq (length seq) 3)
       (nodep   (first  seq))
       (nodep   (second seq))
       (numberp (third  seq))))

; Tree is a nested edge list.
; ex. '(tokyo (takasaki nagano 130) 110)
(defun treep (seq)
  (when (and seq
             (listp seq)
             (symbolp (first  seq))
             (numberp (third  seq)))
    (if (listp (second seq))
      (treep (second seq))
      t)))

; Return edges from a given node.
(defun edges-from (node edges)
  (labels ((start-with-p (edge)
                         (eq (car edge) node)))
    (when (listp edges)
      (remove-if-not #'start-with-p edges))))

; '(tokyo takasaki 110) given, 
; return ((TOKYO (TAKASAKI TOKYO 110) 110)
;         (TOKYO (TAKASAKI NAGANO 130) 110)
;         (TOKYO (TAKASAKI NIIGATA 210) 110)).
(defun edge-trees (seq)
  (let ((head (car seq)) (tail (cdr seq)))
    (cond ((edgep seq) (mapcar (lambda (tree)
                                 (list head tree (cadr tail)))
                               (edges-from (car tail) *edges*)))
          ((treep seq) (mapcar (lambda (edge)
                                 (list head edge (cadr tail)))
                               (edge-trees (car tail)))))))

; '(tokyo takasaki 110) given, return 110.
; '(tokyo (takasaki (niigata hukui 250) 210) 110) given, return 570.
(defun tree-length (seq &optional (len 0))
  (cond ((edgep seq) (+ (caddr seq) len))
        ((treep seq) (tree-length (cadr seq) (+ (caddr seq) len)))))

; Return the shortest edge from edge list.
(defun shortest-edge (edges &optional shortest)
  (when (not shortest)
    (setf shortest (car edges)))
  (let ((head (car edges)) (tail (cdr edges)))
    (if edges
      (if (< (tree-length head) (tree-length shortest))
        (shortest-edge tail head)
        (shortest-edge tail shortest))
      shortest)))

; '(tokyo (takasaki nagano 130) 110) given,
; return NAGANO.
(defun get-end-node (obj)
  (cond ((nodep obj) obj)
        ((edgep obj) (cadr obj))
        ((treep obj) (get-end-node (cadr obj)))))

; '(tokyo (tokyo takasaki 110) (tokyo (takasaki nagoya 130) 110)) given,
; return (TOKYO TAKASAKI NAGOYA).
(defun get-end-node-list (seq)
  (cond ((nodep seq) seq)
        ((listp seq) (let ((head (car seq)) (tail (cdr seq)))
                       (cond ((nodep head) (cons head (get-end-node-list tail)))
                             ((or (edgep head)
                                  (treep head))
                              (cons (get-end-node head) (get-end-node-list tail))))))))

; '(tokyo takasaki 110) 'takasaki given, return true.
; '(tokyo (takasaki nagano 130) 110) 'takasaki given, return nil.
(defun end-with-nodep (edge-or-tree node)
  (eq (get-end-node edge-or-tree) node))

; '((tokyo takasaki 110) (nagano tokyo 230) tokyo) 'tokyo given,
; return ((nagano tokyo 230) tokyo).
(defun find-edges-end-with-node (edges node)
  (let ((head (car edges)) (tail (cdr edges)))
    (when head
      (if (end-with-nodep head node)
        (cons head (find-edges-end-with-node tail node))
        (find-edges-end-with-node tail node)))))

(defun find-edges-end-with-nodes (edges nodes)
  (cond ((nodep nodes) (find-edges-end-with-node edges nodes))
        ((consp nodes) (let ((head (car nodes)) (tail (cdr nodes)))
                         (append (find-edges-end-with-node edges head)
                                 (find-edges-end-with-nodes edges tail))))))

(defun equal-if-sorted (list-a list-b)
  (equal (sort list-a #'string<) (sort list-b #'string<)))

(defun find-probable-paths (seq edges)
  (cond ((nodep seq) (edges-from seq edges))
        ((listp seq)
         (let ((head (car seq)) (tail (cdr seq)))
           (cond ((nodep head) (edges-from head edges))
                 ((or (edgep head)
                      (treep head))
                  (append (edge-trees head) (find-probable-paths tail edges))))))))

(defun remove-end-with-established-nodes (probable-paths paths)
  (let ((end-node-list (get-end-node-list paths)))
    (remove-if-included probable-paths (find-edges-end-with-nodes probable-paths end-node-list))))

; Remove items of a-list if they are included in b-list.
(defun remove-if-included (a b)
  (let ((head (car a)) (tail (cdr a)))
    (when a
      (if (member head b :test #'equal)
        (remove-if-included tail b)
        (cons head (remove-if-included tail b))))))

(defun remove-improbable-paths (probable-paths paths)
  (remove-if-included (remove-end-with-established-nodes probable-paths paths) paths))

(defun establish-path (paths edges)
  (shortest-edge (remove-improbable-paths (find-probable-paths paths edges) paths)))

(defun all-searchedp (established-paths nodes)
  (equal-if-sorted (remove-duplicates (get-end-node-list established-paths)) nodes))

(defun dijkstra (paths nodes edges)
  (when (nodep paths)
    (setf paths (list paths)))
  (let* ((established-path (establish-path paths edges))
         (established-paths (cons established-path paths)))
    (if (all-searchedp established-paths nodes)
      established-paths
      (dijkstra established-paths nodes edges))))

(princ (dijkstra 'tokyo *nodes* *edges*))

実行すると，

((TOKYO (NAGANO HUKUI 330) 230) (TOKYO (NAGOYA KYOTO 160) 350) (TOKYO NAGOYA 350) (TOKYO (TAKASAKI NIIGATA 210) 110) (TOKYO NAGANO 230) (TOKYO TAKASAKI 110) TOKYO)

こんなものが返ってくる。これは各地点までの最短ルートのリストであり，ダイクストラ法の結果である。

3. 感想

　やったぜ。