リスト Xs を木とみなして、X と等しい要素 (葉) を探す関数 member_tree(X, Xs) を定義してください。
> yaep03:member_tree(d, [a, [b, [c, [d | e], f], g], h]). true > yaep03:member_tree(e, [a, [b, [c, [d | e], f], g], h]). true > yaep03:member_tree(a, [a, [b, [c, [d | e], f], g], h]). true > yaep03:member_tree(h, [a, [b, [c, [d | e], f], g], h]). true > yaep03:member_tree(x, [a, [b, [c, [d | e], f], g], h]). false
リスト Xs を木とみなして、要素 (葉) を数える関数 count_leaf(Xs) を定義してください。
> yaep03:count_leaf([a, [b, [c, [d | e], f], g], h]). 8 > yaep03:count_leaf_cps([a, [b, [c, [d | e], f], g], h]). 8
リスト Xs を木とみなして、X と等しい要素を Y に置換する関数 subst(X, Y, Xs) を定義してください。
> yaep03:subst(a, x, [a, [b, [c, [d | a], f], a], h]). [x,[b,[c,[d|x],f],x],h] > yaep03:subst_cps(a, x, [a, [b, [c, [d | a], f], a], h], fun(X) -> X end). [x,[b,[c,[d|x],f],x],h]
リスト Xs を挿入ソートする関数 insert_sort(Pred, Xs) を定義してください。
> yaep03:insert_sort(fun(X, Y) -> X < Y end, [5, 6, 4, 7, 3, 8, 2, 9, 1, 0]). [0,1,2,3,4,5,6,7,8,9] > yaep03:insert_sort(fun(X, Y) -> X > Y end, [5, 6, 4, 7, 3, 8, 2, 9, 1, 0]). [9,8,7,6,5,4,3,2,1,0]
リスト Xs をクイックソートする関数 quick_sort(Pred, Xs) を定義してください。
> yaep03:quick_sort(fun(X, Y) -> X < Y end, [5, 6, 4, 7, 3, 8, 2, 9, 1, 0]). [0,1,2,3,4,5,6,7,8,9] > yaep03:quick_sort(fun(X, Y) -> X > Y end, [5, 6, 4, 7, 3, 8, 2, 9, 1, 0]). [9,8,7,6,5,4,3,2,1,0]
リスト Xs のべき集合を求める関数 power_set(Xs) を定義してください。
たとえばリスト [a, b, c] のべき集合は [ ], [a], [b], [c], [a, b], [a, c], [b, c], [a, b, c] になります。
> yaep03:power_set([a, b, c]). [[],[c],[b],[b,c],[a],[a,c],[a,b],[a,b,c]] > yaep03:power_set1(fun io:write/1, [a, b, c]). [a,b,c][a,b][a,c][a][b,c][b][c][]ok
リスト Xs がリスト Ys の部分集合か判定する述語 subset(Xs, Ys) を定義してください。なお、並び方が異なるだけのリスト、たとえば [a, b] と [b, a] は同じ集合とします。
> yaep03:subset([a, b], [a, b, c]). true > yaep03:subset([b, a], [a, b, c]). true > yaep03:subset([b], [a, b, c]). true > yaep03:subset([], [a, b, c]). true > yaep03:subset([d], [a, b, c]). false
集合を表すリスト Xs, Ys の直積集合を求める述語 product(Xs, Ys) を定義してください。Xs の要素を xi, Ys 要素を yj とすると、直積集合の要素は {xi, yj} となります。たとえば、Xs = [a, b, c], Ys = [1, 2] とすると、直積集合は[{a, 1}, {a, 2}, {b, 1}, {b, 2}, {c, 1}, {c, 2}] になります。
> yaep03:product([a, b, c], [1, 2]).
[{a,1},{b,1},{c,1},{a,2},{b,2},{c,2}]
下記経路図において、スタート (A) からゴール (G) までの経路を求めるプログラムを「深さ優先探索」で作ってください。
Ｂ───Ｄ───Ｆ
／│ │
Ａ │ │
＼│ │
Ｃ───Ｅ───Ｇ
図 : 経路
> yaep03:dfs(g, [a]). [a,b,c,e,g] [a,b,d,e,g] [a,c,b,d,e,g] [a,c,e,g] ok
問題 59 の経路図において、スタート (A) からゴール (G) までの経路を求めるプログラムを「幅優先探索」で作ってください。
> yaep03:bfs(g, [[a]]). [a,c,e,g] [a,b,d,e,g] [a,b,c,e,g] [a,c,b,d,e,g] ok
問題 59 の経路図において、スタート (A) からゴール (G) までの経路を求めるプログラムを「反復深化」で作ってください。
> yaep03:ids(a, g). [a,c,e,g] [a,b,c,e,g] [a,b,d,e,g] [a,c,b,d,e,g] ok
1 から 9 までの数字を順番に並べ、間に + と - を補って 100 になる式を作ってください。
例：1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100
パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を「小町数」といいます。たとえば、123456789 とか 321654987 のような数字です。「小町算」というものもあり、たとえば 123 + 456 + 789 とか 321 * 654 + 987 のようなものです。問題は小町算の中でも特に有名なパズルです。
斗桶に油が 1 斗（= 10 升）あります。これを 5 升ずつ 2 つの油に分けたいのですが、手元には 7 升ますと 3 升ますが 1 つずつしかありません。この 2 つのますを使って油を二等分してください。
油分け算を「幅優先探索」で解くプログラムを作ってください。なお、油分け算は江戸時代の和算書『塵劫記（じんこうき）』にある問題です。
問題 63 の油分け算を「反復深化」で解くプログラムを作ってください。
「マスターマインド」は拙作のページ「お気楽 Scheme プログラミング入門」の数当てゲーム [2] で作成した、0 から 9 までの重複しない 4 つの数字からなる隠しコードを当てるゲームです。数字は合っているが位置が間違っている個数を cows で表し、数字も位置も合っている個数を bulls で表します。bulls が 4 になると正解です。
[6, 2, 8, 1] : 正解
-------------------------------------
1. [0, 1, 2, 3] : cows 2 : bulls 0
2. [1, 0, 4, 5] : cows 1 : bulls 0
3. [2, 3, 5, 6] : cows 2 : bulls 0
4. [3, 2, 7, 4] : cows 0 : bulls 1
5. [3, 6, 0, 8] : cows 2 : bulls 0
6. [6, 2, 8, 1] : cows 0 : bulls 4
図 : マスターマインドの動作例
マスターマインドを解くプログラムを作ってください。
リスト : 木の探索
member_tree(X, X, _) -> true;
member_tree(X, [Y | Ys], Cont) ->
member_tree(X,
Y,
fun(_) ->
member_tree(X, Ys, fun(Z) -> Cont(Z) end)
end);
member_tree(_, _, Cont) -> Cont(false).
member_tree(X, Xs) -> member_tree(X, Xs, fun(Y) -> Y end).
探索は member_tree/3 で行います。member_tree/3 は継続渡しスタイル (Continuation Passing Style : CPS) でプログラムしています。探索を続ける場合は、第 3 引数の継続 Cont を呼び出します。探索を打ち切る場合は Cont を呼び出さずに値をそのまま返します。
リストを二分木と考えると、リストの先頭要素が左部分木、残りのリストが右部分木に相当します。左右の部分木に対して member_tree を再帰呼び出しすればいいわけです。最初の節で、X と等しい要素が見つけたならば true を返します。そうでなければ、第 2 の節で左右の部分木をたどります。最後の節は X と等しくない要素の場合です。継続 Cont に false を渡して呼び出します。
リスト : 葉の個数を求める count_leaf([]) -> 0; count_leaf([X | Xs]) -> count_leaf(X) + count_leaf(Xs); count_leaf(_) -> 1. % 別解 count_leaf_cps([], Cont) -> Cont(0); count_leaf_cps([X | Xs], Cont) -> count_leaf_cps(X, fun(A) -> count_leaf_cps(Xs, fun(B) -> Cont(A + B) end) end); count_leaf_cps(_, Cont) -> Cont(1). count_leaf_cps(Xs) -> count_leaf_cps(Xs, fun(X) -> X end).
count_leaf も簡単です。第 1 引数が空リストならば 0 を返します。第 1 引数がリストならば左右の部分木にたいして count_leaf を再帰呼び出しし、その結果を足し算して返します。そうでなければ、引数は葉なので 1 を返します。別解は継続渡しスタイルで書き直したものです。
リスト : 木の置換 subst(X, Y, X) -> Y; subst(X, Y, [Z | Zs]) -> [subst(X, Y, Z) | subst(X, Y, Zs)]; subst(_, _, Z) -> Z. % 別解 subst_cps(X, Y, X, Cont) -> Cont(Y); subst_cps(X, Y, [Z | Zs], Cont) -> subst_cps(X, Y, Z, fun(A) -> subst_cps(X, Y, Zs, fun(B) -> Cont([A | B]) end) end); subst_cps(_, _, Z, Cont) -> Cont(Z). subst_cps(X, Y, Xs) -> subst_cps(X, Y, Xs, fun(Z) -> Z end).
subst も簡単です。第 3 引数が X と等しい場合は Y を返します。第 3 引数がリストならば左右の部分木にたいして subst を再帰呼び出しし、その結果をリストに格納して返します。それ以外の場合は第 3 引数 Z をそのまま返します。別解は継続渡しスタイルで書き直したものです。
挿入ソートの考え方はとても簡単です。ソート済みのリストに新しいデータを挿入していくことでソートを行います。たとえば、リスト [2, 4, 6] に 5 を挿入する場合、リストの要素 n と 5 を順番に比較して、5 < n を満たす位置に 5 を挿入すればいいわけです。この場合は、4 と 6 の間に 5 を挿入すればいいですね。
ソートするリストは、tl で分解していくと空リストになります。これをソート済みのリストと考えて、ここにデータを挿入していきます。プログラムは次のようになります。
リスト : 挿入ソート
insert_element(_, X, []) -> [X];
insert_element(Pred, X, [Y | Ys]) ->
case Pred(X, Y) of
true -> [X, Y | Ys];
false -> [Y | insert_element(Pred, X, Ys) ]
end.
insert_sort(_, []) -> [];
insert_sort(Pred, [X | Xs]) -> insert_element(Pred, X, insert_sort(Pred, Xs)).
リストにデータをひとつ挿入する関数が insert_element です。再帰呼び出しでリストをたどり、データ x を挿入する位置を探します。比較関数 Pred の返り値が真であれば、その位置にデータを挿入します。insert_sort は引数のリストを再帰呼び出しで分解します。空リストになると再帰呼び出しが停止します。そして、リストの先頭要素を insert_element でソート済みのリストに挿入します。
クイックソートはある値を基準にして、要素をそれより大きいものと小さいものの 2 つに分割していくことでソートを行います。基準になる値のことを「枢軸 (pivot) 」といいます。枢軸は要素の中から適当な値を選んでいいのですが、リストの場合は任意の箇所を簡単に選ぶことができません。この場合、いちばん簡単に求めることができる先頭の要素を枢軸とします。
リストを 2 つに分けたら、それらを同様にソートします。これは、再帰を使えば簡単に実現できます。その結果を枢軸を挟んで結合します。これを図に表すと次のようになります。
5 3 7 6 9 8 1 2 4
5 を枢軸に分割
(3 1 2 4) 5 (7 6 9 8)
3を枢軸に分割 7を枢軸に分割
(1 2) 3 (4) | 5 | (6) 7 (9 8)
・・・分割を繰り返していく・・・
図 : クイックソート
このようにリストを分割していくと、最後は空リストになります。ここが再帰の停止条件になります。あとは分割したリストを演算子 ++ で結合すればいいわけです。プログラムは次のようになります。
リスト : リストのクイックソート
quick_sort(_, []) -> [];
quick_sort(Pred, [X | Xs]) ->
{A, B} = partition(fun(Y) -> Pred(Y, X) end, Xs),
quick_sort(Pred, A) ++ [X] ++ quick_sort(Pred, B).
リストの分割は関数 partition で行います。引数 X が枢軸になります。あとは分割したリスト A, B を quick_sort でソートし、その結果を [X] を挟んで演算子 ++ で連結するだけです。
クイックソートの実行時間は、データ数を N とすると平均して N * log2 N に比例します。ところが、枢軸の選び方によっては、最悪で N の 2 乗に比例するまで劣化します。クイックソートはリストには不向きのアルゴリズムといえます。
リスト : べき集合 power_set([]) -> [[]]; power_set([X | Xs]) -> power_set(Xs) ++ [[X | Ys] || Ys <- power_set(Xs)]. % 別解 (高階関数版) power_set1(F, [], A) -> F(lists:reverse(A)); power_set1(F, [X | Xs], A) -> power_set1(F, Xs, [X | A]), power_set1(F, Xs, A). power_set1(F, Xs) -> power_set1(F, Xs, []).
べき集合を求める関数 power_set は簡単です。引数が空リストの場合は [ ] を格納したリストを返します。そうでなければ power_set を再帰呼び出しして Xs のべき集合を求め、その集合に先頭要素 (car ls) を追加します。そして、その集合と (cdr ls) のべき集合を演算子 ++ で連結します。
別解の power_set1 は高階関数バージョンです。リストの長さを N とすると、べき集合の要素数は 2 ^ N になります。N が大きくなると、べき集合をリストに格納して返すことは困難になります。その場合は高階関数を使うとよいでしょう。
リスト : 部分集合の判定
subset([], _) -> true;
subset([X | Xs], Ys) ->
case lists:member(X, Ys) of
true -> subset(Xs, Ys);
false -> false
end.
最初の節は「空集合は集合 Ys の部分集合である」ということを表しています。これが再帰呼び出しの停止条件となります。次の規則で、リストの先頭要素 X が Ys の要素であることを lists:member で確認し、それから Xs が Ys の部分集合であることを subset で確認すればいいわけです。
リスト : 直積集合
product(Xs, Ys) -> [{X, Y} || Y <- Ys, X <- Xs].
関数 product はリスト内包表記で Xs, Ys の要素を取り出して {X, Y} を生成するだけです。
経路はリストに頂点を格納して表すことにします。次の図を見てください。
A - B - D ─→ [a, b, d] ==> [d, b, a]
A - B - C - E ─→ [a, b, c, e] ==> [e, c, b, a]
逆順で管理する
図 : 経路の表し方
リストの最後尾にデータを追加するのは面倒なので、経路は上図のように逆順で管理することにします。プログラムは次のようになります。
リスト : 経路の探索 (1)
% 経路
adjacent(a) -> [b, c];
adjacent(b) -> [a, c, d];
adjacent(c) -> [a, b, e];
adjacent(d) -> [b, e, f];
adjacent(e) -> [c, d, g];
adjacent(f) -> [d];
adjacent(g) -> [e].
% 深さ優先探索
dfs(G, [G | Path]) ->
io:write(lists:reverse([G | Path])), io:nl();
dfs(G, [X | Path]) ->
lists:foreach(
fun (Y) ->
case lists:member(Y, Path) of
true -> false;
false -> dfs(G, [Y, X | Path])
end
end,
adjacent(X)).
関数 dfs の引数 G がゴール、第 2 引数のリストが経路を表します。最初の節で、リストの先頭要素が引数 G に等しい場合は、ゴールに到達したので経路を表示します。これが再帰呼び出しの停止条件になります。次の節で、リストの先頭から現在地点 X を取り出します。そして、関数 adjacent で X に隣接している地点を求めます。返り値はリストなので、list:foreach で要素を取り出して無名関数の引数 Y に渡します。その中で dfs を再帰呼び出しします。
このとき、経路に含まれている頂点を選んではいけません。そうしないと、同じ道をぐるぐると回る巡回経路が発生し、ゴールまでたどり着くことができなくなります。このチェックを関数 lists:member で行います。経路の中に頂点 Y がないことを確認してから、経路に Y を追加して dfs を再帰呼び出しします。
バックトラックによる探索は、経路を先へ先へ進めるので、「縦形探索」とか「深さ優先探索」と呼ばれています。このため、結果を見てもわかるように、最初に見つかる経路が最短経路とは限りません。最短経路を求めるのに適したアルゴリズムが「幅優先探索」です。
バックトラックによる探索は「深さ優先探索」や「縦形探索」とも呼ばれるように、一つの経路を先へ先へと進めていきます。このため最初に見つかる経路が最短経路であるとは限りません。幅優先探索は全ての経路について平行に探索を進めていくため、最初に見つかる経路が最短経路となります。それでは、同じ経路図を使って幅優先探索を具体的に説明しましょう。
幅優先探索の様子を下図に示します。
[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)
% 幅優先探索
bfs(_, []) -> ok;
bfs(Goal, [[Goal | Xs] | Ys]) ->
io:write(lists:reverse([Goal | Xs])), io:nl(), bfs(Goal, Ys);
bfs(Goal, [[X | Xs] | Ys]) ->
bfs(Goal, Ys ++ lists:foldl(fun(Y, A) ->
case lists:member(Y, Xs) of
true -> A;
false -> [[Y, X | Xs] | A]
end
end,
[],
adjacent(X))).
関数 bfs の引数 G がゴールを表し、第 2 引数のリストでキューを表します。最初の節で、キューが空になったら探索を終了します。これが再帰呼び出しの停止条件になります。次の節で、キューの先頭にある経路をチェックします。経路の先頭要素がゴールであれば、その経路を取り出して表示します。そのあと、bfs を再帰呼び出しすると、次の経路を求めることができます。
最後の節で、キューから先頭の経路を取り出し、foldr で新しい経路を生成し、それをキューの最後尾に連結します。無名関数の引数 Y が X に隣接する地点、A が累積変数です。lists:member で Y が経路 Xs に含まれていなければ、経路に Y を追加して、それを累積変数 A に追加します。そうでなければ A をそのまま返します。これで全ての経路を求めることができます。
幅優先探索は最短手数を求めるのに適したアルゴリズムですが、生成する局面数が多くなると大量のメモリを必要とします。このため、メモリが不足するときは、幅優先探索を使うことができません。深さ優先探索の場合、メモリの消費量は少ないのですが、最初に見つかる解が最短手数とは限らないという問題点があります。
それでは、大量のメモリを使わずに最短手数を求める方法はないのでしょうか。実は、とても簡単な方法があるのです。それは、深さ優先探索の「深さ」に上限値を設定し、解が見つかるまで上限値を段階的に増やしていく、という方法です。
たとえば、1 手で解が見つからない場合は、2 手までを探索し、それでも見つからない場合は 3 手までを探索する、というように制限値を 1 手ずつ増やしていくわけです。このアルゴリズムを「反復深化 (iterative deeping) 」といいます。
反復深化は最短手数を求めることができるアルゴリズムですが、幅優先探索と違って局面を保存する必要が無いため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。ただし、同じ探索を何度も繰り返すため実行時間が増大するという欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。
反復深化のプログラムはとても簡単です。設定した上限値まで深さ優先探索を行う関数を作り、上限値を１手ずつ増やしてその関数を呼び出せばいいのです。プログラムは次のようになります。
リスト : 経路の探索 (3)
% 反復深化
ids(Limit, Goal, Path) when length(Path) =:= Limit ->
if
hd(Path) =:= Goal -> io:write(lists:reverse(Path)), io:nl();
true -> false
end;
ids(Limit, Goal, Path) ->
lists:foreach(fun(N) ->
case lists:member(N, Path) of
true -> false;
false -> ids(Limit, Goal, [N | Path])
end
end,
adjacent(hd(Path))).
ids(Start, Goal) ->
lists:foreach(fun(Limit) -> ids(Limit, Goal, [Start]) end, iota(1, 7)).
関数 ids/3 の引数 Limit が上限値を表します。経路の長さが上限値 Limit に達したら探索を打ち切ります。このとき、ゴールに到達したかチェックします。あとは関数 ids/2 で、Limit の値を増やしながら ids/3 を呼び出せばいいわけです。
それではプログラムを作りましょう。式は次のようにリストで表すことにします。
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 => [1, +, 2, +, 3, -, 4, +, 5, +, 6, +, 78, +, 9]
Erlang の場合、+ と - をアトムとして扱うにはクオートで囲ってください。あとは、式を生成して値を計算するだけです。式を生成するとき、リストを逆順で管理すると簡単です。次の図を見てください。
[1] => [2, +, 1] => [3, +, 2, + 1]
=> [3, -, 2, + 1]
=> [23, +, 1]
=> [2, -, 1] => [3, +, 2, -, 1]
=> [3, -, 2, -, 1]
=> [23, -, 1]
=> [12] => [3, +, 12]
=> [3, -, 12]
=> [123]
式を生成するとき、リストに数字と演算子を順番に追加していきます。数字と +, - を追加する処理は簡単です。プログラムのポイントは数字を連結する処理、たとえば 1 と 2 を連結して一つの数値 12 にする処理です。この処理はリストの先頭の数字 1 を 12 (= 1 * 10 + 2) に置き換えることで実現できます。リストが [2, +, 1] であれば、数字 2 を 23 (= 2 * 10 + 3) に置き換えます。
プログラムは次のようになります。
リスト : 小町算
% 式の計算
calc_expr([], A) -> A;
calc_expr(['+', N | Expr], A) -> calc_expr(Expr, A + N);
calc_expr(['-', N | Expr], A) -> calc_expr(Expr, A - N).
calc_expr([X | Xs]) -> calc_expr(Xs, X).
% 式の生成
make_expr(10, Expr) ->
Expr1 = lists:reverse(Expr),
Value = calc_expr(Expr1),
if
Value =:= 100 -> io:write(Expr1), io:nl();
true -> false
end;
make_expr(N, [M | Expr]) ->
make_expr(N + 1, [N, '+', M | Expr]),
make_expr(N + 1, [N, '-', M | Expr]),
make_expr(N + 1, [M * 10 + N | Expr]).
komachi() -> make_expr(2, [1]).
関数 make_expr の引数 N が追加する数字、Expr が生成する式（リスト）です。N が 10 の場合、式がひとつ完成したので calc_expr を呼び出して式を計算します。その値が 100 であれば式を表示します。それ以外の場合は、make_expr を再帰呼び出しで式を生成します。この処理は簡単で、最初に N, '+' を追加した式を、次に N, '-' を追加した式を、最後に M を M * 10 + N に変換した式を生成します。
式の計算も簡単です。calc_expr/1 は calc_expr/2 を呼び出します。このとき、先頭の要素を累積変数にセットします。これで、リストの先頭は演算子になるので、'+', N であれば A + N を、'-', N であれば A - N を計算していくだけです。空リストになったら累積変数 A を返します。
それでは実行結果を示します。
> yaep03:komachi(). [1,'+',2,'+',3,'-',4,'+',5,'+',6,'+',78,'+',9] [1,'+',2,'+',34,'-',5,'+',67,'-',8,'+',9] [1,'+',23,'-',4,'+',5,'+',6,'+',78,'-',9] [1,'+',23,'-',4,'+',56,'+',7,'+',8,'+',9] [12,'+',3,'+',4,'+',5,'-',6,'-',7,'+',89] [12,'+',3,'-',4,'+',5,'+',67,'+',8,'+',9] [12,'-',3,'-',4,'+',5,'-',6,'+',7,'+',89] [123,'+',4,'-',5,'+',67,'-',89] [123,'+',45,'-',67,'+',8,'-',9] [123,'-',4,'-',5,'-',6,'-',7,'+',8,'-',9] [123,'-',45,'-',67,'+',89] false
全部で 11 通りの解が出力されます。ところで、今回は数式を表すリストをそのまま出力していますが、これを普通の数式で表示するとわかりやすくなるでしょう。興味のある方はプログラムを改造してみてください。
それではプログラムを作りましょう。斗桶 (A) と 7 升ます (B) と 3 升ます (C) の状態をタプル {A, B, C} で表すことにします。油分け算の場合、次に示す 3 通りの操作があります。
ますは 2 つあるので、操作は全部で 6 通りになります。この操作を関数 transfer1 - 6 で定義します。次のリストを見てください。
リスト : 油分け算 (1)
% A -> B
transfer1({A, B, C}, Mb, _) when Mb - B >= A -> {0, A + B, C};
transfer1({A, B, C}, Mb, _) -> {A - Mb + B, Mb, C}.
% A -> C
transfer2({A, B, C}, _, Mc) when Mc - C >= A -> {0, B, A + C};
transfer2({A, B, C}, _, Mc) -> {A - Mc + C, B, Mc}.
% B -> A
transfer3({A, B, C}, _, _) -> {A + B, 0, C}.
% C -> A
transfer4({A, B, C}, _, _) -> {A + C, B, 0}.
% B -> C
transfer5({A, B, C}, _, Mc) when Mc - C >= B -> {A, 0, B + C};
transfer5({A, B, C}, _, Mc) -> {A, B - Mc + C, Mc}.
% C -> B
transfer6({A, B, C}, Mb, _) when Mb - B >= C -> {A, B + C, 0};
transfer6({A, B, C}, Mb, _) -> {A, Mb, C - Mb + B}.
% 幅優先探索
abura(Goal, _, _, [[Goal | Gs] | _]) ->
io:format('~w~n', [lists:reverse([Goal | Gs])]);
abura(Goal, Mb, Mc, [[X | Xs] | Ys]) ->
abura(Goal, Mb, Mc, Ys ++ lists:foldl(
fun(F, A) ->
X1 = F(X, Mb, Mc),
case lists:member(X1, [X |Xs]) of
true -> A;
false -> [[X1, X | Xs] | A]
end
end,
[],
[fun transfer1/3, fun transfer2/3, fun transfer3/3,
fun transfer4/3, fun transfer5/3, fun transfer6/3])).
solve_abura() -> abura({5, 5, 0}, 7, 3, [[{10, 0, 0}]]).
関数の引数は状態を表すタプルと B の容量と C の容量です。油を注ぐとき、移動先の空き容量をチェックして、油がそれ以下ならば全部注ぎ、そうでなければ満杯になるまで注ぎます。B, C から A へ油を注ぐ場合は、空き容量をチェックする必要はありません。あとは幅優先探索でプログラムを作るだけです。
それでは実行結果を示します。
> yaep03:solve_abura().
[{10,0,0},{3,7,0},{3,4,3},{6,4,0},{6,1,3},{9,1,0},{9,0,1},{2,7,1},{2,5,3},{5,5,0}]
ok
最短手数は 9 手になりました。
リスト : 油分け算 (2)
% 反復深化
abura_id(Limit, Goal, _, _, Moves) when length(Moves) =:= Limit ->
if
hd(Moves) =:= Goal -> io:format('~w~n', [lists:reverse(Moves)]);
true -> false
end;
abura_id(Limit, Goal, Mb, Mc, Moves) ->
lists:foreach(fun(F) ->
X = F(hd(Moves), Mb, Mc),
case lists:member(X, Moves) of
true -> false;
false -> abura_id(Limit, Goal, Mb, Mc, [X | Moves])
end
end,
[fun transfer1/3, fun transfer2/3, fun transfer3/3,
fun transfer4/3, fun transfer5/3, fun transfer6/3]).
solve_abura_id() ->
lists:foreach(fun(N) -> abura_id(N, {5, 5, 0}, 7, 3, [{10, 0, 0}]) end,
iota(2, 10)).
反復深化のプログラムも簡単ですね。実行結果を示します。
> yaep03:solve_abura_id().
[{10,0,0},{3,7,0},{3,4,3},{6,4,0},{6,1,3},{9,1,0},{9,0,1},{2,7,1},{2,5,3},{5,5,0
}]
ok
それではプログラムを作りましょう。正解を見つける方法ですが、質問したコードとその結果を覚えておいて、それと矛盾しないコードを作るようにします。具体的には、4 つの数字の順列を生成し、それが今まで質問したコードと矛盾しないことを確かめます。これは生成検定法と同じですね。
矛盾しているかチェックする方法も簡単で、以前に質問したコードと比較して、bulls と cows が等しいときは矛盾していません。たとえば、次の例を考えてみてください。
[6, 2, 8, 1] が正解の場合
[0, 1, 2, 3] => bulls = 0, cows = 2
[0, 1, 2, 3] と比較する
--------------------------------------------------------
[0, X, X, X] 0 から始まるコードは bulls = 1
になるので矛盾する。
・・・・
[1, 0, 3, 4] cows = 3, bulls = 0 になるので矛盾する
・・・・
[1, 0, 4, 5] cows = 2, bulls = 0 で矛盾しない。
--------------------------------------------------------
[1, 0, 4, 5] => bulls = 0, cows = 1
次は、[0, 1, 2, 3] と [1, 0, 4, 5] に矛盾しない数字を選ぶ
図 : マスターマインドの推測アルゴリズム
[0, 1, 2, 3] で bulls が 0 ですから、その位置にその数字は当てはまりません。したがって、[0; X, X, X] というコードは [0, 1, 2, 3] と比較すると bulls が 1 となるので、矛盾していることがわかります。
次に [1, 0, 3, 4] というコードを考えてみます。[0, 1, 2, 3] の結果は cows が 2 ですから、その中で合っている数字は 2 つしかないわけです。ところが、[1, 0, 3, 4] と [0, 1, 2, 3] と比較すると cows が 3 になります。当たっている数字が 2 つしかないのに、同じ数字を 3 つ使うのでは矛盾していることになりますね。
次に [1, 0, 4, 5] というコードと比較すると、bulls が 0 で cows が 2 となります。これは矛盾していないので、このコードを質問することにします。その結果が bulls = 0, cows = 1 となり、今度は [0, 1, 2, 3] と [1, 0, 4, 5] に矛盾しないコードを選択するのです。
プログラムは次のようになります。
リスト : マスターマインドの解法
% bulls を求める
count_bulls([], []) -> 0;
count_bulls([X | Xs], [X | Ys]) -> 1 + count_bulls(Xs, Ys);
count_bulls([_ | Xs], [_ | Ys]) -> count_bulls(Xs, Ys).
% 同じ数字の個数を求める
count_same_number(Xs, Ys) -> length(intersection(Xs, Ys)).
% 矛盾しない質問かチェックする
check_query(_, []) -> true;
check_query(Code, [{Old_bulls, Old_cows, Old_code} | Qs]) ->
Bulls = count_bulls(Code, Old_code),
Cows = count_same_number(Code, Old_code) - Bulls,
if
Bulls =:= Old_bulls andalso Cows =:= Old_cows -> check_query(Code, Qs);
true -> false
end.
% マスターマインドの解法
mastermind(Code) ->
lists:foldl(
fun(Query, Qs) ->
case check_query(Query, Qs) of
true -> Bulls = count_bulls(Query, Code),
Cows = count_same_number(Query, Code) - Bulls,
io:format('~w : bulls ~w, cows ~w~n', [Query, Bulls, Cows]),
[{Bulls, Cows, Query} | Qs];
false -> Qs
end
end,
[],
permutation(4, iota(0, 9))),
ok.
関数 count_bulls は bulls の個数を求めます。関数 count_same_number は同じ数字の個数を求めます。今回は length(intersection(Xs, Ys)) で求めていますが、count_bulls のように再帰定義でプログラムすることも簡単です。count_same_number で求めた値から bulls を引くと cows を求めることができます。
関数 check_query は引数 Code が今まで質問したコードと矛盾していないかチェックします。今まで質問したコードは第 2 引数のリストに格納します。タプルの最初の要素が bulls の個数、次が cows の個数、最後が質問したコードです。次に、Code と Old_code を比較して、Bulls と Cows を求めます。この値が Old_bulls と Old_cows と一致すれば、Code は今までの質問と矛盾していません。check_query を再帰呼び出しして次のデータと比較します。どちらかの値が異なっていれば矛盾しているので false を返します。
関数 mastermind の引数 Code が正解のコードです。関数 permutation はリストの中から 4 個の要素を選ぶ順列を生成し、それをリストに格納して返します。あとは lists:foldl でコードを順番に取り出して、今まで質問したコードと矛盾していないか調べます。無名関数の引数 Qs が今までに質問したコードと結果を格納したリストで、Query が質問するコードです。check_query が true を返す場合、Query は矛盾していないので、Code と Query を比較して bulls と cows を求めます。そして、その結果を表示します。
あとは Qs に今回の結果を追加して返します。code が矛盾している場合は Qs をそのまま返すだけです。bulls が 4 ならば正解です。あとのコードはすべて矛盾することになるので、ここで処理を終了すべきところですが、このプログラムでは最後までチェックしています。興味のある方はプログラムを修正してください。
これでプログラムは完成です。それでは実行例を示しましょう。
> yaep03:mastermind([9, 8, 7, 6]). [0,1,2,3] : bulls 0, cows 0 [4,5,6,7] : bulls 0, cows 2 [5,4,8,9] : bulls 0, cows 2 [6,7,9,8] : bulls 0, cows 4 [8,9,7,6] : bulls 2, cows 2 [9,8,7,6] : bulls 4, cows 0 ok > yaep03:mastermind([9, 4, 3, 1]). [0,1,2,3] : bulls 0, cows 2 [1,0,4,5] : bulls 0, cows 2 [2,3,5,4] : bulls 0, cows 2 [3,4,0,6] : bulls 1, cows 1 [3,5,6,1] : bulls 1, cows 1 [6,5,0,2] : bulls 0, cows 0 [7,4,3,1] : bulls 3, cows 0 [8,4,3,1] : bulls 3, cows 0 [9,4,3,1] : bulls 4, cows 0 ok
肝心の質問回数ですが、5, 6 回で当たる場合が多いようです。実際に、5040 個のコードをすべて試してみたところ、平均は 5.56 回になりました。これは参考文献「数当てゲーム (MOO, マスターマインド)」の結果と同じです。質問回数の最大値は 9 回で、そのときのコードは [9, 4, 3, 1], [9, 2, 4, 1], [5, 2, 9, 3], [9, 2, 0, 4], [9, 2, 1, 4] でした。
なお、参考文献 [1] には平均質問回数がこれよりも少なくなる方法が紹介されています。単純な数当てゲームと思っていましたが、その奥はけっこう深いようです。興味のある方はいろいろ試してみてください。
%
% yaep03.erl : Yet Another Erlang Problems (3)
%
% Copyright (C) 2011-2024 Makoto Hiroi
%
-module(yaep03).
-export([member_tree/2, count_leaf/1, count_leaf_cps/1, subst/3, subst_cps/3, insert_sort/2]).
-export([quick_sort/2, power_set/1, power_set1/2, subset/2, product/2, dfs/2, bfs/2, ids/2]).
-export([komachi/0, solve_abura/0, solve_abura_id/0, mastermind/1]).
-import(yaep01, [iota/2, intersection/2]).
-import(yaep02, [partition/2, permutation/2]).
member_tree(X, X, _) -> true;
member_tree(X, [Y | Ys], Cont) ->
member_tree(X,
Y,
fun(_) ->
member_tree(X, Ys, fun(Z) -> Cont(Z) end)
end);
member_tree(_, _, Cont) -> Cont(false).
member_tree(X, Xs) -> member_tree(X, Xs, fun(Y) -> Y end).
count_leaf([]) -> 0;
count_leaf([X | Xs]) -> count_leaf(X) + count_leaf(Xs);
count_leaf(_) -> 1.
% 別解
count_leaf_cps([], Cont) -> Cont(0);
count_leaf_cps([X | Xs], Cont) ->
count_leaf_cps(X, fun(A) -> count_leaf_cps(Xs, fun(B) -> Cont(A + B) end) end);
count_leaf_cps(_, Cont) -> Cont(1).
count_leaf_cps(Xs) -> count_leaf_cps(Xs, fun(X) -> X end).
subst(X, Y, X) -> Y;
subst(X, Y, [Z | Zs]) -> [subst(X, Y, Z) | subst(X, Y, Zs)];
subst(_, _, Z) -> Z.
% 別解
subst_cps(X, Y, X, Cont) -> Cont(Y);
subst_cps(X, Y, [Z | Zs], Cont) ->
subst_cps(X, Y, Z, fun(A) -> subst_cps(X, Y, Zs, fun(B) -> Cont([A | B]) end) end);
subst_cps(_, _, Z, Cont) -> Cont(Z).
subst_cps(X, Y, Xs) -> subst_cps(X, Y, Xs, fun(Z) -> Z end).
insert_element(_, X, []) -> [X];
insert_element(Pred, X, [Y | Ys]) ->
case Pred(X, Y) of
true -> [X, Y | Ys];
false -> [Y | insert_element(Pred, X, Ys) ]
end.
insert_sort(_, []) -> [];
insert_sort(Pred, [X | Xs]) -> insert_element(Pred, X, insert_sort(Pred, Xs)).
quick_sort(_, []) -> [];
quick_sort(Pred, [X | Xs]) ->
{A, B} = partition(fun(Y) -> Pred(Y, X) end, Xs),
quick_sort(Pred, A) ++ [X] ++ quick_sort(Pred, B).
power_set([]) -> [[]];
power_set([X | Xs]) ->
power_set(Xs) ++ [[X | Ys] || Ys <- power_set(Xs)].
% 別解 (高階関数版)
power_set1(F, [], A) -> F(lists:reverse(A));
power_set1(F, [X | Xs], A) ->
power_set1(F, Xs, [X | A]), power_set1(F, Xs, A).
power_set1(F, Xs) -> power_set1(F, Xs, []).
subset([], _) -> true;
subset([X | Xs], Ys) ->
case lists:member(X, Ys) of
true -> subset(Xs, Ys);
false -> false
end.
product(Xs, Ys) -> [{X, Y} || Y <- Ys, X <- Xs].
% 経路
adjacent(a) -> [b, c];
adjacent(b) -> [a, c, d];
adjacent(c) -> [a, b, e];
adjacent(d) -> [b, e, f];
adjacent(e) -> [c, d, g];
adjacent(f) -> [d];
adjacent(g) -> [e].
% 深さ優先探索
dfs(G, [G | Path]) ->
io:write(lists:reverse([G | Path])), io:nl();
dfs(G, [X | Path]) ->
lists:foreach(
fun (Y) ->
case lists:member(Y, Path) of
true -> false;
false -> dfs(G, [Y, X | Path])
end
end,
adjacent(X)).
% 幅優先探索
bfs(_, []) -> ok;
bfs(Goal, [[Goal | Xs] | Ys]) ->
io:write(lists:reverse([Goal | Xs])), io:nl(), bfs(Goal, Ys);
bfs(Goal, [[X | Xs] | Ys]) ->
bfs(Goal, Ys ++ lists:foldl(fun(Y, A) ->
case lists:member(Y, Xs) of
true -> A;
false -> [[Y, X | Xs] | A]
end
end,
[],
adjacent(X))).
% 反復深化
ids(Limit, Goal, Path) when length(Path) =:= Limit ->
if
hd(Path) =:= Goal -> io:write(lists:reverse(Path)), io:nl();
true -> false
end;
ids(Limit, Goal, Path) ->
lists:foreach(fun(N) ->
case lists:member(N, Path) of
true -> false;
false -> ids(Limit, Goal, [N | Path])
end
end,
adjacent(hd(Path))).
ids(Start, Goal) ->
lists:foreach(fun(Limit) -> ids(Limit, Goal, [Start]) end, iota(1, 7)).
% 式の計算
calc_expr([], A) -> A;
calc_expr(['+', N | Expr], A) -> calc_expr(Expr, A + N);
calc_expr(['-', N | Expr], A) -> calc_expr(Expr, A - N).
calc_expr([X | Xs]) -> calc_expr(Xs, X).
% 式の生成
make_expr(10, Expr) ->
Expr1 = lists:reverse(Expr),
Value = calc_expr(Expr1),
if
Value =:= 100 -> io:write(Expr1), io:nl();
true -> false
end;
make_expr(N, [M | Expr]) ->
make_expr(N + 1, [N, '+', M | Expr]),
make_expr(N + 1, [N, '-', M | Expr]),
make_expr(N + 1, [M * 10 + N | Expr]).
komachi() -> make_expr(2, [1]).
% A -> B
transfer1({A, B, C}, Mb, _) when Mb - B >= A -> {0, A + B, C};
transfer1({A, B, C}, Mb, _) -> {A - Mb + B, Mb, C}.
% A -> C
transfer2({A, B, C}, _, Mc) when Mc - C >= A -> {0, B, A + C};
transfer2({A, B, C}, _, Mc) -> {A - Mc + C, B, Mc}.
% B -> A
transfer3({A, B, C}, _, _) -> {A + B, 0, C}.
% C -> A
transfer4({A, B, C}, _, _) -> {A + C, B, 0}.
% B -> C
transfer5({A, B, C}, _, Mc) when Mc - C >= B -> {A, 0, B + C};
transfer5({A, B, C}, _, Mc) -> {A, B - Mc + C, Mc}.
% C -> B
transfer6({A, B, C}, Mb, _) when Mb - B >= C -> {A, B + C, 0};
transfer6({A, B, C}, Mb, _) -> {A, Mb, C - Mb + B}.
% 幅優先探索
abura(Goal, _, _, [[Goal | Gs] | _]) ->
io:format('~w~n', [lists:reverse([Goal | Gs])]);
abura(Goal, Mb, Mc, [[X | Xs] | Ys]) ->
abura(Goal, Mb, Mc, Ys ++ lists:foldl(
fun(F, A) ->
X1 = F(X, Mb, Mc),
case lists:member(X1, [X |Xs]) of
true -> A;
false -> [[X1, X | Xs] | A]
end
end,
[],
[fun transfer1/3, fun transfer2/3, fun transfer3/3,
fun transfer4/3, fun transfer5/3, fun transfer6/3])).
solve_abura() -> abura({5, 5, 0}, 7, 3, [[{10, 0, 0}]]).
% 反復深化
abura_id(Limit, Goal, _, _, Moves) when length(Moves) =:= Limit ->
if
hd(Moves) =:= Goal -> io:format('~w~n', [lists:reverse(Moves)]);
true -> false
end;
abura_id(Limit, Goal, Mb, Mc, Moves) ->
lists:foreach(fun(F) ->
X = F(hd(Moves), Mb, Mc),
case lists:member(X, Moves) of
true -> false;
false -> abura_id(Limit, Goal, Mb, Mc, [X | Moves])
end
end,
[fun transfer1/3, fun transfer2/3, fun transfer3/3,
fun transfer4/3, fun transfer5/3, fun transfer6/3]).
solve_abura_id() ->
lists:foreach(fun(N) -> abura_id(N, {5, 5, 0}, 7, 3, [{10, 0, 0}]) end,
iota(2, 10)).
% bulls を求める
count_bulls([], []) -> 0;
count_bulls([X | Xs], [X | Ys]) -> 1 + count_bulls(Xs, Ys);
count_bulls([_ | Xs], [_ | Ys]) -> count_bulls(Xs, Ys).
% 同じ数字の個数を求める
count_same_number(Xs, Ys) -> length(intersection(Xs, Ys)).
% 矛盾しない質問かチェックする
check_query(_, []) -> true;
check_query(Code, [{Old_bulls, Old_cows, Old_code} | Qs]) ->
Bulls = count_bulls(Code, Old_code),
Cows = count_same_number(Code, Old_code) - Bulls,
if
Bulls =:= Old_bulls andalso Cows =:= Old_cows -> check_query(Code, Qs);
true -> false
end.
% マスターマインドの解法
mastermind(Code) ->
lists:foldl(
fun(Query, Qs) ->
case check_query(Query, Qs) of
true -> Bulls = count_bulls(Query, Code),
Cows = count_same_number(Query, Code) - Bulls,
io:format('~w : bulls ~w, cows ~w~n', [Query, Bulls, Cows]),
[{Bulls, Cows, Query} | Qs];
false -> Qs
end
end,
[],
permutation(4, iota(0, 9))),
ok.