今回は「ハッシュ表 (hash table)」を取り上げます。ハッシュとは、高速なデータ検索アルゴリズムである「ハッシュ法 (hashing)」のことを指します。ハッシュ法はコンパイラやインタプリタなどで、予約語、関数名、変数名などの管理に使われています。
また、Perl, Python, Ruby など連想配列をサポートしているスクリプト言語がありますが、その実装にはハッシュ法が使われています。Perl や Ruby で連想配列をハッシュと呼ぶのは、アルゴリズムの名称からきているのです。
SWI-Prolog の場合、ハッシュ表を表すデータ構造 ht が用意されているので、簡単にハッシュ法を利用することができます。今回は「ハッシュ表」の使い方を簡単に説明します。
ハッシュ法は「ハッシュ表 (hash table)」と呼ばれるデータを格納する配列と、データを数値に変換する「ハッシュ関数 (hash function)」を用意します。たとえば、ハッシュ表の大きさを n とすると、ハッシュ関数はデータを 0 から n - 1 までの整数値に変換するように作ります。この値を「ハッシュ値 (hash value)」と呼びます。
ハッシュ値はハッシュ表の添字に対応し、この位置にデータを格納します。つまり、ハッシュ関数によってデータを格納する位置を決める探索方法がハッシュ法なのです。
ハッシュ法で不特定多数のデータを取り扱う場合、異なるデータでも同じハッシュ値が生成されることがあります。これをハッシュ値の「衝突(collision)」といいます。つまり、データをハッシュ表に登録しようとしても、すでに先客が居座っているわけです。この場合、2 種類の解決方法があります。
ひとつは、ハッシュ表に複数のデータを格納することです。配列にはひとつのデータしか格納できないので、複数個のデータをまとめて格納しておく工夫が必要になります。このときによく利用されるデータ構造がリストです。ハッシュ表からデータを探索する場合、まずハッシュ値を求め、そこに格納されているリストの中からデータを探索します。これを「チェイン法 (chaining)」といいます。
この方法ではハッシュ値の衝突が頻繁に発生すると、データを格納するリストが長くなるため、探索時間が余分にかかってしまいます。効率よく探索を行うには、ハッシュ表の大きさとハッシュ関数の選択が重要になります。
もうひとつは、空いている場所を探して、そこにデータを入れる方法です。この場合、最初とは違うハッシュ関数を用意して、新しくハッシュ値を計算させて場所を決めます。この処理を空いている場所が見つかるまで繰り返します。これを「オープンアドレス法 (open addressing)」といいます。
この場合、データの最大数はハッシュ表の大きさに制限されます。また、ハッシュ表の空きが少なくなると、探索効率も極端に低下してしまいます。このため、ハッシュ表の空きが少なくなったら、ハッシュ表のサイズを大きくして、ハッシュ表を作り直す作業を行うのがふつうです。これを「リハッシュ (rehash)」といいます。そのあと探索効率は良くなるので、リハッシュにかけた時間のもとは十分にとれます。
SWI-Prolog の場合、ハッシュ表は特定のキーと特定のデータを関連付けるデータ構造です。つまり、キーのハッシュ値を計算し、ハッシュ表のその場所へデータを格納します。キーとデータは SWI-Prolog のデータであれば何でもかまいません。ただし、自由変数をキーにすることはできません。
それでは、ハッシュ表を操作する述語を説明します。ハッシュ表を作るには述語 ht_new/1 を使います。
ht_new(Ht)
ht_new/1 は新しいハッシュ表を生成して引数の変数 Ht とマッチングします。
ハッシュ表から値を求めるには述語 ht_get/3 を使います。
ht_get(Ht, Key, Value)
ht_get はハッシュ表 Ht からキー Key を検索し、格納されているデータ Value を返します。キーが見つからない場合は失敗します。それから、ハッシュ表に値を書き込むときは述語 ht_put/3, ht_put_new/3 を使います。
ht_put(Ht, Key, Value) ht_put_new(Ht, Key, Value)
どちらの述語もハッシュ表 Ht にキー Key とその値 Value を書き込みます。ht_put_new/3 は Ht に Key が存在する場合は失敗します。ht_put/3 は、Ht に同じ Key が存在するときは、その値を Value に書き換えます。
簡単な使用例を示しましょう。
?- ht_new(H). H = ht(0, 0, [](_)). ?- ht_new(H), ht_get(H, foo, A). false. ?- ht_new(H), ht_put(H, foo, 100), ht_put(H, bar, 200), ht_get(H, foo, A), ht_get(H, bar, B). H = ht(2, 4, [](foo, 100, bar, 200, _, _, _, _, _)), A = 100, B = 200. ?- ht_new(H), ht_put(H, foo, 100), ht_put(H, foo, 200), ht_get(H, foo, A). H = ht(1, 4, [](foo, 200, _, _, _, _, _, _, _)), A = 200. ?- ht_new(H), ht_put(H, foo, 100), ht_put_new(H, foo, 200), ht_get(H, foo, A). false. ?-
ハッシュ表からデータを削除するには述語 ht_del/3 を使います。
ht_del(Ht, Key, Value)
ht_del/3 は Ht からキー Key とその値を削除します。削除した値は Value にセットされます。Ht に Key が存在しない場合は失敗します。
?- ht_new(H), ht_put(H, foo, 100), ht_del(H, foo, A). H = ht(0, 4, [](_, _, _, _, _, _, _, _, _)), A = 100. ?- ht_new(H), ht_put(H, foo, 100), ht_del(H, bar, A). false. ?-
述語 ht_gen/3 はハッシュ表内のキーと値をひとつずつ取り出します。述語 ht_pairs/2 はハッシュ表内のキーと値を連想リストに格納して返します。ハッシュ表に格納されたデータ数は述語 ht_size/2 で求めることができます。
ht_gen(Ht, Key, Value) ht_pairs(Ht, Xs) ht_size(Ht, Cnt)
?- ht_new(H), ht_put(H, foo, 100), ht_put_new(H, bar, 200), ht_gen(H, K, V). H = ht(2, 4, [](foo, 100, bar, 200, _, _, _, _, _)), K = foo, V = 100 ; H = ht(2, 4, [](foo, 100, bar, 200, _, _, _, _, _)), K = bar, V = 200 ; false. ?- ht_new(H), ht_put(H, foo, 100), ht_put_new(H, bar, 200), ht_pairs(H, Xs). H = ht(2, 4, [](foo, 100, bar, 200, _, _, _, _, _)), Xs = [bar-200, foo-100]. ?- ht_new(H), ht_put(H, foo, 100), ht_put_new(H, bar, 200), ht_size(H, C). H = ht(2, 4, [](foo, 100, bar, 200, _, _, _, _, _)), C = 2. ?-
ハッシュ表の詳しい説明は、SWI-Prolog のマニュアル hashtable.pl -- Hash tables をお読みくださいませ。
それでは簡単な例題として、3 次元空間の異なる点 [x, y, z] を n 個作る述語を作ります。要素 x, y, z は 0 から 99 までの整数値とし、乱数で生成することにします。生成する点の個数が少なければ、ハッシュ表を使わなくても線形探索で十分です。プログラムは次のようになります。
リスト : N 個の異なる点を作る
make_point([X, Y, Z]) :-
X is random(100), Y is random(100), Z is random(100).
make_data(0, A, A) :- !.
make_data(N, A, B) :-
make_point(K),
not(member(K, A)),
!,
N1 is N - 1,
make_data(N1, [K | A], B).
make_data(N, A, B) :- make_data(N, A, B).
make_data(N, A) :- make_data(N, [], A).
述語 make_data は述語 make_point で点をひとつ生成し、それが今まで生成した点と異なることを member でチェックします。member は線形探索なので、点の個数が増えると時間がかかるようになります。実際に 1000, 2000, 4000, 8000 個の点を作ったときの実行時間を示します。
?- time(make_data(1000, _)). % 507,502 inferences, 0.047 CPU in 0.047 seconds (100% CPU, 10730972 Lips) true. ?- time(make_data(2000, _)). % 2,015,002 inferences, 0.180 CPU in 0.180 seconds (100% CPU, 11223562 Lips) true. ?- time(make_data(4000, _)). % 8,035,846 inferences, 0.696 CPU in 0.696 seconds (100% CPU, 11543653 Lips) true. ?- time(make_data(8000, _)). % 32,143,652 inferences, 2.742 CPU in 2.742 seconds (100% CPU, 11723507 Lips) true.
点の個数が増えると実行時間が大幅に増加することがわかります。それでは線形探索の代わりにハッシュ法を使ってみましょう。プログラムは次のようになります。
リスト : n 個の異なる点を作る (ハッシュ法)
make_data_sub(0, _) :- !.
make_data_sub(N, H) :-
make_point(K),
ht_put(H, K, true),
!,
N1 is N - 1,
make_data_sub(N1, H).
make_data_sub(N, H) :- make_data_sub(N, H).
make_data_ht(N, H) :-
ht_new(H), make_data_sub(N, H)
述語 make_data_ht は生成したデータのチェックにハッシュ表を使います。実際の処理は述語 make_data_sub で行います。make_point でデータ K を生成したら、ht_put でハッシュ表に K を登録します。すでに K が存在する場合、ht_put は失敗するので 3 番目の規則が実行されます。K が登録できた場合は、カットを通してから make_data_sub を再帰呼び出しします。
これでプログラムは完成です。実行時間は次のようになりました。
?- time(make_data_ht(1000, _)). % 44,176 inferences, 0.008 CPU in 0.008 seconds (100% CPU, 5358824 Lips) true. ?- time(make_data_ht(2000, _)). % 88,413 inferences, 0.016 CPU in 0.016 seconds (100% CPU, 5485528 Lips) true. ?- time(make_data_ht(4000, _)). % 176,721 inferences, 0.030 CPU in 0.030 seconds (100% CPU, 5907161 Lips) true. ?- time(make_data_ht(8000, _)). % 354,159 inferences, 0.056 CPU in 0.056 seconds (100% CPU, 6366709 Lips) true.
圧倒的にハッシュ表の方が速いですね。
最後に、拙作のページ「幅優先探索」で取り上げた「7 パズル」の解法プログラムにハッシュ表を使ってみましょう。プログラムは次のようになります。
リスト : 7 パズル (幅優先探索)
% キュー (差分リスト)
enqueue(Item, [Qh, [Item | Qt]], [Qh, Qt]).
dequeue(Item, [[Item | Qh], Qt], [Qh, Qt]).
empty([X, Y]) :- X == Y.
% 盤面
% 0 1 2 3
% 4 5 6 7
% 隣接リスト
neighbor(0, [1, 4]).
neighbor(1, [0, 2, 5]).
neighbor(2, [1, 3, 6]).
neighbor(3, [2, 7]).
neighbor(4, [0, 5]).
neighbor(5, [1, 4, 6]).
neighbor(6, [2, 5, 7]).
neighbor(7, [3, 6]).
% 駒の移動
move_piece(_, [], []).
move_piece(Piece, [0 | Rest], [Piece | Rest1]) :- move_piece(Piece, Rest, Rest1), !.
move_piece(Piece, [Piece | Rest], [0 | Rest1]) :- move_piece(Piece, Rest, Rest1), !.
move_piece(Piece, [X | Rest], [X | Rest1]) :- move_piece(Piece, Rest, Rest1).
% 新しい盤面の生成
make_new_board(_, _, [], _, Q, Q) :- !.
make_new_board(Board, Space, [X | Xs], Ht, Q, Qe) :-
nth0(X, Board, Piece),
move_piece(Piece, Board, NewBoard),
ht_put_new(Ht, NewBoard, Board),
!,
enqueue([NewBoard, X], Q, Qn),
make_new_board(Board, Space, Xs, Ht, Qn, Qe).
make_new_board(Board, Space, [_| Xs], Ht, Q, Qe) :-
make_new_board(Board, Space, Xs, Ht, Q, Qe).
% 手順の表示
print_answer([], _) :- !.
print_answer(Board, Ht) :-
ht_get(Ht, Board, Prev),
print_answer(Prev, Ht),
write(Board),
nl.
% 幅優先探索
bfs(Goal, Q, Ht) :-
not(empty(Q)),
dequeue([Board, Space], Q, Q1),
(Board == Goal -> print_answer(Board, Ht) ; true),
neighbor(Space, Xs),
make_new_board(Board, Space, Xs, Ht, Q1, Q2),
bfs(Goal, Q2, Ht).
test :-
B = [0,7,2,1,4,3,6,5],
ht_new(Ht),
ht_put_new(Ht, B, []),
enqueue([B, 0], [Q, Q], Qn),
bfs([1,2,3,4,5,6,7,0], Qn, Ht).
述語 test でハッシュ表 Ht を生成します。キーは盤面を表すリストで、値は 1 手前の盤面を表すリストです。生成したハッシュ表は、述語 bfs, print_answer, make_new_board の引数 Ht に渡します。make_new_board では、新しい盤面 NewBoard を ht_put_new でハッシュ表に追加します。同じキーがあると ht_put_new は失敗します。これで同一局面のチェックを行うことができます。
あとは特に難しいところはないでしょう。詳細はプログラムリストをお読みくださいませ。実行結果は次のようになりました。
?- time(test). [0,7,2,1,4,3,6,5] [7,0,2,1,4,3,6,5] [7,2,0,1,4,3,6,5] [7,2,1,0,4,3,6,5] [7,2,1,5,4,3,6,0] [7,2,1,5,4,3,0,6] [7,2,0,5,4,3,1,6] [7,0,2,5,4,3,1,6] [0,7,2,5,4,3,1,6] [4,7,2,5,0,3,1,6] [4,7,2,5,3,0,1,6] [4,7,2,5,3,1,0,6] [4,7,0,5,3,1,2,6] [4,7,5,0,3,1,2,6] [4,7,5,6,3,1,2,0] [4,7,5,6,3,1,0,2] [4,7,0,6,3,1,5,2] [4,0,7,6,3,1,5,2] [0,4,7,6,3,1,5,2] [3,4,7,6,0,1,5,2] [3,4,7,6,1,0,5,2] [3,4,7,6,1,5,0,2] [3,4,7,6,1,5,2,0] [3,4,7,0,1,5,2,6] [3,4,0,7,1,5,2,6] [3,0,4,7,1,5,2,6] [0,3,4,7,1,5,2,6] [1,3,4,7,0,5,2,6] [1,3,4,7,5,0,2,6] [1,3,4,7,5,2,0,6] [1,3,4,7,5,2,6,0] [1,3,4,0,5,2,6,7] [1,3,0,4,5,2,6,7] [1,0,3,4,5,2,6,7] [1,2,3,4,5,0,6,7] [1,2,3,4,5,6,0,7] [1,2,3,4,5,6,7,0] % 2,942,427 inferences, 0.489 CPU in 0.490 seconds (100% CPU, 6023013 Lips) false.
実行時間は約 0.5 秒、キーがリストでも高速に解くことができました。リストを数値に変換してハッシュ表のキーにすると、実行時間はもう少し速くなるかもしれません。興味のある方は試してみてください。
今回は Prolog で「ナンバープレース (数独)」の解法プログラムを作ってみましょう。最近のパソコンはハイスペックなので、9 行 9 列盤のナンバープレースであれば、特に工夫しなくても単純な深さ優先探索で解くことができます。ただし、普通の Prolog は配列をサポートしていないので、他のプログラミング言語よりもちょっとだけ難しくなります。
SWI-Prolog の場合、一番簡単な方法は制約論理プログラミング用のライブラリ clpfd を使うことです。clpfd のマニュアルにはナンバープレースの解法プログラムが掲載されています。プログラムはとても簡単、高速にパズルを解くことができます。実際に動かしてみると、制約プログラミングのパワーを実感することができるでしょう。制約論理プログラミングについては拙作のページ「制約論理プログラミング超入門」をお読みくださいませ。
clpfd を使わない場合、いろいろな方法が考えられると思いますが、今回は盤面をリストで表すことにしましょう。この場合、空き場所を数字 0 で表すよりも、自由変数で表したほうが Prolog らしいプログラムになります。そして、空き場所に置くことができる数字のリストと、空き場所が属する縦横枠の自由変数のリストをあらかじめ求めておいて、深さ優先探索で矛盾しないように自由変数の値を決定していくことにします。
数字のリストを求める場合、集合演算を使うと簡単ですが、自由変数のリストを求めるときは注意が必要です。Prolog の自由変数はどんな値にでもマッチングするので、今回の処理に SWI-Prolog の集合演算を使うことはできません。簡単な例を示しましょう。
?- union([1,2,3,4], [3,4,5,6], X). X = [1, 2, 3, 4, 5, 6]. ?- union([A,B,C,D], [C,D,E,F], X). A = B, B = C, C = D, X = [D, D, E, F]. ?-
和集合を求める述語 union/3 は、要素が数字だと正常に動作しますが、自由変数だと正常に動作しません。この場合、自由変数のリスト [A,B,C,D,E,F] がほしいわけです。
そこで、等値の判定に述語 == を使う集合演算を定義することにします。次のリストを見てください。
リスト : 集合演算
% 述語 == による member
memq(X, [Y | _]) :- X == Y.
memq(X, [_ | Ys]) :- memq(X, Ys).
% memq による集合述語
% 和集合
unionq([], Ys, Ys).
unionq([X | Xs], Ys, Zs) :- memq(X, Ys), !, unionq(Xs, Ys, Zs).
unionq([X | Xs], Ys, [X | Zs]) :- unionq(Xs, Ys, Zs).
% 積集合
intersectq([], _, []).
intersectq([X | Xs], Ys, [X | Zs]) :-
memq(X, Ys), !, intersectq(Xs, Ys, Zs).
intersectq([_ | Xs], Ys, Zs) :- intersectq(Xs, Ys, Zs).
% 差集合
differenceq([], _, []).
differenceq([X | Xs], Ys, Zs) :-
memq(X, Ys), !, differenceq(Xs, Ys, Zs).
differenceq([X | Xs], Ys, [X | Zs]) :- differenceq(Xs, Ys, Zs).
述語 memq は演算子 == で等値を判定します。名前は Scheme から拝借しました。member と違って第 1 引数を自由変数にしてもマッチングは行われません。あとは、拙作のページ「Yet Another Prolog Problems (1)」の問題 18, 19, 20 のプログラムで、member を memq に変更するだけです。
簡単な実行例を示しましょう。
?- memq(1, [1,2,3,4,5]). true ; false. ?- memq(A, [1,2,3,4,5]). false. ?- unionq([1,2,3,4],[3,4,5,6], X). X = [1, 2, 3, 4, 5, 6]. ?- unionq([A,B,C,D], [C,D,E,F], X). X = [A, B, C, D, E, F]. ?- intersectq([1,2,3,4],[3,4,5,6], X). X = [3, 4]. ?- intersectq([A,B,C,D], [C,D,E,F], X). X = [C, D]. ?- differenceq([1,2,3,4],[3,4,5,6], X). X = [1, 2]. ?- differenceq([A,B,C,D], [C,D,E,F], X). X = [A, B]. ?-
正常に動作していますね。
次は盤面を表すデータ構造を定義しましょう。最初にナンバープレースの盤面 (9 行 9 列) を下図に示します。
列 0 1 2 3 4 5 6 7 8 行 +-------+-------+-------+ 0 | | | | 1 | 枠 0 | 1 | 2 | 2 | | | | +-------+-------+-------+ 3 | | | | 4 | 3 | 4 | 5 | 5 | | | | +-------+-------+-------+ 6 | | | | 7 | 6 | 7 | 8 | 8 | | | | +-------+-------+-------+ 図 : 数独 (9 * 9) の盤面
この盤面を次のようにリストのリストで表すことにすると、横 (行) の関係はすぐに求めることができます。
リスト : 問題 (出典: 数独 - Wikipedia の問題例)
problem(0, [[5,3,_, _,7,_, _,_,_],
[6,_,_, 1,9,5, _,_,_],
[_,9,8, _,_,_, _,6,_],
[8,_,_, _,6,_, _,_,3],
[4,_,_, 8,_,3, _,_,1],
[7,_,_, _,2,_, _,_,6],
[_,6,_, _,_,_, 2,8,_],
[_,_,_, 4,1,9, _,_,5],
[_,_,_, _,8,_, _,7,9]]).
要素のリストの中で 1 から 9 の数字が重複せずに一つずつ入ればいいわけです。
次は、縦 (列) の関係を求める述語を作ります。盤面を行列と考えると、列の関係は転置行列を求めることと同じになります。次の図を見てください。
[[1,2,3], [[1,4,7], [4,5,6], = 転置行列 => [2,5,8], [7,8,9]] [3,6,9]]
このように、行列の行と列を入れ替えた行列を「転置行列 (transposed matrix)」といいます。SWI-Prolog のライブラリ clpfd には転置行列を求める述語 transpose が用意されていますが、maplist を使うと私たちでも簡単に定義することができます。次のリストを見てください。
リスト : 転置行列
head([X | _], X).
tail([_ | Xs], Xs).
transpose(Xs, []) :- member([], Xs), !.
transpose(Xs, [Y | Ys]) :-
maplist(head, Xs, Y),
maplist(tail, Xs, Xs1),
transpose(Xs1, Ys).
述語 head はリストの先頭要素を取り出します。tail はリストの先頭要素を取り除きます。これらの述語は Lisp / Scheme の car, cdr と同じです。
transpose の最初の節が再帰呼び出しの停止条件で、要素のリストが空リストになったか member でチェックします。次の節で maplist に head を渡して、各リストの先頭要素を格納したリスト、つまり列を表すリスト Y を作ります。
そして、maplist に tail を渡して、先頭要素を取り除いたリストを格納したリスト Xs1 を作ります。この Xs1 に transpose を適用すれば、次の列の要素を格納したリストを作ることができます。
簡単な実行例を示します。
?- transpose([[1,2],[3,4]], Xs). Xs = [[1, 3], [2, 4]]. ?- transpose([[1,2],[3,4],[5,6]], Xs). Xs = [[1, 3, 5], [2, 4, 6]]. ?- transpose([[1,2,3],[4,5,6],[7,8,9]], Xs). Xs = [[1, 4, 7], [2, 5, 8], [3, 6, 9]]. ?-
次は枠 (ブロック) の関係を求めるプログラムを作りましょう。次のリストを見てください。
リスト : 枠 (ブロック) の関係を求める
make_block_sub([],[],[],[]).
make_block_sub([X1, X2, X3 | Xs],
[Y1, Y2, Y3 | Ys],
[Z1, Z2, Z3 | Zs],
[[X1, X2, X3, Y1, Y2, Y3, Z1, Z2, Z3] | Bs]) :-
make_block_sub(Xs, Ys, Zs, Bs).
make_block([], []).
make_block([X, Y, Z | Ls], Gs) :-
make_block_sub(X, Y, Z, Gs1),
make_block(Ls, Gs2),
append(Gs1, Gs2, Gs).
述語 make_block はリストの先頭から 3 行 (X, Y, Z) ずつ取り出して述語 make_block_sub に渡します。make_block_sub では、各リストの先頭から 3 つの要素を取り出して、それらを一つのリストに格納します。これで同じ枠内にある要素を一つのリストにまとめることができます。
それでは簡単なテストを行ってみましょう。
リスト : テスト
test :-
Ls = [
[11, 12, 13, 14, 15, 16, 17, 18, 19],
[21, 22, 23, 24, 25, 26, 27, 28, 29],
[31, 32, 33, 34, 35, 36, 37, 38, 39],
[41, 42, 43, 44, 45, 46, 47, 48, 49],
[51, 52, 53, 54, 55, 56, 57, 58, 59],
[61, 62, 63, 64, 65, 66, 67, 68, 69],
[71, 72, 73, 74, 75, 76, 77, 78, 79],
[81, 82, 83, 84, 85, 86, 87, 88, 89],
[91, 92, 93, 94, 95, 96, 97, 98, 99]],
maplist(writeln, Ls),
nl,
transpose(Ls, Cs),
maplist(writeln, Cs),
nl,
make_block(Ls, Gs),
maplist(writeln, Gs).
?- test. [11,12,13,14,15,16,17,18,19] [21,22,23,24,25,26,27,28,29] [31,32,33,34,35,36,37,38,39] [41,42,43,44,45,46,47,48,49] [51,52,53,54,55,56,57,58,59] [61,62,63,64,65,66,67,68,69] [71,72,73,74,75,76,77,78,79] [81,82,83,84,85,86,87,88,89] [91,92,93,94,95,96,97,98,99] [11,21,31,41,51,61,71,81,91] [12,22,32,42,52,62,72,82,92] [13,23,33,43,53,63,73,83,93] [14,24,34,44,54,64,74,84,94] [15,25,35,45,55,65,75,85,95] [16,26,36,46,56,66,76,86,96] [17,27,37,47,57,67,77,87,97] [18,28,38,48,58,68,78,88,98] [19,29,39,49,59,69,79,89,99] [11,12,13,21,22,23,31,32,33] [14,15,16,24,25,26,34,35,36] [17,18,19,27,28,29,37,38,39] [41,42,43,51,52,53,61,62,63] [44,45,46,54,55,56,64,65,66] [47,48,49,57,58,59,67,68,69] [71,72,73,81,82,83,91,92,93] [74,75,76,84,85,86,94,95,96] [77,78,79,87,88,89,97,98,99] true. ?-
正常に動作していますね。
次は空き場所に置くことができる数字と、空き場所が属する縦横枠にある自由変数 (空き場所) を求める述語 analysis を作りましょう。次のリストを見てください。
リスト : 盤面の解析
% 数字を取り出す
get_number(X, Y, Ls, N) :- nth0(Y, Ls, L), nth0(X, L, N).
% 解析
analysis(_, 9, _, _, _, []).
analysis(9, Y, Ls, Cs, Gs, Zs) :-
Y1 is Y + 1, analysis(0, Y1, Ls, Cs, Gs, Zs).
analysis(X, Y, Ls, Cs, Gs, Zs) :-
get_number(X, Y, Ls, N),
nonvar(N),
X1 is X + 1,
analysis(X1, Y, Ls, Cs, Gs, Zs).
analysis(X, Y, Ls, Cs, Gs, [Z | Zs]) :-
get_number(X, Y, Ls, N),
var(N),
analysis_sub(X, Y, N, Ls, Cs, Gs, Z),
X1 is X + 1,
analysis(X1, Y, Ls, Cs, Gs, Zs).
analysys(X, Y, Ls, Cs, Gs, Zs) の引数 X, Y は盤面の列と行、Ls が盤面 (行)、Cs が盤面を転置したもの (列)、Gs が枠を表します。Zs の要素はリストで要素は次のようになります。
[空き場所 (自由変数), 置くことができる数字のリスト, 空き場所が属する縦横枠の自由変数のリスト]
このリストは述語 analysys_sub で作ります。最初に、述語 get_number で (X, Y) にある数字 N を求めます。N が自由変数でなければ、次の場所を調べます。自由変数の場合、analysis_sub で数字と自由変数のリストを求めます。
次は述語 analysis_sub を作ります。プログラムは次のようになります。
リスト : 盤面の解析 (2)
analysis_sub(X, Y, N, Ls, Cs, Gs, [N, As, Bs]) :-
nth0(Y, Ls, Ys),
nth0(X, Cs, Xs),
G is (Y // 3) * 3 + X // 3,
nth0(G, Gs, Zs),
% 数字と変数に分ける
partition(integer, Ys, Ys1, Ys2),
partition(integer, Xs, Xs1, Xs2),
partition(integer, Zs, Zs1, Zs2),
unionq(Ys1, Xs1, As1),
unionq(Zs1, As1, As2),
% 未確定の数字
differenceq([1,2,3,4,5,6,7,8,9], As2, As),
% 変数のリスト
unionq(Ys2, Xs2, Bs1),
unionq(Zs2, Bs1, Bs).
最初に nth0 で Y 行のリストを Ys に、X 列のリストを Xs に、G 番目の枠のリストを Zs にもと目増す。次に、それぞれのリストの要素を述語 partition/4 で数字と自由変数に分けます。partition の説明は拙作のページ「高階プログラミング」をお読みくださいませ。
リスト Xs, Ys, Zs を partition で Xs1, Xs2, Ys1, Ys2, Zs1, Zs2 に分離します。ヒントの数字は Xs1, Ys1, Zs1 の和集合を unionq で求めるだけです。この場合、SWI-Prolog の述語 union を使っても問題ありません。
この値を As2 とすると、置くことができる数字は、1 から 9 までの数字の集合から As2 を引き算する、つまり differenceq で差集合を求めるだけです。自由変数のリストは Xs2, Ys2, Zs2 の和集合を unionq で求めるだけです。この場合、SWI-Prolog の union を使ってはいけません。ご注意ください。
ここまで準備が整ったら、あとは簡単です。ナンバープレースの解法プログラムは次のようになります。
リスト : ナンバープレースの解法
% 深さ優先探索
dfs([]).
dfs([[N, As, Bs] | Vs]) :-
member(I, As),
maplist(\==(I), Bs),
N = I,
dfs(Vs).
% 解法
solver(N) :-
problem(N, Ls),
transpose(Ls, Cs),
make_block(Ls, Gs),
analysis(0, 0, Ls, Cs, Gs, Vs),
dfs(Vs),
maplist(writeln, Ls).
述語 solver の引数 N は問題番号を表します。problem から問題 (盤面) を取り出して、transpose で列の関係を、make_block で枠の関係を求めます。次に、述語 analysis で盤面を解析して、述語 dfs で深さ優先探索します。解が見つかったら maplist で盤面を表示します。
述語 dfs も簡単です。引数 N が空き場所を表す自由変数、As が置くことができる数字のリスト、Bs が自由変数のリストです。最初に、member で As から数字 I を選びます。次に、Bs の中で I と同じ値がないか maplist でチェックします。最初、Bs の要素は自由変数しかありませんが、探索を進めていくと数字と自由変数が混在するようになります。述語には \== を使うことに注意してください。
同じ値がない場合は N = I で N の値を I に決定し、次の空き場所の数字を決めるため dfs を再帰呼び出しします。引数 Vs が空リストになったならば解を求めることができました。これが再帰呼び出しの停止条件になります。
それでは実行してみましょう。
?- time(solver(0)). [5,3,4,6,7,8,9,1,2] [6,7,2,1,9,5,3,4,8] [1,9,8,3,4,2,5,6,7] [8,5,9,7,6,1,4,2,3] [4,2,6,8,5,3,7,9,1] [7,1,3,9,2,4,8,5,6] [9,6,1,5,3,7,2,8,4] [2,8,7,4,1,9,6,3,5] [3,4,5,2,8,6,1,7,9] % 296,569 inferences, 0.030 CPU in 0.030 seconds (100% CPU, 9941105 Lips) true . ?-
0.1 秒もかからずに解くことができました。ヒント (初期配置の数字) が多い問題であれば、単純な深さ優先探索でも簡単に解を求めることができるようです。そこで、もう少し難しい問題を解いてみましょう。deepgreen さんが作成された「ナンプレ問題集」より問題 c1, d1, e1, h1, h2, k3, k4, x2 を試してみたところ、実行時間は次のようになりました。
表 : 実行結果 問題 : Hint : 秒 ------+------+------- c1 : 22 : 0.740 d1 : 21 : 5.535 e1 : 24 : 0.497 h1 : 23 : 0.041 h2 : 24 : 0.191 k3 : 24 : 2.352 k4 : 21 : 6.105 x2 : 24 : 0.836
ヒントが少なくなると、今回のプログラムでは時間がかかるようです。制約論理プログラミング用のライブラリ clpfd を使うと、もっと速く解くことができるかもしれません。興味のある方は試してみてください。
%
% numplace.pl : ナンバープレースの解法
%
% Copyright (C) 2016-2023 Makoto Hiroi
%
% 述語 == による member
memq(X, [Y | _]) :- X == Y.
memq(X, [_ | Ys]) :- memq(X, Ys).
% memq による集合述語
unionq([], Ys, Ys).
unionq([X | Xs], Ys, Zs) :- memq(X, Ys), !, unionq(Xs, Ys, Zs).
unionq([X | Xs], Ys, [X | Zs]) :- unionq(Xs, Ys, Zs).
intersectq([], _, []).
intersectq([X | Xs], Ys, [X | Zs]) :-
memq(X, Ys), !, intersectq(Xs, Ys, Zs).
intersectq([_ | Xs], Ys, Zs) :- intersectq(Xs, Ys, Zs).
differenceq([], _, []).
differenceq([X | Xs], Ys, Zs) :-
memq(X, Ys), !, differenceq(Xs, Ys, Zs).
differenceq([X | Xs], Ys, [X | Zs]) :- differenceq(Xs, Ys, Zs).
% 行列の転置
head([X | _], X).
tail([_ | Xs], Xs).
transpose(Xs, []) :- member([], Xs), !.
transpose(Xs, [Y | Ys]) :-
maplist(head, Xs, Y),
maplist(tail, Xs, Xs1),
transpose(Xs1, Ys).
% ブロックの生成
make_block_sub([],[],[],[]).
make_block_sub([X1, X2, X3 | Xs],
[Y1, Y2, Y3 | Ys],
[Z1, Z2, Z3 | Zs],
[[X1, X2, X3, Y1, Y2, Y3, Z1, Z2, Z3] | Bs]) :-
make_block_sub(Xs, Ys, Zs, Bs).
%
make_block([], []).
make_block([X, Y, Z | Ls], Gs) :-
make_block_sub(X, Y, Z, Gs1),
make_block(Ls, Gs2),
append(Gs1, Gs2, Gs).
% 数字を取り出す
get_number(X, Y, Ls, N) :- nth0(Y, Ls, L), nth0(X, L, N).
% 解析
analysis_sub(X, Y, N, Ls, Cs, Gs, [N, As, Bs]) :-
nth0(Y, Ls, Ys),
nth0(X, Cs, Xs),
G is (Y // 3) * 3 + X // 3,
nth0(G, Gs, Zs),
% 数字と変数に分ける
partition(integer, Ys, Ys1, Ys2),
partition(integer, Xs, Xs1, Xs2),
partition(integer, Zs, Zs1, Zs2),
unionq(Ys1, Xs1, As1),
unionq(Zs1, As1, As2),
% 未確定の数字
differenceq([1,2,3,4,5,6,7,8,9], As2, As),
% 変数のリスト
unionq(Ys2, Xs2, Bs1),
unionq(Zs2, Bs1, Bs).
analysis(_, 9, _, _, _, []).
analysis(9, Y, Ls, Cs, Gs, Zs) :-
Y1 is Y + 1, analysis(0, Y1, Ls, Cs, Gs, Zs).
analysis(X, Y, Ls, Cs, Gs, Zs) :-
get_number(X, Y, Ls, N),
nonvar(N),
X1 is X + 1,
analysis(X1, Y, Ls, Cs, Gs, Zs).
analysis(X, Y, Ls, Cs, Gs, [Z | Zs]) :-
get_number(X, Y, Ls, N),
var(N),
analysis_sub(X, Y, N, Ls, Cs, Gs, Z),
X1 is X + 1,
analysis(X1, Y, Ls, Cs, Gs, Zs).
% 深さ優先探索
dfs([]).
dfs([[N, As, Bs] | Vs]) :-
member(I, As),
maplist(\==(I), Bs),
N = I,
dfs(Vs).
% 解法
solver(N) :-
problem(N, Ls),
transpose(Ls, Cs),
make_block(Ls, Gs),
analysis(0, 0, Ls, Cs, Gs, Vs),
dfs(Vs),
maplist(writeln, Ls),
fail.
% 問題 (出典: 数独 - Wikipedia の問題例)
problem(0, [[5,3,_, _,7,_, _,_,_],
[6,_,_, 1,9,5, _,_,_],
[_,9,8, _,_,_, _,6,_],
[8,_,_, _,6,_, _,_,3],
[4,_,_, 8,_,3, _,_,1],
[7,_,_, _,2,_, _,_,6],
[_,6,_, _,_,_, 2,8,_],
[_,_,_, 4,1,9, _,_,5],
[_,_,_, _,8,_, _,7,9]]).