リスト Ls を木とみなして、X と等しい要素 (葉) を探す述語 member_tree(X, Ls) を定義してください。
?- member_tree(5, [1, 2, [3, 4, [5, 6], 7], 8]). true ; false. ?- member_tree(X, [1, 2, [3, 4, [5, 6], 7], 8]). X = 1 ; X = 2 ; X = 3 ; X = 4 ; X = 5 ; X = 6 ; X = 7 ; X = 8 ; false.
リスト Ls を木とみなして、要素 (葉) を数える述語 count_leaf(Ls, N) を定義してください。
18 ?- count_leaf([1, 2, [3, 4, [5, 6], 7], 8], X). X = 8 ; false.
リスト Ls を木とみなして、X と等しい要素を Y に置換する述語 subst(X, Y, Ls, Zs) を定義してください。
?- subst(5, 50, [1, 2, [3, 4, [5, 6], 7], 8], X). X = [1, 2, [3, 4, [50, 6], 7], 8] ; false.
リスト Xs から N 個の要素を選ぶ順列を求める述語 permutation(N, Xs, Ys) を定義してください。
?- permutation(3, [a, b, c], X). X = [a, b, c] ; X = [a, c, b] ; X = [b, a, c] ; X = [b, c, a] ; X = [c, a, b] ; X = [c, b, a] ; false.
リスト Xs から重複を許して N 個の要素を選ぶ順列を求める述語 repeat_perm(N, Xs, Ys) を定義してください。
13 ?- repeat_perm(2, [a, b, c], X). X = [a, a] ; X = [a, b] ; X = [a, c] ; X = [b, a] ; X = [b, b] ; X = [b, c] ; X = [c, a] ; X = [c, b] ; X = [c, c] ; false.
n 個の中から r 個を選ぶ組み合わせの数 nＣr を求める述語 comb_num(N, R, X) を定義してください。
?- comb_num(5, 3, X). X = 10 ; false. ?- comb_num(10, 5, X). X = 252 ; false.
リスト Xs から N 個の要素を選ぶ組み合わせを求める述語 combination(N, Xs,Ys) を定義してください。
?- combination(3, [a, b, c, d, e], X). X = [a, b, c] ; X = [a, b, d] ; X = [a, b, e] ; X = [a, c, d] ; X = [a, c, e] ; X = [a, d, e] ; X = [b, c, d] ; X = [b, c, e] ; X = [b, d, e] ; X = [c, d, e] ; false.
リスト Xs から重複を許して N 個の要素を選ぶ組み合わせを求める述語 repeat_comb(N, Xs,Ys) を定義してください。
?- repeat_comb(3, [a, b, c, d], X). X = [a, a, a] ; X = [a, a, b] ; X = [a, a, c] ; X = [a, a, d] ; X = [a, b, b] ; X = [a, b, c] ; X = [a, b, d] ; X = [a, c, c] ; X = [a, c, d] ; X = [a, d, d] ; X = [b, b, b] ; X = [b, b, c] ; X = [b, b, d] ; X = [b, c, c] ; X = [b, c, d] ; X = [b, d, d] ; X = [c, c, c] ; X = [c, c, d] ; X = [c, d, d] ; X = [d, d, d] ; false.
リスト Xs を N 番目の要素で二分割する述語 split_nth(Xs, N, As, Bs) を定義してください。
?- split_nth([1, 2, 3, 4, 5, 6], 3, X, Y). X = [1, 2] Y = [3, 4, 5, 6] ; false.
リスト Xs を奇数番目の要素と偶数番目の要素に分ける述語 partition(Xs, Os, Es) を定義してください。
?- partition([a, b, c, d, e, f], X, Y). X = [a, c, e], Y = [b, d, f].
X と等しい要素の位置でリスト Xs を二分割する述語 split_find(X, Xs, Ys, Zs) を定義してください。
?- split_find(c, [a, b, c, d, e, f], X, Y). X = [a, b], Y = [c, d, e, f] ; false.
リスト Xs を X よりも大きい要素と X 以下の要素に分ける述語 split_ge(X, Xs, Ls, Bs) を定義してください。
split_ge(3, [1, 3, 5, 2, 4, 6], X, Y). X = [1, 3, 2], Y = [5, 4, 6] ; false.
リスト Xs の中で連続した等しい記号を部分リストにまとめる述語 pack(Xs, Ys) を定義してください。
pack([a, a, b, b, b, c, d, d, d, d], X). X = [[a, a], [b, b, b], [c], [d, d, d, d]].
整列済みの整数を表すリストで、連続している部分列を [Start | End] に置き換える述語 pack_num_list(Xs, Ys) を定義してください。Start は部分列の始点、End は部分列の終点を表します。
?- pack_num_list([1, 2, 3, 4, 6, 8, 9], X). X = [[1 | 4], 6, [8 | 9]] ; false.
なお、この問題は下記サイトを参考にさせていただきました。関係各位に感謝いたします。
問題 39 の逆変換を行う述語 expand_num_list(Xs, Ys) を定義してください。
?- expand_num_list([[1 | 4], 6, [8 | 9]], X). X = [1, 2, 3, 4, 6, 8, 9] ; false.
連続している同じ記号を [Code, Num] に変換する述語 encode(Xs, Ys) を定義してください。Code は記号、Num は個数を表します。このような変換を「ランレングス符号化」といいます。
?- encode([a, a, a, b, b, c, d, d, d, d], X). X = [[a, 3], [b, 2], [c, 1], [d, 4]] ; false.
問題 41 の逆変換を行う述語 decode(Xs, Ys) を定義してください。
?- decode([[a, 3], [b, 2], [c, 1], [d, 4]], X). X = [a, a, a, b, b, c, d, d, d, d] ; false.
整数値 X, Y の最大公約数を求める述語 gcd(X, Y, Gcd) を定義してください。
?- gcd(42, 30, X). X = 6 ; false.
整数値 X, Y の最小公倍数を求める述語 lcm(X, Y, Lcm) を定義してください。
?- lcm(14, 35, L). L = 70 ; false.
分数を ratio(P, Q) を表すことにします。P, Q は整数値とし、P が分子で Q が分母です。符号は分子 P に付けるものとします。分数 Ratio を生成する述語 make_ratio(P, Q, Ratio) を定義してください。
?- make_ratio(2, 4, X). X = raito(1, 2) ; false. ?- make_ratio(9, 3, X). X = raito(3, 1) ; false.
分数の四則演算を行う述語 addr, subr, mulr, divr を定義してください。
?- addr(ratio(1, 3), ratio(1, 4), X). X = ratio(7, 12) ; false. ?- subr(ratio(1, 3), ratio(1, 4), X). X = ratio(1, 12) ; false. ?- mulr(ratio(1, 3), ratio(1, 4), X). X = ratio(1, 12) ; false. ?- divr(ratio(1, 3), ratio(1, 4), X). X = ratio(4, 3) ; false.
パズル「小町分数」を解くプログラムを作ってください。
下図の A から I の場所に 1 から 9 までの数字をひとつずつ配置します。3 つの分数を足すと 1 / N になる配置を求めてください。
このパズルの元ネタは N = 1 の場合で、参考文献『超々難問数理パズル 解けるものなら解いてごらん』に掲載されています。
3 行 3 列の魔方陣を解くプログラムを作ってください。
┌─┬─┬─┐ 式
│Ａ│Ｂ│Ｃ│ A + B + C = N, A + E + I = N
├─┼─┼─┤ D + E + F = N, C + E + G = N
│Ｄ│Ｅ│Ｆ│ G + H + I = N
├─┼─┼─┤ A + D + G = N
│Ｇ│Ｈ│Ｉ│ B + E + H = N
└─┴─┴─┘ C + F + I = N
図 : 魔方陣
上図の A から I の場所に 1 から 9 までの数字をひとつずつ配置します。縦横斜めの合計が等しくなるように数字を配置してください。
計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。覆面算 WRONG * M = RIGHT を解くプログラムを作ってください。なお、今回は使用する数字を 1 から 9 までとします。
W R O N G * M ------------ R I G H T 図 : 小町覆面算
自然数 N 以下の素数をすべて求める述語 sieve(N, Xs) を作ってください。
?- sieve(25, X). X = [2, 3, 5, 7, 11, 13, 17, 19, 23] ; false.
リスト : 木の探索 member_tree(X, X) :- X \= [], atomic(X). member_tree(X, [L | _]) :- member_tree(X, L). member_tree(X, [_ | R]) :- member_tree(X, R).
木の探索は簡単です。リストを二分木と考えると、リストの先頭要素が左部分木、残りのリストが右部分木に相当します。左右の部分木に対して、member_tree を再帰呼び出しすればいいわけです。今回は葉を探索するので、X とマッチングしたら、それがリストではないことを確認します。
ちなみに、最初の規則を member_tree(X, X). に変更すると、葉だけではなく部分木も探索することができます。動作は次のようになります。
?- member_tree([c, d], [a, [b, [c, d], e], f]). true ; false. ?- member_tree(X, [a, [b, [c, d], e], f]). X = [a, [b, [c, d], e], f] ; X = a ; X = [[b, [c, d], e], f] ; X = [b, [c, d], e] ; X = b ; X = [[c, d], e] ; X = [c, d] ; X = c ; X = [d] ; X = d ; X = [] ; X = [e] ; X = e ; X = [] ; X = [f] ; X = f ; X = [] ; false.
このように、member_tree で部分木を取り出すこともできます。空リストとマッチングさせたくない場合は、最初の規則を member_tree(X, X) :- X \= []. とすればいいでしょう。
リスト : 葉の個数を求める
count_leaf([], 0).
count_leaf(X, 1) :- X \= [], atomic(X).
count_leaf([X | Xs], N) :-
count_leaf(X, M1),
count_leaf(Xs, M2),
N is M1 + M2.
count_leaf も簡単です。最初の規則は、空リストの要素は 0 であることを表しています。次の規則で、X が空リストではなくアトムであれば、要素数は 1 であることを表しています。最後の規則で、左右の部分木の葉の個数を count_leaf で求め、その値を足し算したものが求める葉の個数になります。
リスト : 木の置換
subst(X, Y, X, Y) :- !.
subst(X, _, Z, Z) :- atomic(Z), X \= Z.
subst(X, Y, [Ls | Rs], [Ls1 | Rs1]) :-
subst(X, Y, Ls, Ls1), subst(X, Y, Rs, Rs1).
最初の規則が置換する要素を見つけた場合です。この場合は X を Y に置換します。2 番目の規則は、Z が X と等しくない場合です。この場合は置換しないで Z のままです。最後の規則で、木を左右の部分木に分解して subst で置換します。そして、置換した部分木を頭部の [Ls1 | Rs1] で組み立てます。
リスト : 順列の生成
permutation(0, Xs, Xs).
permutation(N, Xs, [X | Ys]) :-
N > 0, N1 is N - 1, select(X, Xs, Zs), permutation(N1, Zs, Ys).
順列の生成は拙作のページ「8 クイーン」で説明しています。permutation は N が 0 になるまで select で Xs から要素を取り出して順列を生成します。
リスト : 重複順列
repeat_perm(0, _, []).
repeat_perm(N, Xs, [X | Ys]) :-
N > 0, N1 is N - 1, member(X, Xs), repeat_perm(N1, Xs, Ys).
重複順列も簡単です。選んだ要素を取り除く必要がないので、select のかわりに member 使って要素を順番に選択していくだけです。
組み合わせの数を \({}_n \mathrm{C}_r\) と表記します。\({}_n \mathrm{C}_r\) を求めるには、次の公式を使えば簡単です。
皆さんお馴染みの公式ですね。ところが、整数値の範囲が限られているプログラミング言語では、この公式を使うと乗算で「桁あふれ」を起こす恐れがあります。Haskell は多倍長演算をサポートしているので、桁あふれを心配する必要はありません。
この公式をそのままプログラムすることもできますが、次の式を使うともっと簡単にプログラムできます。
この式は \({}_n \mathrm{C}_r\) と \({}_n \mathrm{C}_{r-1}\) の関係を表しています。あとは再帰定義を使って簡単にプログラムできます。
リスト : 組み合わせの数 comb_num(_,0,1). comb_num(N, N, 1) :- N > 0. comb_num(N, R, M) :- R > 0, N =\= R, R1 is R - 1, comb_num(N, R1, A), M is A * (N - R + 1) / R.
組み合わせの生成は、次に示す組み合わせの公式と同じ考え方でプログラムすることができます。
プログラムは次のようになります。
リスト : 組み合わせの生成 combination(0, _, []). combination(N, [X | Xs], [X | Zs]) :- N > 0, N1 is N - 1, combination(N1, Xs, Zs). combination(N, [_ | Xs], Zs) :- N > 0, combination(N, Xs, Zs).
最初の規則は個数 N が 0 の場合です。選択する要素がないので空リストになります。次の規則はリストの先頭要素 X を選ぶ場合です。残りのリスト Xs から N - 1 個の要素を選び、その組み合わせのリスト Zs の先頭に X を追加します。最後の規則がリストの先頭要素を選ばない場合です。残りのリスト Xs から N 個の要素を選びます。
リスト : 重複組み合わせ
repeat_comb(0, _, []).
repeat_comb(N, [X | Xs], [X | Zs]) :-
N > 0, N1 is N - 1, repeat_comb(N1, [X | Xs], Zs).
repeat_comb(N, [_ | Xs], Zs) :- N > 0, repeat_comb(N, Xs, Zs).
重複組み合わせを求める repeat_comb は簡単です。2 番目の規則で、リストの先頭要素を選んだら、その要素を取り除かないで、そこから N - 1 個の要素を選ぶようにします。これで同じ要素を何回も選ぶことができます。
リスト : N 番目の要素で分割する
split_nth(Xs, N, As, Bs) :-
N > 0, N1 is N - 1, take(Xs, N1, As), drop(Xs, N1, Bs).
split_nth は take と drop を使うと簡単です。take で先頭から N - 1 個の要素を取り出し、drop で先頭から N - 1 個の要素を取り除くだけです。
リスト : リストの要素を偶数番目と奇数番目で分ける partition(Xs, Os, Es) :- odd_part(Xs, Os, Es). odd_part([], [], []). odd_part([X | Xs], [X | Os], Es) :- even_part(Xs, Os, Es). even_part([],[],[]). even_part([X | Xs], Os, [X | Es]) :- odd_part(Xs, Os, Es). % 別解 partition(Xs, Os, Es) :- part_sub(Xs, Os, Es, 1). part_sub([], [], [], _). part_sub([X | Xs], Os, [X | Es], 0) :- part_sub(Xs, Os, Es, 1). part_sub([X | Xs], [X | Os], Es, 1) :- part_sub(Xs, Os, Es, 0).
奇数番目の要素は odd_part で、偶数番目の要素は even_part で取り出すと簡単です。この場合、odd_part と even_part は相互再帰になります。別解は末尾再帰でプログラムしたもので、part_sub/4 の第 4 引数で奇数番目と偶数番目を判別しています。
リスト : X と等しい要素の位置で分割 split_find(X, [X | Xs], [], [X | Xs]). split_find(X, [Y | Ys], [Y | As], Bs) :- split_find(X, Ys, As, Bs). % 別解 split_find(X, Xs, As, [X | Ys]) :- append(As, [X | Ys], Xs).
最初の規則は、リストの先頭要素が X と等しい場合です。空リストとリスト [X | Xs] に分割します。次の規則で、先頭要素 Y を取り除いたリスト Ys から X と等しい要素を探します。そして、Y をリスト As の先頭に追加します。別解は append を使った方法で、As と [X | Ys] を連結すると Xs になることを表しています。
リスト : リストを X よりも大きい要素と X 以下の要素に分ける split_ge(_, [], [], []). split_ge(X, [Y | Ys], Ls, [Y | Bs]) :- X < Y, split_ge(X, Ys, Ls, Bs). split_ge(X, [Y | Ys], [Y | Ls], Bs) :- X >= Y, split_ge(X, Ys, Ls, Bs).
最初の規則が再帰の停止条件です。次の規則で、リストの先頭要素 Y が X よりも大きい場合は、Y をリスト Bs の先頭に追加します。Bs は X よりも大きい要素を格納します。最後の規則で、Y が X 以下の場合はリスト Ls の先頭に追加します。Ls は X 以下の要素を格納します。
リスト : 連続した同じ記号を部分リストにまとめる pack([X | Xs], Ys) :- pack(Xs, [[X]], Ys). pack([], Xs, Ys) :- reverse(Xs, Ys). pack([X | Xs], [[X | Ys] | Ls], Zs) :- !, pack(Xs, [[X, X | Ys] | Ls], Zs). pack([X | Xs], Ys, Zs) :- pack(Xs, [[X] | Ys], Zs).
pack/2 の処理は pack/3 で行います。pack/3 の第 2 引数が累積変数です。2 番目の規則が再帰の停止条件です。パックされたデータは累積変数 Xs に逆順で格納されるので、reverse で Xs を反転します。3 番目の規則で、リストの要素 X が累積変数に格納されている要素と等しい場合は X を累積変数に追加します。そうでなければ、最後の規則でリストの先頭要素 X をリストに格納して累積変数に追加します。
リスト : 連続している数列を [S | E] で表す
pack_num_list([X | Xs], Ys) :- pack_num_list(Xs, [X], Ys).
pack_num_list([], Xs, Ys) :- reverse(Xs, Ys).
pack_num_list([X | Xs], [[S | E] | Ys], Zs) :-
X =:= E + 1, pack_num_list(Xs, [[S | X] | Ys], Zs).
pack_num_list([X | Xs], [[S | E] | Ys], Zs) :-
X =\= E + 1, pack_num_list(Xs, [X, [S | E] | Ys], Zs).
pack_num_list([X | Xs], [Y | Ys], Zs) :-
X =:= Y + 1, pack_num_list(Xs, [[Y | X] | Ys], Zs).
pack_num_list([X | Xs], [Y | Ys], Zs) :-
X=\= Y + 1, pack_num_list(Xs, [X, Y | Ys], Zs).
pack/2 と同様に pack_num_list/2 も実際の処理は pack_num_list/3 で行います。第 2 引数が累積変数になります。2 番目の規則が再帰の停止条件で、累積変数 Xs を reverse で反転します。
3, 4 番目の規則は、連続している数列を変換する処理です。累積変数には連続している数列を表す [S | E] が格納されています。リストの先頭要素 X が E + 1 と等しい場合は、E を X に置き換えて pack_num_list を再帰呼び出しします。そうでなければ、数列は連続していないので、X を累積変数に追加します。
5, 6 番目の規則は、数列が連続していない場合の処理です。累積変数には数値 Y が格納されています。リストの先頭要素 X が Y + 1 と等しい場合は、Y を [Y | X] に置き換えて、pack_num_list を再帰呼び出しします。そうでなければ、Y を累積変数に追加します。
リスト : [S | E] を数列に戻す
expand_num_list([], []).
expand_num_list([[S | E] | Xs], Zs) :-
expand_num_list(Xs, Ys), iota(S, E, Ls), append(Ls, Ys, Zs).
expand_num_list([X | Xs], [X | Zs]) :-
integer(X), expand_num_list(Xs, Zs).
expand_num_list は iota を使うと簡単です。最初の規則が再帰の停止条件です。次の規則で、[S | E] を iota で数列に変換します。expand_num_list を再帰呼び出しして残りのリスト Xs を数列に戻し、そのリスト Ys と iota で変換したリスト Ls を append で連結します。最後の規則はリストの要素 X が数値の場合で、残りのリスト Xs を数列に変換したリスト Zs の先頭に X を追加します。
リスト : ランレングス符号化
drop_same_code([_], [], 1).
drop_same_code([X, Y | Ys], [Y | Ys], 1) :- X \= Y.
drop_same_code([X, X | Xs], Ys, N) :-
drop_same_code([X | Xs], Ys, M), N is M + 1.
encode([], []).
encode([X | Xs], [[X, N] | Ls]) :-
drop_same_code([X | Xs], Ys, N), encode(Ys, Ls).
リストの先頭から連続している記号を述語 drop_same_code(Xs, Ys, N) で取り除きます。このとき、その個数もカウントします。第 2 引数 Ys が連続した同じ記号を取り除いたリスト、第 3 引数 N が取り除いた記号の個数です。
最初の規則で、リストの要素が一つしかない場合は、それを取り除きます。残りのリストは空リストで、個数は 1 になります。次の規則は、先頭の要素 X と次の要素 Y が異なる場合です。残りのリストは [Y | Ys] になり、個数は 1 になります。この 2 つの規則が再帰の停止条件になります。最後の規則は、リストの先頭要素と 2 番目の要素が等しい場合です。drop_same_code を再帰呼び出しして個数 M を求め、そこに 1 を加算します。
encode は簡単です。drop_same_code で連続している記号の個数 N を求めます。そして、encode を再帰呼び出しした結果に [X, N] を追加するだけです。
リスト : ランレングス復号
fill_list(_, 0, []).
fill_list(X, N, [X | Xs]) :-
N > 0, N1 is N - 1, fill_list(X, N1, Xs).
decode([], []).
decode([[Code, N] | Xs], Zs) :-
decode(Xs, Ys), fill_list(Code, N, Ls), append(Ls, Ys, Zs).
ランレングスの復号は述語 fill_list(X, N, Ls) を定義すると簡単です。fill_list は要素 X を N 個格納したリスト Ls を生成します。decode は記号 Code とその個数 N を取り出して、残りのリスト Xs を decode で復号します。次に、fill_list でリスト Ls を生成し、それと復号したリスト Ys を append で連結します。
リスト : 最大公約数
gcd(A, 0, A).
gcd(A, B, G) :-
B > 0, C is A mod B, gcd(B, C, G).
最大公約数は「ユークリッドの互除法」を使うと簡単に求めることができます。
[ユークリッドの互除法] 負でない整数 a と b (a > b) で、a を b で割った余りを r とする。 このとき、a と b の最大公約数は b と r の最大公約数に等しい。
あとは b を a とし、r を b にして同じ計算をすればいいわけです。この計算を繰り返し行うと、a と b はどんどん小さくなっていき、r = 0 になったときの b が最大公約数になります。述語 gcd はこのアルゴリズムをそのままプログラムしただけです。
リスト : 最小公倍数
lcm(A, B, L) :-
gcd(A, B, G), L is A * B // G.
最小公倍数は gcd を使って簡単に求めることができます。
リスト : 分数 ratio(分子, 分母)
make_ratio(P, Q, ratio(P1, Q1)) :-
(Q < 0 -> (P0 is -P, Q0 is -Q) ; (P0 is P, Q0 is Q)),
gcd(P0, Q0, G),
P1 is P0 // G, Q1 is Q0 // G.
make_ratio の引数 P が分子で、Q が分母を表します。ratio を生成するとき、gcd で最大公約数を求めて、約分することに注意してください。それから、有理数の符号は分子に付けるので、分母 Q が負の場合は P と Q の符号を反転します。
リスト : 有理数の四則演算
addr(ratio(P1, Q1), ratio(P2, Q2), R) :-
P3 is P1 * Q2 + P2 * Q1, Q3 is Q1 * Q2, make_ratio(P3, Q3, R).
subr(ratio(P1, Q1), ratio(P2, Q2), R) :-
P3 is P1 * Q2 - P2 * Q1, Q3 is Q1 * Q2, make_ratio(P3, Q3, R).
mulr(ratio(P1, Q1), ratio(P2, Q2), R) :-
P3 is P1 * P2, Q3 is Q1 * Q2, make_ratio(P3, Q3, R).
divr(ratio(P1, Q1), ratio(P2, Q2), R) :-
P3 is P1 * Q2, Q3 is Q1 * P2, make_ratio(P3, Q3, R).
有理数 (分数) の四則演算をそのままプログラムしただけなので、とくに難しいところはないと思います。
リスト : 小町分数
solve :-
permutation(9, [1,2,3,4,5,6,7,8,9], [A,B,C,D,E,F,G,H,I]),
A < D,
D < G,
X1 is B * 10 + C,
X2 is E * 10 + F,
X3 is H * 10 + I,
addr(ratio(A, X1), ratio(D, X2), Z1),
addr(Z1, ratio(G, X3), ratio(1, N)),
format('~d/~d~d + ~d/~d~d + ~d/~d~d = 1/~d~n', [A,B,C,D,E,F,G,H,I,N]),
fail.
単純な生成検定法です。重複解を排除するため、A < D < G の条件を付けています。また、順列を生成するとき、このチェックを入れることで枝刈りと同じ効果を得ることができます。興味のある方は試してみてください。実行結果は次のようになります。
?- solve. 1/24 + 3/56 + 7/98 = 1/6 1/26 + 5/39 + 7/84 = 1/4 1/32 + 5/96 + 7/84 = 1/6 1/38 + 2/95 + 4/76 = 1/10 1/48 + 5/32 + 7/96 = 1/4 1/56 + 3/72 + 9/84 = 1/6 1/96 + 5/32 + 7/84 = 1/4 1/96 + 5/48 + 7/32 = 1/3 2/18 + 5/63 + 7/49 = 1/3 2/19 + 4/57 + 6/38 = 1/3 3/27 + 6/54 + 9/81 = 1/3 3/48 + 5/16 + 9/72 = 1/2 3/54 + 6/72 + 9/81 = 1/4 5/34 + 7/68 + 9/12 = 1/1 false.
リスト : 魔方陣
magic :-
permutation(9, [1,2,3,4,5,6,7,8,9], [A,B,C,D,E,F,G,H,I]),
X is A + B + C,
X =:= D + E + F,
X =:= G + H + I,
X =:= A + D + G,
X =:= B + E + H,
X =:= C + F + I,
X =:= A + E + I,
X =:= C + E + G,
format('~d ~d ~d~n~d ~d ~d~n~d ~d ~d~n~n', [A,B,C,D,E,F,G,H,I]),
fail.
単純な生成検定法です。実行結果は次のようになります。
?- solve. 2 7 6 9 5 1 4 3 8 2 9 4 7 5 3 6 1 8 4 3 8 9 5 1 2 7 6 4 9 2 3 5 7 8 1 6 6 1 8 7 5 3 2 9 4 6 7 2 1 5 9 8 3 4 8 1 6 3 5 7 4 9 2 8 3 4 1 5 9 6 7 2 false.
解は 8 通り出力されましたが、重複解を取り除くと解は一通りしかありません。重複解のチェックは面倒だと思われる方もいるでしょう。ところが、下図のように四隅の大小関係を利用すると簡単です。
┌─┬─┬─┐
│Ａ│Ｂ│Ｃ│
├─┼─┼─┤ A < C < G
│Ｄ│Ｅ│Ｆ│
├─┼─┼─┤ A < I
│Ｇ│Ｈ│Ｉ│
└─┴─┴─┘
図 : 対称解のチェック
魔方陣の場合、回転解が 4 種類あって、鏡像解が 2 種類あります。四隅の大小関係をチェックすることで、これらの対称解を排除することができます。また、順列を生成するとき、重複解のチェックを入れると枝刈りと同じ効果を得ることができます。興味のある方は試してみてください。
リスト : 小町覆面算
solve1 :-
permutation(9, [1,2,3,4,5,6,7,8,9], [W,R,O,N,G,I,H,T,M]),
X is W * 10000 + R * 1000 + O * 100 + N * 10 + G,
Y is R * 10000 + I * 1000 + G * 100 + H * 10 + T,
X * M =:= Y,
format('~d * ~d = ~d~n', [X, M, Y]),
fail.
単純な生成検定法です。実行結果は次のようになります。
?- solve1. 16958 * 4 = 67832 false.
素数を求める基本的な考え方は簡単です。最初に、2 から N までの整数列を生成します。先頭の 2 は素数なので、この整数列から 2 で割り切れる整数を取り除き除きます。2 で割り切れる整数が取り除かれたので、残った要素の先頭が素数になります。先頭要素は 3 になるので、今度は 3 で割り切れる整数を取り除けばいいのです。このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩 (ふるい) 」といいます。
プログラムは次のようになります。
リスト : 素数 (エラトステネスの篩) filter(_, [], []). filter(X, [Y | Ys], Zs) :- Y mod X =:= 0, filter(X, Ys, Zs). filter(X, [Y | Ys], [Y | Zs]) :- Y mod X =\= 0, filter(X, Ys, Zs). sieve(N, Ps) :- iota(2, N, Ns), sieve(Ns, [], Ps). sieve([], Xs, Ps) :- reverse(Xs, Ps). sieve([X | Xs], Ys, Ps) :- filter(X, Xs, Zs), sieve(Zs, [X | Ys], Ps).
述語 filter(X, Xs, Ys) はリスト Xs から X で割り切れる要素を取り除きます。sieve/2 の処理は sieve/3 で行います。iota で 2 から N までの整数列を生成し、それを sieve/3 に渡します。sieve/3 はリストの先頭要素 X で割り切れる要素を filter で取り除き、sieve/3 を再帰呼び出しします。このとき、累積変数に X を追加します。2 番目の規則が再帰の停止条件です。累積変数には素数が逆順にセットされているので、reverse で反転します。
sieve には無駄な処理があります。リストの先頭要素 x が √n よりも大きい場合、リストには素数しか残っていません。つまり、ふるいにかけるのは x <= √n まででいいのです。これをプログラムすると次のようになります。
リスト : 別解
revAppend([], Ys, Ys).
revAppend([X | Xs], Ys, Zs) :- revAppend(Xs, [X | Ys], Zs).
sieve1(N, Ps) :- iota(2, N, Ns), sieve1(N, Ns, [], Ps).
sieve1(N, [], Xs, Ps) :- reverse(Xs, Ps).
sieve1(N, [X | Xs], Ys, Ps) :-
N < X * X, revAppend(Ys, [X | Xs], Ps).
sieve1(N, [X | Xs], Ys, Ps) :-
N >= X * X, filter(X, Xs, Zs), sieve1(N, Zs, [X | Ys], Ps).
sieve1 の 3 番目の節で、リストの先頭要素 X が X * X > N ならば、累積変数 Ys とリスト [X | Xs] を述語 revAppend で連結して返します。revAppend は第 1 要素のリストを反転して第 2 要素のリストに連結します。これで sieve よりも速く素数を求めることができます。