今回はリストを使って「集合 (set) 」を表してみましょう。集合はいくつかの要素を集めたものです。一般に、集合は重複した要素を含まず、要素の順番に意味はありません。なお、要素の重複を許す集合は「多重集合 (multi set) 」と呼ばれます。たとえば、集合 {1, 3, 5, 7} は {7, 5, 3, 1} や {5, 3, 1, 7} と表すこともできます。このように、要素は適当に並べてもかまわないのですが、ある規則で要素を整列させておく場合 (正規化) もあります。
集合をリストで表す場合、拙作のページ 数当てゲーム [2] で説明した関数 member は、要素が集合に含まれているか調べる述語と考えることができます。このほかにも、集合 A は集合 B の部分集合か調べたり、集合 A と B の和や積を求める、といった操作を考えることができます。また、空集合は空リストで表すことができます。
なお、ライブラリ srfi-1 にはリストを集合として扱う関数が用意されていますが、今回は Scheme の勉強ということで実際にプログラムを作ってみましょう。
それでは、集合の和を求める関数 union から作りましょう。関数 union は 2 つのリスト (集合) を受け取り、2 つの集合の要素をすべて含むリストを返します。このとき、2 つの集合で重複している要素はひとつだけ結果のリストに含まれます。簡単な例を示しましょう。
gosh> (union '(a b c) '(d e f)) (a b c d e f) gosh> (union '(a b c) '(c b d)) (a c b d)
union は append と同じように作ることができます。第 1 引数のリストから要素を取り出し、それが第 2 引数のリストに含まれていなければ、その要素を結果のリストに追加します。含まれていれば、その要素は追加しません。そして最後に、第 2 引数のリストを追加します。プログラムは次のようになります。
リスト : 集合の和
(define (union x y)
(cond ((null? x) y)
((member (car x) y)
(union (cdr x) y))
(else
(cons (car x) (union (cdr x) y)))))
リスト x の要素を car で取り出して、同じ要素がリスト y に含まれているか member でチェックします。含まれていれば union を再帰呼び出します。そうでなければ、union を再帰呼び出しした結果に要素を追加します。
次は集合の積を求める関数 intersection を作ります。intersection は 2 つのリストに共通な要素を取り出し、それをリストに格納して返します。簡単な例を示しましょう。
gosh> (intersection '(a b c) '(b c d)) (c b) gosh> (intersection '(a b c) '(d e f)) ()
プログラムは次のようになります。
リスト : 集合の積
(define (intersection x y)
(cond ((null? x) '())
((member (car x) y)
(cons (car x) (intersection (cdr x) y)))
(else
(intersection (cdr x) y))))
これも簡単ですね。リスト x が空リストの場合は空リストを返します。次に、x の要素を car で取り出して、同じ要素がリスト y に含まれているか member でチェックします。そうであれば、intersection を再帰呼び出しした結果に要素を追加します。そうでなければ、intersection を再帰呼び出しするだけです。
次は集合の差を求める関数 set-difference を作ります。set-difference は集合 y に現れない集合 x の要素をリストに格納して返します。つまり、集合 x から集合 y に含まれる要素を取り除いた集合を求めることになります。簡単な例を示しましょう。
gosh> (set-difference '(a b c d e) '(b d f)) (a c e) gosh> (set-difference '(a b c) '(a b c)) ()
プログラムは次のようになります。
リスト : 集合の差
(define (set-difference x y)
(cond ((null? x) '())
((member (car x) y)
(set-difference (cdr x) y))
(else
(cons (car x) (set-difference (cdr x) y)))))
これも簡単ですね。リスト x が空リストの場合は空リストを返します。次に、x の要素を car で取り出して、同じ要素がリスト y に含まれているか member でチェックします。含まれていれば、set-difference を再帰呼び出しします。そうでなければ、set-difference を再帰呼び出しした結果に要素を追加します。
次は、集合の排他的論理和を求める関数 set-exclusive-or を作りましょう。set-exclusive-or は集合 x と y の両方にちょうど 1 つだけ現れる要素をリストに格納して返します。これは集合の和から集合の積を取り除けば求めることができます。簡単な例を示しましょう。
gosh> (set-exclusive-or '(a b c d e f) '(d e f b g h)) (c a g h) gosh> (set-exclusive-or '(a b c d e f) '(a b c d e f)) () gosh> (set-exclusive-or '(a b c) '(d e f)) (a b c d e f)
プログラムは次のようになります。
リスト : 集合の排他的論理和
(define (set-exclusive-or x y)
(set-difference (union x y) (intersection x y)))
排他的論理和の定義をそのままプログラムしただけなので簡単です。
最後に集合 x が集合 y の部分集合か判定する述語 subset? を作ります。集合 x の要素がすべて集合 y に含まれていれば #t を返します。簡単な例を示しましょう。
gosh> (subset? '(1 2) '(1 2 3)) #t gosh> (subsetp '(0 1 2) '(1 2 3)) #f
プログラムは次のようになります。
リスト : 部分集合の判定
(define (subset? x y)
(cond ((null? x) #t)
((member (car x) y) (subset? (cdr x) y))
(else #f)))
x が空リストの場合、x のすべての要素は y に含まれているので #t を返します。また、空リストは空集合を表しているので、空集合はすべての集合の部分集合であることを意味しています。次に、リスト x の要素を car で取り出して、同じ要素がリスト y に含まれているか member でチェックします。含まれていれば、subset? を再帰呼び出しするだけです。そうでなければ、集合 y と異なる要素があるので #f を返します。
最後に、集合を表すデータ構造をクロージャで作ってみましょう。まず最初に、今回のプログラムで作成する処理内容を示します。
集合の操作を行うため、クロージャに格納されている集合 (リスト) を取り出す処理が必要になります。このため、次の操作を用意します。
プログラムは次のようになります。
リスト : 集合
; 重複した要素を取り除く
(define (remove-same-item ls)
(cond ((null? ls) '())
((member (car ls) (cdr ls))
(remove-same-item (cdr ls)))
(else
(cons (car ls) (remove-same-item (cdr ls))))))
; 集合の操作
(define (make-set ls)
(let ((buff (remove-same-item ls)))
(lambda (msg . args)
(cond ((eq? msg 'union)
(make-set (union buff ((car args) 'get))))
((eq? msg 'intersection)
(make-set (intersection buff ((car args) 'get))))
((eq? msg 'difference)
(make-set (set-difference buff ((car args) 'get))))
((eq? msg 'exclusive-or)
(make-set (set-exclusive-or buff ((car args) 'get))))
((eq? msg 'subset?)
(subset? buff ((car args) 'get)))
((eq? msg 'get) buff)
((eq? msg 'member?)
(if (member (car args) buff) #t #f))
((eq? msg 'insert!)
(if (not (member (car args) buff))
(set! buff (cons (car args) buff)))
#t)
((eq? msg 'delete!)
(set! buff (remove! (lambda (x) (equal? x (car args))) buff))
#t)
(else #f)))))
関数 make-set は集合を操作するクロージャを返します。引数 ls は集合を表すリストです。重複した要素を削除するため、関数 remove-same-item を呼び出して、その返り値を局所変数 buff にセットします。次に、クロージャを返すラムダ式を定義します。実際の処理は集合を操作する関数を呼び出すだけです。引数がクロージャの場合、集合 (リスト) を取り出すため get を使っていることに注意してください。あとは、とくに難しいところはないでしょう。
それでは、簡単な実行例を示します。
gosh> (define a (make-set '(1 2 3 4 5))) a gosh> (define b (make-set '(2 4 6 8 10))) b gosh> ((a 'union b) 'get) (1 3 5 2 4 6 8 10) gosh> ((a 'intersection b) 'get) (2 4) gosh> ((a 'difference b) 'get) (1 3 5) gosh> ((a 'exclusive-or b) 'get) (1 3 5 6 8 10) gosh> (a 'member? 5) #t gosh> (a 'delete! 5) #t gosh> (a 'member? 5) #f gosh> (a 'member? 6) #f gosh> (a 'insert! 6) #t gosh> (a 'member? 6) #t
次は「グラフ (graph) 」というデータ構造を取り上げます。一般にグラフというと、 円グラフや折れ線グラフといった図表を思い出す人が多いと思います。数学の「グラフ理論」では、いくつかの点とそれを結ぶ線でできた図形を「グラフ」といいます。次の図を見てください。
頂点 辺
↓ ↓
●─────────●
│ │
│ │
│ │
●─────────●
図 : グラフの例
上図に示すように、グラフは点とそれを接続する線から構成されています。点のことを「頂点 (vertex) 」や「節点 (node) 」と呼び、線のことを「辺 (edge) 」や「弧 (arc) 」と呼びます。また、グラフには 2 種類あって、辺に向きの無いグラフを「無向グラフ」といい、辺に向きがあるグラフを「有向グラフ」といいます。有向グラフは一方通行の道と考えればいいでしょう。 次の図を見てください。
(1) Ａ──────────→Ｂ 有向グラフ
(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 が接続しているか調べるには、データを順番に調べていくしか方法がありません。このため、接続の判定に時間がかかることがあるのです。まあ、頂点に接続されている辺の数が少なければ、処理速度が極端に遅くなることはないでしょう。
ところで、Scheme (Lisp) でグラフをプログラムするのであれば、わざわざ頂点を数値に変換する必要はありません。頂点はシンボルで表せばいいのです。頂点と隣接リストの対応は連想リストを使うと簡単です。次のリストを見てください。
リスト : 連想リストによる隣接リストの表現
(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 地点から B 地点までの道順を求めるプログラムを作ってみましょう。「探索」にはいろいろな種類があります。たとえば、8 クイーン のようなパズルの解法も、あらゆる可能性の中から正解に行き着く手順を探すことですから、探索の一つと考えることができます。そして、探索でよく用いられる最も基本的な方法が「バックトラック (backtracking) 」なのです。もちろん、経路の探索もバックトラックで解くことができます。
経路図を再掲します。今回は隣接リストでグラフを表し、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)
(if (eq? goal (car path))
(format #t "~A~%" (reverse path))
(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 と同じシンボルであれば format で経路を表示します。経路は逆順になっているので、reverse で path を反転しています。そして、経路を求めたあとバックトラックすることにより、A から G までの経路をすべて求めることができます。
ゴールに到達していない場合は経路をのばして探索を進めます。このとき、節点 x が経路 path に含まれていないかチェックすることを忘れないで下さい。そうしないと、同じ道をぐるぐると回る巡回経路が発生し、ゴールである G 地点にたどり着くことができなくなります。それから、path の先頭に x を追加して depth-first-search を再帰呼び出しします。
実際に depth-first-search を実行すると、次のような経路を表示します。
gosh> (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)
4 通りの経路を見つけることができました。バックトラックによる探索は経路を先へ先へ進めるので、「縦形探索」とか「深さ優先探索」と呼ばれています。このため、結果を見てもわかるように、最初に見つかる経路が最短経路とは限りません。最短経路を求めるには「幅優先探索」というアルゴリズムが適しています。
深さ優先探索は一つの経路を先へ先へと進めていくため、最初に見つかる経路が最短経路であるとは限りません。幅優先探索はすべての経路について平行に探索を進めていくため、最初に見つかる経路が最短経路となります。それでは、同じ経路図を使って幅優先探索を具体的に説明しましょう。
幅優先探索の様子を下図に示します。
(A) ─┬─ (A B) ─┬─ (A B C) ・・・・
│ └─ (A B D) ─┬─ (A B D F) 行き止まり
│ └─ (A B D E)
└─ (A C) ─┬─ (A C B) ・・・・
└─ (A C E) ─┬─ (A C E G) GOAL
└─ (A C E D)
（出発点） （２節点） （３節点） （４節点）
図 : 幅優先探索
まず、出発点 A から一つ進んだ経路 (2 節点) をすべて求めます。この場合は、(A B) と (A C) の 2 つあり、これをすべて記憶しておきます。次に、これらの経路から一つ進めた経路 (3 節点) をすべて求めます。経路 (A B) は (A B C) と (A B D) へ進めることができますね。ほかの経路 (A C) も同様に進めて、すべての経路を記憶します。あとはこの作業をゴールに達するまで繰り返せばいいのです。
上図では、4 節点の経路 (A C E G) でゴールに達していることがわかります。このように幅優先探索では、最初に見つかった経路が最短距離 (または最小手数) となるのです。この性質は、すべての経路を平行に進めていく探索順序から考えれば当然のことといえるでしょう。このことからバックトラックの縦形探索に対して、幅優先探索は「横形探索」と呼ばれます。このあとも探索を繰り返せばすべての経路を求めることができます。
完成までの最小手数を求めるパズルを解く場合、幅優先探索を使ってみるといいでしょう。ただし、探索を進めるにしたがって、記憶しておかなければならないデータの総数が爆発的に増加する、つまりメモリを大量消費することに注意してください。
上図の場合ではメモリを大量消費することはありませんが、問題によってはマシンに搭載されているメモリが不足するため、幅優先探索を実行できない場合もあるでしょう。したがって、幅優先探索を使う場合は、メモリの消費量を抑える工夫も必要になります。
経路の管理はキューを使うと簡単です。幅優先探索でのキューの動作を下図に示します。
(1) ───── QUEUE ──────
┌── (A)
│ ───────────────
│
└─→ キューからデータを取り出す
(2) ───── QUEUE ──────
←─┐
─────────────── │
│
(A) の経路を進め (A B) ───┤
キューに追加する (A C) ───┘
(3) ───── QUEUE ──────
┌── (A B) (A C) ←─┐
│ ─────────────── │
│ │
└─→ (A B) の経路を進めキューに追加 │
(A B C) (A B D) ────────┘
(4) ───── QUEUE ──────
┌── (A C) (A B C) (A B D) ←─┐
│ ─────────────── │
│ │
└─→ キューに経路がある間繰り返す ──┘
図 : 幅優先探索とキューの動作
最初は、(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)))
(q 'enqueue! (list start))
(while (not (q 'empty?))
(let ((path (q 'dequeue!)))
(if (eq? goal (car path))
(format #t "~A~%" (reverse path))
(for-each
(lambda (x)
(if (not (member x path))
(q 'enqueue! (cons x path))))
(cdr (assoc (car path) *adjacent*))))))))
関数 breadth-first-search は start から goal までの経路を幅優先探索で求めます。最初に make-queue でキューを生成し、出発点 (start) だけの経路をキューに追加します。キューは拙作のページ Scheme プログラミング中級編 [4] で作成したプログラムを使いました。そして、キューにデータがある間、while ループで探索処理を続行します。経路をのばす処理はバックトラックのプログラムとほぼ同じです。ひとつのばした経路は enqueue! でキューに追加するところに注意してください。
それでは実行してみましょう。
gosh> (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)
結果を見ればおわかりのように、最初に見つかる経路が最短で、最後に見つかる経路が最長となります。当然ですが経路の総数は 4 通りになります。
幅優先探索は最短手数を求めるのに適したアルゴリズムですが、生成する局面数が多くなると大量のメモリを必要とします。このため、メモリが不足するときには使うことができないという欠点があります。逆に深さ優先探索の場合、メモリの消費量は少ないのですが、最初に見つかる解が最短手数とは限らないという問題点があります。
それでは、大量のメモリを使わずに最短手数を求める方法はないのでしょうか。実は、とても簡単な方法があるのです。それは、深さ優先探索の「深さ」に上限値を設定し、解が見つかるまで上限値を段階的に増やしていくという方法です。
たとえば、1 手で解が見つからない場合は 2 手までを探索し、それでも見つからない場合は 3 手までを探索するというように、制限値を 1 手ずつ増やしていくわけです。このアルゴリズムを「反復深化 (iterative deeping) 」といいます。
反復深化は最短手数を求めることができるアルゴリズムですが、幅優先探索と違って局面を保存する必要がないため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。ただし、同じ探索を何度も繰り返すため実行時間が増大する、という欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。
それでは、経路図で A から G までの経路を反復深化で求めてみましょう。反復深化のプログラムはとても簡単です。設定した上限値まで深さ優先探索を行う関数を作り、上限値を 1 手ずつ増やしてその関数を呼び出せばいいのです。プログラムは次のようになります。
リスト : 経路の探索 (3)
; 反復深化
(define (id-search start goal)
(define (search limit path)
(if (= limit (length path))
(if (eq? goal (car path))
(format #t "~A~%" (reverse path)))
(for-each
(lambda (x)
(if (not (member x path))
(search limit (cons x path))))
(cdr (assoc (car path) *adjacent*)))))
(let loop ((n 2))
(cond ((<= n 7)
(format #t "~D nodes~%" n)
(search n (list start))
(loop (+ n 1))))))
実際の処理は内部関数 search で行います。引数 limit が上限値を表します。search は limit まで深さ優先探索を行います。経路の長さを length で求めて、これが上限値 limit に達したら探索を打ち切ります。このとき goal に到達したかチェックします。あとは、limit の値を増やしながら search を呼び出せばいいわけです。
それでは実行結果を示しましょう。
gosh> (id-search 'A 'G) 2 nodes 3 nodes 4 nodes (A C E G) 5 nodes (A B C E G) (A B D E G) 6 nodes (A C B D E G) 7 nodes
結果を見ればおわかりのように、最初に見つかる解が最短手数になります。このプログラムではすべての経路を求めましたが、最短手数を求めるだけでよい場合は、解が見つかった時点で探索を終了すればいいでしょう。
;
; set.scm : 集合
;
; Copyright (C) 2008 Makoto Hiroi
;
(use srfi-1)
; 和
(define (union x y)
(cond ((null? x) y)
((member (car x) y)
(union (cdr x) y))
(else
(cons (car x) (union (cdr x) y)))))
; 積
(define (intersection x y)
(cond ((null? x) '())
((member (car x) y)
(cons (car x) (intersection (cdr x) y)))
(else
(intersection (cdr x) y))))
; 差
(define (set-difference x y)
(cond ((null? x) '())
((member (car x) y)
(set-difference (cdr x) y))
(else
(cons (car x) (set-difference (cdr x) y)))))
; 排他的論理和
(define (set-exclusive-or x y)
(set-difference (union x y) (intersection x y)))
; 部分集合
(define (subset? x y)
(cond ((null? x) #t)
((member (car x) y) (subset? (cdr x) y))
(else #f)))
; 重複した要素を取り除く
(define (remove-same-item ls)
(cond ((null? ls) '())
((member (car ls) (cdr ls))
(remove-same-item (cdr ls)))
(else
(cons (car ls) (remove-same-item (cdr ls))))))
; 集合
(define (make-set ls)
(let ((buff (remove-same-item ls)))
(lambda (msg . args)
(cond ((eq? msg 'union)
(make-set (union buff ((car args) 'get))))
((eq? msg 'intersection)
(make-set (intersection buff ((car args) 'get))))
((eq? msg 'difference)
(make-set (set-difference buff ((car args) 'get))))
((eq? msg 'exclusive-or)
(make-set (set-exclusive-or buff ((car args) 'get))))
((eq? msg 'subset?)
(subset? buff ((car args) 'get)))
((eq? msg 'get) buff)
((eq? msg 'member)
(if (member (car args) buff) #t #f))
((eq? msg 'insert!)
(if (not (member (car args) buff))
(set! buff (cons (car args) buff)))
#t)
((eq? msg 'delete!)
(set! buff (remove! (lambda (x) (equal? x (car args))) buff))
#t)
(else #f)))))
;
; keiro.scm : 経路の探索
;
; Copyright (C) 2008 Makoto Hiroi
;
; キュー
(define (make-queue)
(let ((front '()) (rear '()))
;
(define (enqueue! item)
(let ((new-cell (list item)))
(if (null? front)
; キューは空
(set! front new-cell)
; 最後尾のセルを書き換える
(set-cdr! rear new-cell))
(set! rear new-cell)))
;
(define (dequeue!)
(if (null? front)
#f
(let ((item (car front)))
(set! front (cdr front))
(if (null? front)
; キューは空になった
(set! rear '()))
item)))
:
(lambda (x . args)
(cond ((eq? x 'enqueue!)
(enqueue! (car args)))
((eq? x 'dequeue!)
(dequeue!))
((eq? x 'empty?)
(null? front))
(else #f)))))
; 経路図
;
; Ｂ───Ｄ───Ｆ
; ／│ │
; Ａ │ │
; ＼│ │
; Ｃ───Ｅ───Ｇ
; 連想リストで表現
(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)
(if (eq? goal (car path))
(format #t "~A~%" (reverse path))
(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)))
(q 'enqueue! (list start))
(while (not (q 'empty?))
(let ((path (q 'dequeue!)))
(if (eq? goal (car path))
(format #t "~A~%" (reverse path))
(for-each
(lambda (x)
(if (not (member x path))
(q 'enqueue! (cons x path))))
(cdr (assoc (car path) *adjacent*))))))))
; 反復深化
(define (id-search start goal)
(define (search limit path)
(if (= limit (length path))
(if (eq? goal (car path))
(format #t "~A~%" (reverse path)))
(for-each
(lambda (x)
(if (not (member x path))
(search limit (cons x path))))
(cdr (assoc (car path) *adjacent*)))))
(let loop ((n 2))
(cond ((<= n 7)
(format #t "~D nodes~%" n)
(search n (list start))
(loop (+ n 1))))))