M.Hiroi's Home Page

Functional Programming

お気楽 Scheme プログラミング入門

[ PrevPage | Scheme | NextPage ]

集合としてのリスト

今回はリストを使って「集合 (set)」を表してみましょう。集合はいくつかの要素を集めたものです。一般に、集合は重複した要素を含まず、要素の順番に意味はありません。なお、要素の重複を許す集合は「多重集合 (multi set)」と呼ばれます。たとえば、集合 {1, 3, 5, 7} は {7, 5, 3, 1} や {5, 3, 1, 7} と表すこともできます。このように、要素は適当に並べてもかまわないのですが、ある規則で要素を整列させておく場合 (正規化) もあります。

集合をリストで表す場合、関数 member は要素が集合に含まれているか調べる述語と考えることができます。このほかにも、集合 A は集合 B の部分集合か調べたり、集合 A と B の和や積を求める、といった操作を考えることができます。また、空集合は空リストで表すことができます。

なお、ライブラリ SRFI-1 にはリストを集合として扱う関数が用意されていますが、今回は Scheme のお勉強ということで、実際にプログラムを作ってみましょう。

●union

それでは、集合の和を求める関数 union から作りましょう。関数 union は等値を判定する述語と 2 つのリスト (集合) を受け取り、2 つの集合の要素をすべて含むリストを返します。このとき、2 つの集合で重複している要素はひとつだけ結果のリストに含まれます。簡単な例を示しましょう。

gosh[r7rs.user]> (union eq? '(a b c) '(d e f))
(a b c d e f)
gosh[r7rs.user]> (union eq? '(a b c) '(c b d))
(a c b d)

union は append と同じように作ることができます。第 1 引数のリストから要素を取り出し、それが第 2 引数のリストに含まれていなければ、その要素を結果のリストに追加します。含まれていれば、その要素は追加しません。そして最後に、第 2 引数のリストを追加します。プログラムは次のようになります。

リスト : 集合の和

(define (union pred xs ys)
  (cond
   ((null? xs) ys)
   ((member (car xs) ys pred)
    (union pred (cdr xs) ys))
   (else
    (cons (car xs) (union pred (cdr xs) ys)))))

リスト xs の要素を car で取り出して、同じ要素がリスト ys に含まれているか member でチェックします。含まれていれば union を再帰呼び出します。そうでなければ、union を再帰呼び出しした結果に要素を追加します。

●intersection

次は集合の積を求める関数 intersection を作ります。intersection は 2 つのリストに共通な要素を取り出し、それをリストに格納して返します。簡単な例を示しましょう。

gosh[r7rs.user]> (intersection eq? '(a b c) '(b c d))
(c b)
gosh[r7rs.user]> (intersection eq? '(a b c) '(d e f))
()

プログラムは次のようになります。

リスト : 集合の積

(define (intersection pred xs ys)
  (cond
   ((null? xs) '())
   ((member (car xs) ys pred)
    (cons (car xs) (intersection pred (cdr xs) ys)))
   (else
    (intersection pred (cdr xs) ys))))

これも簡単ですね。リスト xs が空リストの場合は空リストを返します。次に、xs の要素を car で取り出して、同じ要素がリスト ys に含まれているか member でチェックします。そうであれば、intersection を再帰呼び出しした結果に要素を追加します。そうでなければ、intersection を再帰呼び出しするだけです。

●difference

次は集合の差を求める関数 difference を作ります。difference は集合 ys に現れない集合 xs の要素をリストに格納して返します。つまり、集合 xs から集合 ys に含まれる要素を取り除いた集合を求めることになります。簡単な例を示しましょう。

gosh[r7rs.user]> (difference eq? '(a b c d e) '(b d f))
(a c e)
gosh[r7rs.user]> (difference eq? '(a b c) '(a b c))
()

プログラムは次のようになります。

リスト : 集合の差

(define (difference pred xs ys)
  (cond
   ((null? xs) '())
   ((member (car xs) ys pred)
    (difference pred (cdr xs) ys))
   (else
    (cons (car xs) (difference pred (cdr xs) ys)))))

これも簡単ですね。リスト xs が空リストの場合は空リストを返します。次に、xs の要素を car で取り出して、同じ要素がリスト ys に含まれているか member でチェックします。含まれていれば、difference を再帰呼び出しします。そうでなければ、difference を再帰呼び出しした結果に要素を追加します。

●exclusive-or

次は、集合の排他的論理和を求める関数 exclusive-or を作りましょう。exclusive-or は集合 xs と ys の両方にちょうど 1 つだけ現れる要素をリストに格納して返します。これは集合の和から集合の積を取り除けば求めることができます。簡単な例を示しましょう。

gosh[r7rs.user]> (exclusive-or eq? '(a b c d e f) '(d e f b g h))
(a c g h)
gosh[r7rs.user]> (exclusive-or eq? '(a b c d e f) '(a b c d e f))
()
gosh[r7rs.user]> (exclusive-or eq? '(a b c) '(d e f))
(a b c d e f)

プログラムは次のようになります。

リスト : 集合の排他的論理和

(define (exclusive-or pred xs ys)
  (difference pred (union pred xs ys) (intersection pred xs ys)))

排他的論理和の定義をそのままプログラムしただけなので簡単です。

●subset?

次は集合 xs が集合 ys の部分集合か判定する述語 subset? を作ります。集合 xs の要素がすべて集合 ys に含まれていれば #t を返します。簡単な例を示しましょう。

gosh[r7rs.user]> (subset? eq? '(a b) '(a b c))
#t
gosh[r7rs.user]> (subset? eq? '(a b d) '(a b c))
#f

プログラムは次のようになります。

リスト : 部分集合の判定

(define (subset? pred xs ys)
  (cond
   ((null? xs) #t)
   ((member (car xs) ys pred)
    (subset? pred (cdr xs) ys))
   (else #f)))

xs が空リストの場合、xs のすべての要素は ys に含まれているので #t を返します。また、空リストは空集合を表しているので、空集合はすべての集合の部分集合であることを意味しています。次に、リスト xs の要素を car で取り出して、同じ要素がリスト ys に含まれているか member でチェックします。含まれていれば、subset? を再帰呼び出しするだけです。そうでなければ、集合 ys と異なる要素があるので #f を返します。

●adjoin

最後に、要素を集合に追加する関数 adjoin を作りましょう。

adjoin pred ls item1 item2 ...

adjoin は集合 ls に要素 item1 item2 ... を追加します。集合 ls に含まれている要素は追加しないことに注意してください。簡単な例を示しましょう。

gosh[r7rs.user]> (adjoin eq? '(a b c) 'd 'e 'f)
(f e d a b c)
gosh[r7rs.user]> (adjoin eq? '(a b c) 'a 'b 'd)
(d a b c)
gosh[r7rs.user]> (apply adjoin eq? '() '(a b a b c a b c d))
(d c b a)

最後の例のように、adjoin は重複要素を削除することもできます。プログラムは次のようになります。

リスト : 要素の追加

(define (adjoin pred ls . xs)
  (let loop ((xs xs) (ls ls))
    (cond
     ((null? xs) ls)
     ((member (car xs) ls pred)
      (loop (cdr xs) ls))
     (else
      (loop (cdr xs) (cons (car xs) ls))))))

追加する要素は可変個引数で受け取ります。名前付き let で xs から要素を一つずつ取り出し、それが集合 ls に含まれているか member でチェックします。含まれていれば、その要素は ls に追加しません。含まれていなければ要素を ls に追加します。

●ライブラリの作成

プログラムを作っていると、ほかのプログラムで作った関数が利用できるのではないか、といった場面に出あうことがあります。このような場合、自分で作成した関数をライブラリとしてまとめておくと、簡単に再利用することができて便利です。R7RS-small では、define-library でライブラリを定義することができます。ここで define-library の基本的な使い方を簡単に説明しておきましょう。

define-library (library name) (library declaration) ...

(library name) はライブラリ名を表すリストで、その要素は識別子 (シンボル) もしくは非負の整数です。(library declaration) はライブラリ宣言を表します。これにはいくつかの形式がありますが、ライブラリとして最低限必要になるのは export 宣言、import 宣言、begin 宣言の 3 つです。

  1. (export name ...)
  2. (import (library name) ...)
  3. (begin S式 ...)

1 の export 宣言はライブラリ外部に公開する識別子などを指定します。(rename name1 name2) で公開する名前を変更することもできます。2 の import 宣言はライブラリで必要となる他のライブラリを import します。3 の begin 宣言は、ライブラリ本体である Scheme コード (S 式) を begin フォームに記述します。

簡単な例を示しましょう。

リスト : ライブラリ (mylib foo) の定義

(define-library (mylib foo)
  (export foo)
  (import (scheme base) (scheme write))
  (begin
    (define (foo) (display "hello, foo!\n"))))

ライブラリ名が (mylib foo) で、begin の中に関数 foo が定義されています。そして export 宣言で foo を外部に公開しています。ライブラリ名 (mylib foo) と実際のファイルとの対応は、仕様 (R7RS-small) では未定義なので Scheme 処理系に依存します。Gauche の場合、ライブラリ名は次のようなファイル名に変換されます。

(mylib foo) => mylib/foo.scm
(mylib test bar) => mylib/test/bar.scm

(mylib foo) はディレクトリ mylib/ にある foo.scm を表します。(mylib test bar) はディレクトリ mylib/test/ の bar.scm を表します。たとえば、カレントディレクトリに mylib/foo.scm があるとしましょう。Gauche の場合、REPL で (import (mylib foo)) としてもライブラリをロードすることはできません。

$ rlwrap gosh -r7
gosh[r7rs.user]> (import (mylib foo))
*** ERROR: cannot find "mylib/foo" in ("/usr/local/share/gauche-0.97/site/lib" 
"/usr/local/share/gauche-0.97/0.9.9/lib")
    While compiling "(standard input)" at line 1: (import (mylib foo))

Gauche はライブラリを検索するとき *load-path* に登録されているパスを使用します。カレントディレクトリは *load-path* に登録されていないので、mylib/foo.scm を読み込むことができないのです。一番簡単な方法は Gauche の起動時にオプション -A または -I を使って、カレントディレクトリを *load-path* に追加することです。

$ rlwrap gosh -r7 -A .
gosh[r7rs.user]> (import (mylib foo))
gosh[r7rs.user]> (foo)
hello, foo!
#<undef>

これでライブラリ (mylib foo) を読み込むことができます。それから、今回作成した集合演算を行う関数をライブラリ (mylib lset) にまとめると、プログラムリスト のようになります。ご参考までに。

●プログラムリスト

;;;
;;; lset.scm : リストによる集合演算
;;;
;;;            Copyright (C) 2020 by Makoto Hiroi
;;;
(define-library (mylib lset)
  (import (scheme base))
  (export adjoin union intersection difference exclusive-or subset?)
  (begin
    ;; 要素の追加
    (define (adjoin pred ls . xs)
      (let loop ((xs xs) (ls ls))
        (cond
         ((null? xs) ls)
         ((member (car xs) ls pred)
          (loop (cdr xs) ls))
         (else
          (loop (cdr xs) (cons (car xs) ls))))))

    ;; 和集合
    (define (union pred xs ys)
      (cond
       ((null? xs) ys)
       ((member (car xs) ys pred)
        (union pred (cdr xs) ys))
       (else
        (cons (car xs) (union pred (cdr xs) ys)))))

    ;; 積集合
    (define (intersection pred xs ys)
      (cond
       ((null? xs) '())
       ((member (car xs) ys pred)
        (cons (car xs) (intersection pred (cdr xs) ys)))
       (else
        (intersection pred (cdr xs) ys))))

    ;; 差集合
    (define (difference pred xs ys)
      (cond
       ((null? xs) '())
       ((member (car xs) ys pred)
        (difference pred (cdr xs) ys))
       (else
        (cons (car xs) (difference pred (cdr xs) ys)))))

    ;; 排他的論理和
    (define (exclusive-or pred xs ys)
      (difference pred (union pred xs ys) (intersection pred xs ys)))

    ;; 部分集合
    (define (subset? pred xs ys)
      (cond
       ((null? xs) #t)
       ((member (car xs) ys pred)
        (subset? pred (cdr xs) ys))
       (else #f)))
    ))

簡単な使用例を示します。

$ rlwrap gosh -r7 -A .
gosh[r7rs.user]> (import (mylib lset))
gosh[r7rs.user]> (union eq? '(a b c d) '(c d e f))
(a b c d e f)
gosh[r7rs.user]> (intersection eq? '(a b c d) '(c d e f))
(c d)
gosh[r7rs.user]> (difference eq? '(a b c d) '(c d e f))
(a b)

初版 2008 年 2 月 2 日
改訂 2020 年 9 月 6 日

経路の探索

今回は、地図上の A 地点から B 地点までの道順を求める、といった「経路の探索」と呼ばれる問題を取り上げます。「探索」にはいろいろな種類があります。「8 クイーン」のようなパズルの解法も、あらゆる可能性の中から正解に行き着く手順を探すことですから、探索の一つと考えることができます。そして、探索でよく用いられる最も基本的な方法が「バックトラック」なのです。もちろん、経路の探索もバックトラックで解くことができます。

このほかに、もう一つ基本的な方法として「幅優先探索」があります。バックトラックの場合、失敗したら後戻りして別の道を選び直しますが、幅優先探索の場合は、全ての経路について並行に探索を進めていきます。幅優先探索は最短手順を求めるのに適したアルゴリズムですが、問題によっては必要となるメモリの量がとても多くなり、幅優先探索を使用することができない場合があります。このような場合、「反復深化」という方法を使うと、多少時間はかかりますが、少ないメモリで最短手順を求めることができます。今回はこの 3 つの方法で経路を求めてみましょう。

●グラフとは?

まず最初に「グラフ (graph)」というデータ構造を取り上げます。一般にグラフというと、 円グラフや折れ線グラフといった図表を思い出す人が多いと思います。数学の「グラフ理論」では、いくつかの点とそれを結ぶ線でできた図形を「グラフ」といいます。次の図を見てください。


      図 : グラフの例

上図に示すように、グラフは点とそれを接続する線から構成されています。点のことを「頂点 (vertex)」や「節点 (node)」と呼び、線のことを「辺 (edge)」や「弧 (arc)」と呼びます。また、グラフには 2 種類あって、辺に向きの無いグラフを「無向グラフ」といい、辺に向きがあるグラフを「有向グラフ」といいます。有向グラフは一方通行の道と考えればいいでしょう。 次の図を見てください。


          図 : 有向グラフと無向グラフ

たとえば、上図の (1) では A 地点から B 地点へ行くことができますが、一方通行のため B 地点から A 地点に戻ることはできません。これが有効グラフです。(2) の無効グラフでは、A 地点から B 地点へ行くことができるし、逆に B 地点から A 地点に戻ることもできます。

データ間のさまざまな関係を表す場合、グラフはとても役に立ちます。たとえば、下図のように経路をグラフで表すことができます。


      図 : 経路図

上図ではアルファベットで頂点を表しています。この例では経路をグラフで表していますが、このほかにもいろいろな問題をグラフで表現することができます。

●隣接行列と隣接リスト

グラフをプログラムする場合、よく使われる方法に「隣接行列」と「隣接リスト」があります。隣接行列は 2 次元配列で頂点の連結を表す方法です。頂点が N 個ある場合、隣接行列は N 行 N 列の行列で表すことができます。上の経路図を隣接行列で表すと次のようになります。

   │A B C D E F G
 ─┼─────── 
  A│0 1 1 0 0 0 0
  B│1 0 1 1 0 0 0
  C│1 1 0 0 1 0 0
  D│0 1 0 0 1 1 0
  E│0 0 1 1 0 0 1
  F│0 0 0 1 0 0 0
  G│0 0 0 0 1 0 0


    図 : 隣接行列

A に接続している頂点は B と C なので、A 行の B と C に 1 をセットし、接続していない頂点には 0 をセットします。経路が一方通行ではない無向グラフの場合は、A 列の B と C にも 1 がセットされます。これを Scheme でプログラムすると、次のようになります。

リスト : 隣接行列

(define *adjacent*
  #(#(0 1 1 0 0 0 0)   ; A 
    #(1 0 1 1 0 0 0)   ; B
    #(1 1 0 0 1 0 0)   ; C
    #(0 1 0 0 1 1 0)   ; D
    #(0 0 1 1 0 0 1)   ; E
    #(0 0 0 1 0 0 0)   ; F
    #(0 0 0 0 1 0 0))) ; G

頂点 A から G を数値 0 から 6 に対応させるところがポイントです。隣接行列は 2 次元配列 (Scheme ではベクタのベクタ) で表します。内容は上図の隣接行列と同じです。

隣接行列の欠点は、辺の数が少ない場合でも N 行 N 列の行列が必要になることです。つまり、ほとんどの要素が 0 になってしまい、メモリを浪費してしまうのです。この欠点を補う方法に隣接リストがあります。これはつながっている頂点をリストに格納する方法です。これを Scheme でプログラムすると次のようになります。

リスト : 隣接リスト

(define *adjacent*
  #((1 2)        ; A 
    (0 2 3)      ; B
    (0 1 4)      ; C
    (1 4 5)      ; D
    (2 3 6)      ; E
    (3)          ; F
    (1)))        ; G

隣接行列と同様に、頂点 A から G を数値 0 から 6 に対応させます。この場合、ベクタの要素がリストになることに注意してください。

ところで、隣接リストにも欠点があります。たとえば、E と G が接続しているか調べるには、データを順番に調べていくしか方法がありません。このため、接続の判定に時間がかかることがあるのです。まあ、頂点に接続されている辺の数が少なければ、処理速度が極端に遅くなることはないでしょう。

●連想リストによる方法

ところで、Lisp / Scheme でグラフをプログラムするのであれば、わざわざ頂点を数値に変換する必要はありません。頂点はシンボルで表せばいいのです。頂点と隣接リストの対応は連想リストを使うと簡単です。次のリストを見てください。

リスト : 連想リストによる隣接リストの表現

(define *adjacent*
  '((A B C)
    (B A C D)
    (C A B E)
    (D B E F)
    (E C D G)
    (F D)
    (G E)))

グラフを連想リストで表現する場合、キーが頂点を表すシンボルでデータが隣接リストになります。そして、関数 assoc で頂点の隣接リストを求めることになります。次の例を見てください。

リスト : 隣接リストの使用例

(for-each
  (lambda (node) (display (cdr (assoc node *adjacent*))))
  '(A B C D E F G))

(B C) 
(A C D) 
(A B E) 
(B E F) 
(C D G) 
(D) 
(E) 
#<undef>

assoc で頂点 node を検索して cdr で隣接リストを取り出しています。

●バックトラックによる探索

経路図を再掲します。今回は隣接リストでグラフを表し、A から G までの経路を求めることにします。


      図 : 経路図

経路の表し方ですが、これはシンボルを並べたリストで表せばいいでしょう。たとえば、A 地点から G 地点までの経路は次のようになります。

A - C - E - G  ─→  (A C E G) ==> (G E C A)  ; 逆順で管理する


                図 : 経路の管理方法

ただし、そのまま並べただけでは探索中の処理が面倒になります。というのは、経路 A - C を E へ延ばす場合、リスト (A C) の最後にシンボル E を追加しなければならないからです。リストの先頭にデータを追加することは cons を使って簡単にできますが、それ以外の場所にデータを追加するのはちょっと面倒です。そこで、経路を逆順に管理することにします。

バックトラックを再帰呼び出しで実現する場合、順列と組み合わせ で説明したように、「進む」ことを再帰呼び出しに対応させるのがポイントです。たとえば、経路を探索する関数を search としましょう。search は引数としてゴール地点と経路を受け取ることにします。最初は次のように呼び出します。

(search 'G '(A))

経路を逆順で表しているので、リストの先頭要素が現在地点 (経路の先端) を表わしていることに注意してください。そして、A から B へ進むにはリストの先頭に B を追加して search を再帰呼び出しします。

(search 'G '(A)) ─ Call → (search 'G '(B A))

これで A から B へ進むことができます。それでは、A に戻るにはどうしたらいいのでしょう。(search 'G '(B A)) は (search 'G '(A)) から呼び出されたので、(search 'G '(B A)) の実行を終了すれば呼び出し元である (search 'G '(A)) に戻ることができます。

(search 'G '(A)) ─  Call  → (search 'G '(B A))
                 ← Return ─

つまり、関数の実行を終了すれば、ひとつ手前の地点にバックトラックできるのです。このように、再帰呼び出しを使うと、進むことと戻ることを関数呼び出しで簡単に実現することができます。プログラムは次のようになります。

リスト : 経路の探索 (1)

;;; 深さ優先探索
(define (depth-first-search goal path)
  (cond
   ((eq? goal (car path))
    (display (reverse path))
    (newline))
  (else
   (for-each
     (lambda (x)
       (if (not (member x path))
           (depth-first-search goal (cons x path))))
     (cdr (assoc (car path) *adjacent*))))))

経路図を表す隣接リストは連想リストで表すことにします。関数 depth-first-search の引数 goal がゴール地点、path が経路を表します。最初に、ゴールに到達したかチェックします。goal と同じシンボルであれば display で経路を表示します。経路は逆順になっているので、reverse で path を反転しています。そして、経路を求めたあとバックトラックすることにより、A から G までの経路をすべて求めることができます。

ゴールに到達していない場合は経路をのばして探索を進めます。このとき、節点 x が経路 path に含まれていないかチェックすることを忘れないで下さい。そうしないと、同じ道をぐるぐると回る巡回経路が発生し、ゴールである G 地点にたどり着くことができなくなります。それから、path の先頭に x を追加して depth-first-search を再帰呼び出しします。

実際に depth-first-search を実行すると、次のような経路を表示します。

gosh[r7rs.user]> (depth-first-search 'G '(A))
(A B C E G) 
(A B D E G) 
(A C B D E G) 
(A C E G) 
#<undef>

4 通りの経路を見つけることができました。バックトラックによる探索は経路を先へ先へ進めるので、「縦形探索」とか「深さ優先探索」と呼ばれています。このため、結果を見てもわかるように、最初に見つかる経路が最短経路とは限りません。最短経路を求めるには「幅優先探索」というアルゴリズムが適しています。

●幅優先探索

深さ優先探索は一つの経路を先へ先へと進めていくため、最初に見つかる経路が最短経路であるとは限りません。幅優先探索はすべての経路について平行に探索を進めていくため、最初に見つかる経路が最短経路となります。それでは、同じ経路図を使って幅優先探索を具体的に説明しましょう。

幅優先探索の様子を下図に示します。


                  図 : 幅優先探索

まず、出発点 A から一つ進んだ経路 (2 節点) をすべて求めます。この場合は、(A B) と (A C) の 2 つあり、これをすべて記憶しておきます。次に、これらの経路から一つ進めた経路 (3 節点) をすべて求めます。経路 (A B) は (A B C) と (A B D) へ進めることができますね。ほかの経路 (A C) も同様に進めて、すべての経路を記憶します。あとはこの作業をゴールに達するまで繰り返せばいいのです。

上図では、4 節点の経路 (A C E G) でゴールに達していることがわかります。このように幅優先探索では、最初に見つかった経路が最短距離 (または最小手数) となるのです。この性質は、すべての経路を平行に進めていく探索順序から考えれば当然のことといえるでしょう。このことからバックトラックの縦形探索に対して、幅優先探索は「横形探索」と呼ばれます。このあとも探索を繰り返せばすべての経路を求めることができます。

完成までの最小手数を求めるパズルを解く場合、幅優先探索を使ってみるといいでしょう。ただし、探索を進めるにしたがって、記憶しておかなければならないデータの総数が爆発的に増加する、つまりメモリを大量消費することに注意してください。

上図の場合ではメモリを大量消費することはありませんが、問題によってはマシンに搭載されているメモリが不足するため、幅優先探索を実行できない場合もあるでしょう。したがって、幅優先探索を使う場合は、メモリの消費量を抑える工夫も必要になります。

●経路の管理

経路の管理はキューを使うと簡単です。幅優先探索でのキューの動作を下図に示します。


          図 : 幅優先探索とキューの動作

最初は、(1) のように出発点をキューにセットしておきます。次に、キューから経路を取り出し、(2) のように経路 (A) を一つ進めて、経路 (A B) (A C) を作り、それをキューに追加します。(3) では、経路 (A B) を取り出して、一つ進めた経路 (A B C) と (A B D) をキューに追加します。あとはキューに経路がある間、処理を繰り返せばいいわけです。

キューは先入れ先出し (FIFO) の性質を持つデータ構造です。距離の短い経路から順番に処理されるため、幅優先探索として機能するわけです。

●プログラムの作成

それではプログラムを作りましょう。次のリストを見てください。

リスト : 経路の探索 (2)

;;; 幅優先探索
(define (breadth-first-search start goal)
  (let ((q (make-queue)))
    (enqueue! q (list start))
    (do ()
        ((queue-empty? q))
      (let ((path (dequeue! q)))
        (cond
         ((eq? goal (car path))
          (display (reverse path))
          (newline))
         (else
          (for-each
           (lambda (x)
             (unless (member x path)
                     (enqueue! q (cons x path))))
           (cdr (assoc (car path) *adjacent*)))))))))

関数 breadth-first-search は start から goal までの経路を幅優先探索で求めます。最初に make-queue でキューを生成し、出発点 (start) だけの経路をキューに追加します。

キューは拙作のページ Scheme プログラミング中級編 [4] で作成したプログラムをレコード型に改造し、それをライブラリ (mylib queue) にまとめたものです。詳細は プログラムリスト2 をお読みください。

そして、キューにデータがある間、do ループで探索処理を続行します。経路をのばす処理はバックトラックのプログラムとほぼ同じです。ひとつのばした経路は enqueue! でキューに追加するところに注意してください。

それでは実行してみましょう。

gosh[r7rs.user]> (breadth-first-search 'A 'G)
(A C E G) 
(A B C E G) 
(A B D E G) 
(A C B D E G) 
#t

結果を見ればおわかりのように、最初に見つかる経路が最短で、最後に見つかる経路が最長となります。当然ですが経路の総数は 4 通りになります。

●反復深化

幅優先探索は最短手数を求めるのに適したアルゴリズムですが、生成する局面数が多くなると大量のメモリを必要とします。このため、メモリが不足するときには使うことができないという欠点があります。逆に深さ優先探索の場合、メモリの消費量は少ないのですが、最初に見つかる解が最短手数とは限らないという問題点があります。

それでは、大量のメモリを使わずに最短手数を求める方法はないのでしょうか。実は、とても簡単な方法があるのです。それは、深さ優先探索の「深さ」に上限値を設定し、解が見つかるまで上限値を段階的に増やしていくという方法です。

たとえば、1 手で解が見つからない場合は 2 手までを探索し、それでも見つからない場合は 3 手までを探索するというように、制限値を 1 手ずつ増やしていくわけです。このアルゴリズムを「反復深化 (iterative deeping)」といいます。

反復深化は最短手数を求めることができるアルゴリズムですが、幅優先探索と違って局面を保存する必要がないため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。ただし、同じ探索を何度も繰り返すため実行時間が増大する、という欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。

●反復深化による経路の探索

それでは、経路図で A から G までの経路を反復深化で求めてみましょう。反復深化のプログラムはとても簡単です。設定した上限値まで深さ優先探索を行う関数を作り、上限値を 1 手ずつ増やしてその関数を呼び出せばいいのです。プログラムは次のようになります。

リスト : 経路の探索 (3)

;;; 反復深化
(define (id-search start goal)
  ;; 深さ優先探索
  (define (dfs limit path)
    (if (= limit (length path))
        (when
         (eq? goal (car path))
         (display (reverse path))
         (newline))
        (for-each
         (lambda (x)
           (unless (member x path)
                   (dfs limit (cons x path))))
         (cdr (assoc (car path) *adjacent*)))))
  ;;
  (do ((n 2 (+ n 1)))
      ((> n 7))
    (display "-----") (display n) (display "-----\n")
    (dfs n (list start))))

実際の処理は局所関数 dfs で行います。引数 limit が上限値を表します。dfs は limit まで深さ優先探索を行います。経路の長さを length で求めて、これが上限値 limit に達したら探索を打ち切ります。このとき goal に到達したかチェックします。あとは、limit の値を増やしながら dfs を呼び出せばいいわけです。

それでは実行結果を示しましょう。

gosh[r7rs.user]> (id-search 'A 'G)
-----2-----
-----3-----
-----4-----
(A C E G)
-----5-----
(A B C E G)
(A B D E G)
-----6-----
(A C B D E G)
-----7-----
#t

結果を見ればおわかりのように、最初に見つかる解が最短手数になります。このプログラムではすべての経路を求めましたが、最短手数を求めるだけでよい場合は、解が見つかった時点で探索を終了すればいいでしょう。


●プログラムリスト1

;;;
;;; keiro.scm : 経路の探索
;;;
;;;             Copyright (C) 2008-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write) (mylib queue))

;; 隣接リスト
(define *adjacent*
  '((A B C)
    (B A C D)
    (C A B E)
    (D B E F)
    (E C D G)
    (F D)
    (G E)))

;;; 深さ優先探索
(define (depth-first-search goal path)
  (cond
   ((eq? goal (car path))
    (display (reverse path))
    (newline))
  (else
   (for-each
     (lambda (x)
       (if (not (member x path))
           (depth-first-search goal (cons x path))))
     (cdr (assoc (car path) *adjacent*))))))

;;; 幅優先探索
(define (breadth-first-search start goal)
  (let ((q (make-queue)))
    (enqueue! q (list start))
    (do ()
        ((queue-empty? q))
      (let ((path (dequeue! q)))
        (cond
         ((eq? goal (car path))
          (display (reverse path))
          (newline))
         (else
          (for-each
           (lambda (x)
             (unless (member x path)
                     (enqueue! q (cons x path))))
           (cdr (assoc (car path) *adjacent*)))))))))

;;; 反復深化
(define (id-search start goal)
  ;; 深さ優先探索
  (define (dfs limit path)
    (if (= limit (length path))
        (when
         (eq? goal (car path))
         (display (reverse path))
         (newline))
        (for-each
         (lambda (x)
           (unless (member x path)
                   (dfs limit (cons x path))))
         (cdr (assoc (car path) *adjacent*)))))
  ;;
  (do ((n 2 (+ n 1)))
      ((> n 7))
    (display "-----") (display n) (display "-----\n")
    (dfs n (list start))))

;;; 実行
(display "----- dfs -----\n")
(depth-first-search 'G '(A))
(display "----- bfs -----\n")
(breadth-first-search 'A 'G)
(display "----- ids -----\n")
(id-search 'A 'G)

●プログラムリスト2

;;;
;;; queue.scm :  キュー
;;;
;;;              Copyright (C) 2020 Makoto Hiroi
;;;
(define-library (mylib queue)
  (import (scheme base))
  (export make-queue enqueue! dequeue! queue-empty? queue-clear!)
  (begin
    ;; キューの定義
    (define-record-type Queue
      (create-queue front rear)
      queue?
      (front front set-front!)
      (rear  rear  set-rear!))

    ;; キューの生成
    (define (make-queue) (create-queue '() '()))

    ;; キューは空か?
    (define (queue-empty? q) (null? (front q)))

    ;; キューを空にする
    (define (queue-clear! q)
      (set-front! q '())
      (set-rear!  q '()))

    ;; キューにデータを追加する
    (define (enqueue! q item)
      (let ((new-cell (list item)))
        (if (queue-empty? q)
            ;; キューは空
            (set-front! q new-cell)
            ;; 最後尾のセルを書き換える
            (set-cdr! (rear q) new-cell))
        (set-rear! q new-cell)))

    ;; キューからデータを取り出す
    (define (dequeue! q)
      (if (queue-empty? q)
          #f
          (let ((item (car (front q))))
            (set-front! q (cdr (front q)))
            ;; キューは空になったか?
            (when
             (null? (front q))
             (set-rear! q '()))
            item)))
    ))

初版 2008 年 2 月 2 日
改訂 2020 年 9 月 6 日

Copyright (C) 2008-2020 Makoto Hiroi
All rights reserved.

[ PrevPage | Scheme | NextPage ]