LISPUSER

LISPMEMOLisp is like a ball of mud - you can throw anything you want into it, and it's still Lisp. -- Anonymous

(top)  (memo)  (rss)

ANSI Common Lisp の bfs について

先日 ANSI Common Lisp の bfs がわかりにくい、という話があったので。

A -> B, C
B -> C
C -> D

で、このようなネットワークの A から C までの最短経路を求める。

(defun shortest-path (start end net)
  (bfs end (list (list start)) net))

(defun bfs (end queue net)
  (if (null queue)
      nil
      (let ((path (car queue)))
       (let ((node (car path)))
         (if (eql node end)
             (reverse path)
             (bfs end
                  (append (cdr queue)
                          (new-paths path node net))
                  net))))))
                                        
(defun new-paths (path node net)
  (mapcar #'(lambda (n)
             (cons n path))
         (cdr (assoc node net))))
入力 開始ノード、終了ノード
出力 最短の経路が一つ

最短経路探索は次のようになります。

…でも説明しようとすると手間がかかるので、formatで表示を入れます。とりあえずコピーペーストで次のプログラムを入力してください。

(defun shortest-path (start end net)
  (format t "幅優先探索開始: ~A から ~A までの最短距離を探索する。~%ネットワーク: ~%" start end)
  (dolist (node net)
    (format t " ~A => ~{~A~^, ~}~%" (car node) (cdr node)))
  (terpri)
  (bfs end (list (list start)) net))

(defun bfs (end queue net &optional (n 1))
  (format t "~D. 探索: 経路情報は ~{~{~A~^->~}~^, ~}~%" n (mapcar #'reverse queue))
  (if (null queue)
      nil
      (let ((path (car queue)))
       (let ((node (car path)))
         (if (eql node end)
             (progn
               (format t "~&~%~{~A~^->~} が最短経路です。~%" (reverse path))
               (reverse path))
             (bfs end
                  (append (cdr queue)
                          (new-paths path node net))
                  net
                  (1+ n)))))))
                                        
(defun new-paths (path node net)
  (format t "  [探索] 経路: ~{~A~^-~} を拡張します。 ノード: ~A => ~{~S~^, ~} より" (reverse path) node (cdr (assoc node net)))
  (let ((paths (mapcar #'(lambda (n)
                          (cons n path))
                      (cdr (assoc node net)))))
    (format t "経路 ~{~{~A~^->~}~^, ~} を取得。~%~%" (mapcar #'reverse paths))
    paths))

そして実行すると説明が表示されます。

CL-USER> (shortest-path 'a 'd '((a b c) (b c) (c d)))
幅優先探索開始: A から D までの最短距離を探索する。
ネットワーク: 
 A => B, C
 B => C
 C => D

1. 探索: 経路情報は A
  [探索] 経路: A を拡張します。 ノード: A => B, C より経路 A->B, A->C を取得。

2. 探索: 経路情報は A->B, A->C
  [探索] 経路: A-B を拡張します。 ノード: B => C より経路 A->B->C を取得。

3. 探索: 経路情報は A->C, A->B->C
  [探索] 経路: A-C を拡張します。 ノード: C => D より経路 A->C->D を取得。

4. 探索: 経路情報は A->B->C, A->C->D
  [探索] 経路: A-B-C を拡張します。 ノード: C => D より経路 A->B->C->D を取得。

5. 探索: 経路情報は A->C->D, A->B->C->D

A->C->D が最短経路です。
(A C D)
CL-USER> 

動作がイメージできたでしょうか。もっと簡単なネットワークでやると良いかもしれません。

CL-USER> (shortest-path 'a 'e '((a b) (b c) (c d) (d e)))
幅優先探索開始: A から E までの最短距離を探索する。
ネットワーク: 
 A => B
 B => C
 C => D
 D => E

1. 探索: 経路情報は A
  [探索] 経路: A を拡張します。 ノード: A => B より経路 A->B を取得。

2. 探索: 経路情報は A->B
  [探索] 経路: A-B を拡張します。 ノード: B => C より経路 A->B->C を取得。

3. 探索: 経路情報は A->B->C
  [探索] 経路: A-B-C を拡張します。 ノード: C => D より経路 A->B->C->D を取得。

4. 探索: 経路情報は A->B->C->D
  [探索] 経路: A-B-C-D を拡張します。 ノード: D => E より経路 A->B->C->D->E を取得。

5. 探索: 経路情報は A->B->C->D->E

A->B->C->D->E が最短経路です。
(A B C D E)
CL-USER> (shortest-path 'a 'e '((A B D) (B C) (C D) (D E)))
幅優先探索開始: A から E までの最短距離を探索する。
ネットワーク: 
 A => B, D
 B => C
 C => D
 D => E

1. 探索: 経路情報は A
  [探索] 経路: A を拡張します。 ノード: A => B, D より経路 A->B, A->D を取得。

2. 探索: 経路情報は A->B, A->D
  [探索] 経路: A-B を拡張します。 ノード: B => C より経路 A->B->C を取得。

3. 探索: 経路情報は A->D, A->B->C
  [探索] 経路: A-D を拡張します。 ノード: D => E より経路 A->D->E を取得。

4. 探索: 経路情報は A->B->C, A->D->E
  [探索] 経路: A-B-C を拡張します。 ノード: C => D より経路 A->B->C->D を取得。

5. 探索: 経路情報は A->D->E, A->B->C->D

A->D->E が最短経路です。
(A D E)
CL-USER> (shortest-path 'a 'e '((A B) (B D) (C D) (D E) (E F)))
幅優先探索開始: A から E までの最短距離を探索する。
ネットワーク: 
 A => B
 B => D
 C => D
 D => E
 E => F

1. 探索: 経路情報は A
  [探索] 経路: A を拡張します。 ノード: A => B より経路 A->B を取得。

2. 探索: 経路情報は A->B
  [探索] 経路: A-B を拡張します。 ノード: B => D より経路 A->B->D を取得。

3. 探索: 経路情報は A->B->D
  [探索] 経路: A-B-D を拡張します。 ノード: D => E より経路 A->B->D->E を取得。

4. 探索: 経路情報は A->B->D->E

A->B->D->E が最短経路です。
(A B D E)
CL-USER> (shortest-path 'a 'e '((A B) (B D E) (C D) (D E) (E F)))
幅優先探索開始: A から E までの最短距離を探索する。
ネットワーク: 
 A => B
 B => D, E
 C => D
 D => E
 E => F

1. 探索: 経路情報は A
  [探索] 経路: A を拡張します。 ノード: A => B より経路 A->B を取得。

2. 探索: 経路情報は A->B
  [探索] 経路: A-B を拡張します。 ノード: B => D, E より経路 A->B->D, A->B->E を取得。

3. 探索: 経路情報は A->B->D, A->B->E
  [探索] 経路: A-B-D を拡張します。 ノード: D => E より経路 A->B->D->E を取得。

4. 探索: 経路情報は A->B->E, A->B->D->E

A->B->E が最短経路です。
(A B E)
CL-USER> 

いろんなネットワークを入力して試してみてください。 ネットワークの表示を改造して GraphViz フォーマットで図にしたりするとか面白いかも。

posted: 2008/07/27 01:14 | permanent link to this entry | Tags: LISP

(top)  (memo)  (rss)