Prolog Programming

幅優先探索

前回は反復深化の例題として、15 パズルの変形版である 7 パズル を解きました。下図に 7 パズルを再掲します。

今回はスタートからゴールに到達する最短手順を「幅優先探索」で求めてみましょう。

●データ構造の定義

7 パズルの盤面は前回と同様にリストで表します。隣接リストの定義と駒を移動する述語 move_piece も前回と同じものを使用します。

リスト : 隣接リストの定義

% 盤面
% 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).

幅優先探索は「キュー (Queue)」を使うと簡単にプログラムすることができます。拙作のページ 待ち行列 (キュー) で作成した差分リストによるキューを使用することにします。

リスト : キューの操作

enqueue(Item, [Qh, [Item | Qt]], [Qh, Qt]).
dequeue(Item, [[Item | Qh], Qt], [Qh, Qt]).
empty([X, Y]) :- X == Y.

今回はキューにリスト [Board, Space] を格納します。Board が盤面、Space が空き場所 (0) の位置を表します。

●幅優先探索

次は幅優先探索で解を求める述語 bfs を作ります。

リスト : 幅優先探索

bfs(Goal, Q) :-
    not(empty(Q)),
    dequeue([Board, Space], Q, Q1),
    (Board == Goal -> (print_answer(Board), fail) ; true),
    neighbor(Space, Xs),
    make_new_board(Board, Space, Xs, Q1, Q2),
    bfs(Goal, Q2).

引数 Goal はゴールを表す盤面、Q はキューを表します。bfs を呼び出すときは、スタートの盤面 [0,7,2,1,4,3,6,5] と空き場所の位置 0 をキューにセットしてください。

まず最初に、キューにデータがあるかチェックします。キューが空の場合は探索失敗となります。次に、dequeue でキューから盤面 Board と空き場所の位置 Space を取り出します。Board と Goal が等しければ、解を求めることができました。述語 print_answer で手順を表示してから fail します。

ゴールに到達していない場合、neighbor から隣接リスト Xs を取り出して、述語 make_new_board で新しい盤面を生成し、それをキューに追加します。同一局面のチェックには事実 check(Board, Prev) を使います。Board が盤面、Prev が 1 手前の盤面です。check に 1 手前の盤面をセットし、これを使って移動手順を表示します。スタートの 1 手前の盤面は無いので、空のリストをセットします。最後に bfs を再帰呼び出しします。

次は述語 make_new_board を作ります。

リスト : 新しい盤面を生成する

make_new_board(_, _, [], Q, Q) :- !.
make_new_board(Board, Space, [X | Xs], Q, Qe) :-
    nth0(X, Board, Piece),
    move_piece(Piece, Board, NewBoard),
    not(check(NewBoard, _)),
    !,
    assert(check(NewBoard, Board)),
    enqueue([NewBoard, X], Q, Qn),
    make_new_board(Board, Space, Xs, Qn, Qe).
make_new_board(Board, Space, [_| Xs], Q, Qe) :-
    make_new_board(Board, Space, Xs, Q, Qe).

最初の規則が再帰呼び出しの停止条件です。隣接リストが空リストになったらキュー Q を返します。そうでなければ、隣接リストから場所 X を取り出し、nth0 で駒 Piece を求めます。それを move_piece に渡して新しい盤面 NewBoard を生成します。そして、同一局面があるかチェックします。

check(NewBoard, _) が失敗すれば、NewBoard は新しい盤面です。assert で事実 check(NewBoard, Board) を登録して、盤面と空き場所の位置をキューに追加して、make_new_board を再帰呼び出しします。check が成功すると 2 番目の規則が失敗するので、最後の規則が実行されます。隣接リストから先頭要素を取り除いて処理を続行します。

最後に手順を表示する述語 print_answer と bfs を呼び出す処理を作ります。

リスト : 実行

% 手順の表示
print_answer([]) :- !.
print_answer(Board) :-
    check(Board, Prev),
    print_answer(Prev),
    write(Board),
    nl.

test :-
    B = [0,7,2,1,4,3,6,5],
    assert(check(B, [])),
    enqueue([B, 0], [Q, Q], Qn),
    bfs([1,2,3,4,5,6,7,0], Qn).

print_answer は簡単です。check から 1 手前の盤面を求めて print_answer を再帰呼び出しします。これで、手順をさかのぼっていき、スタートから盤面を表示することができます。述語 test はスタートの盤面と空き場所の位置をキューに追加してから bfs を呼び出すだけです。

●実行結果

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

?- 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]
% 932,629 inferences, 4.221 CPU in 4.274 seconds (99% CPU, 220925 Lips)
false.

• 実行環境 : SWI-Prolog version 8.4.2, Ubunts 22.04 (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz

当然ですが、最短手数は 36 手、時間は 4 秒ちょっとかかりました。実行時間が遅いのは、check のマッチングに時間がかかるからです。盤面のリストを整数値に変換して check に登録すると、実行速度は大幅に向上します。次のリストを見てください。

リスト : 盤面を数値に変換

board_to_number([], Result, Result).
board_to_number([N | Rest], M, Result) :-
    M1 is M * 10 + N, board_to_number(Rest, M1, Result).

述語 board_to_number は盤面を 8 桁の整数値に変換します。単純な方法ですが、これで盤面を固有の整数値に変換することができます。このほかに、N! 通りのパターンを 0 から N! - 1 までの整数値に変換する方法があります。興味のある方は Puzzle DE Programming の ８パズル をご覧ください。

プログラムの修正は簡単なので、説明は割愛させていただきます。詳細は プログラムリスト１ をお読みください。実際に試してみたところ、実行時間は 0.29 秒になりました。約 15 倍の高速化に大変驚きました。なお、これは SWI-Prolog での結果であり、他の Prolog 処理系で同様な結果が得られるとは限りません。興味のある方は、他の Prolog 処理系でも試してみてください。

●最長手数の局面

次は単純に解くのではなく、パズルが完成するまでに一番手数がかかる配置 (最長手数となる局面) を求めてみましょう。7 パズルは全部で 20160 通りの局面があります。それらすべての局面の最短手順を求めて、その中から最長の手順となる局面を求めることもできますが、それでは時間がとてもかかりそうです。そこで、完成形から始めて一番手数が長くなる局面を生成することにします。

まず、完成形から駒を動かして 1 手で到達する局面をすべて作ります。次に、これらの局面から駒を動かして新しい局面を作れば、完成形から 2 手で到達する局面となります。このように、手数を 1 手ずつ延ばしていき、新しい局面が生成できなくなった時点での手数が求める最長手数となります。この処理は幅優先探索を使えばぴったりです。

●プログラムの作成

プログラムは単純な幅優先探索なので、それほど難しくありません。幅優先探索を行う述語 bfs から説明します。

リスト : 幅優先探索

bfs(N, Xs) :-
    length(Xs, K),
    format('~d moves = ~d~n', [N, K]),
    make_new_state(Xs, Ys),
    N1 is N + 1,
    (Ys == [] -> print_answer(N, Xs) ; bfs(N1, Ys)).

bfs の引数 N は手数、Xs は N 手で生成された局面を格納したリストです。リストの要素は [Board, Space] で、Board が盤面を、Space が空き場所の位置を表します。bfs は N 手の局面から N + 1 手の局面を述語 make_new_state で生成します。新しい局面は変数 Ys に格納されます。Ys が空リストならば N 手の局面 Xs が最長手数の局面となります。述語 print_answer で手数と局面を表示します。そうでなければ bfs を再帰呼び出しします。

次は make_new_state を説明します。

リスト : 新しい局面を作る

make_new_state([], []).
make_new_state(N, [[Board, Space] | Rest ], Ys) :-
    neighbor(Space, Ls),
    move_check(Board, Ls, Ys1),
    make_new_state(Rest, Ys2),
    append(Ys1, Ys2, Ys).

空き場所 Space の隣の場所は neighbor で求めることができます。それを述語 move_check に渡して新しい局面を生成します。新しい局面は変数 Ys1 にセットされます。そして、make_new_state を再帰呼び出しして、次の局面から駒を動かして新しい局面を生成します。返り値は変数 Ys2 にセットされます。最後に append で Ys1 と Ys2 を連結して返します。

次は述語 move_check を説明します。

リスト : 駒の移動と同一局面のチェック

move_check(_, [], []) :- !.
move_check(Board, [X | Rest], [[NewBoard, X] | Ys]) :-
    nth0(X, Board, Piece),
    move_piece(Piece, Board, NewBoard),
    board_to_number(NewBoard, 0, Num),
    not(check(Num)),
    !,
    assert(check(Num)),
    move_check(Board, Rest, Ys).
move_check(Board, [_ | Rest], Ys) :- move_check(Board, Rest, Ys).

move_check は場所 X にある駒を空き場所へ移動します。Board から X にある駒 Piece を求め、move_piece で駒を動かして新しい盤面 NewBoard を生成します。そして、この盤面が述語 check とマッチングしなければ新しい盤面です。assert で check(Num) を登録して次の盤面を生成します。

あとのプログラムは簡単なので説明は割愛させていただきます。詳細は プログラムリスト２ をお読みください。

●実行結果 (2)

それでは実行してみましょう。初期状態を assert で登録してから bfs を呼び出します。

リスト : 実行

test :-
    S = [1,2,3,4,5,6,7,0],
    board_to_number(S, 0, Num),
    assert(check(Num)),
    bfs(0, [[S, 7]]).

?- time(test).
0 moves = 1
1 moves = 2
2 moves = 3
3 moves = 6
4 moves = 10
5 moves = 14
6 moves = 19
7 moves = 28
8 moves = 42
9 moves = 61
10 moves = 85
11 moves = 119
12 moves = 161
13 moves = 215
14 moves = 293
15 moves = 396
16 moves = 506
17 moves = 632
18 moves = 788
19 moves = 985
20 moves = 1194
21 moves = 1414
22 moves = 1664
23 moves = 1884
24 moves = 1999
25 moves = 1958
26 moves = 1770
27 moves = 1463
28 moves = 1076
29 moves = 667
30 moves = 361
31 moves = 190
32 moves = 88
33 moves = 39
34 moves = 19
35 moves = 7
36 moves = 1
moves = 36
[0,7,2,1,4,3,6,5]
% 1,753,389 inferences, 0.329 CPU in 0.329 seconds (100% CPU, 5324098 Lips)
true .

最長手数は 36 手、局面は 1 通りしかありません。実行時間は約 0.33 秒でした。

●プログラムリスト１

%
% seven_bfs.pl : 7 パズル (幅優先探索)
%
%                Copyright (C) 2023 Makoto Hiroi
%

% キュー (差分リスト)
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).

% 盤面を数値に変換
board_to_number([], Result, Result).
board_to_number([N | Rest], M, Result) :-
    M1 is M * 10 + N, board_to_number(Rest, M1, Result).

% 新しい盤面を生成する
make_new_board(_, _, [], Q, Q) :- !.
make_new_board(Board, Space, [X | Xs], Q, Qe) :-
    nth0(X, Board, Piece),
    move_piece(Piece, Board, NewBoard),
    board_to_number(NewBoard, 0, Num),
    not(check(Num, _)),
    !,
    assert(check(Num, Board)),
    enqueue([NewBoard, X], Q, Qn),
    make_new_board(Board, Space, Xs, Qn, Qe).
make_new_board(Board, Space, [_| Xs], Q, Qe) :-
    make_new_board(Board, Space, Xs, Q, Qe).

% 手順の表示
print_answer([]) :- !.
print_answer(Board) :-
    board_to_number(Board, 0, Num),
    check(Num, Prev),
    print_answer(Prev),
    write(Board),
    nl.

% 幅優先探索
bfs(Goal, Q) :-
    not(empty(Q)),
    dequeue([Board, Space], Q, Q1),
    (Board == Goal -> print_answer(Board) ; true),
    neighbor(Space, Xs),
    make_new_board(Board, Space, Xs, Q1, Q2),
    bfs(Goal, Q2).

test :-
    B = [0,7,2,1,4,3,6,5],
    board_to_number(B, 0, Num),
    assert(check(Num, [])),
    enqueue([B, 0], [Q, Q], Qn),
    bfs([1,2,3,4,5,6,7,0], Qn).

●プログラムリスト２

%
% seven_max.pl : 7 パズル (最長手数の局面を求める)
%
%                Copyright (C) 2023 Makoto Hiroi
%

% 盤面
% 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).

% 盤面を数値に変換
board_to_number([], Result, Result).
board_to_number([N | Rest], M, Result) :-
    M1 is M * 10 + N, board_to_number(Rest, M1, Result).

% 同一局面のチェック
move_check(_, [], []) :- !.
move_check(Board, [X | Rest], [[NewBoard, X] | Ys]) :-
    nth0(X, Board, Piece),
    move_piece(Piece, Board, NewBoard),
    board_to_number(NewBoard, 0, Num),
    not(check(Num)),
    !,
    assert(check(Num)),
    move_check(Board, Rest, Ys).
move_check(Board, [_ | Rest], Ys) :- move_check(Board, Rest, Ys).

% 新しい盤面を作る
make_new_state([], []).
make_new_state([[Board, Space] | Rest ], Ys) :-
    neighbor(Space, Ls),
    move_check(Board, Ls, Ys1),
    make_new_state(Rest, Ys2),
    append(Ys1, Ys2, Ys).

% 局面の表示
print_state([]).
print_state([[Board, _] | Rest]) :-
    write(Board), nl, print_state(Rest).

print_answer(N, Xs) :-
    format('moves = ~d~n', N), print_state(Xs).

% 幅優先探索
bfs(N, Xs) :-
    length(Xs, K),
    format('~d moves = ~d~n', [N, K]),
    make_new_state(Xs, Ys),
    N1 is N + 1,
    (Ys == [] -> print_answer(N, Xs) ; bfs(N1, Ys)).

test :-
    S = [1,2,3,4,5,6,7,0],
    board_to_number(S, 0, Num),
    assert(check(Num)),
    bfs(0, [[S, 7]]).

整数の論理演算とビット操作

Prolog の場合、データ構造を表すのにリストがよく使われます。ところが、問題によってはリストよりもビットで表した方が、プログラムを作るのに都合がいい場合もあります。SWI-Prolog には、整数の論理演算とビット操作を行う演算子が用意されています。

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

?- X is 1 \/ 0.
X = 1.

?- X is 1 /\ 0.
X = 0.

?- X is 1 xor 1.
X = 0.

?- X is 1 xor 0.
X = 1.

?- X is \ 0.
X = -1.

?- X is 1 << 1.
X = 2.

?- X is 1 << 2.
X = 4.

●パズル「ライツアウト」

それでは、例題として Puzzel DE Programming で取り上げた ライツアウト というパズルを Prolog で解いてみましょう。ライツアウトの説明は、Puzzle DE Programming と重複するところがありますが、ご容赦くださいませ。

ライツアウトは光っているボタンをすべて消すことが目的のパズルです。ルールはとても簡単です。あるボタンを押すと、そのボタンと上下左右のボタンの状態が反転します。つまり、光っているボタンは消灯し、消えていたボタンは点灯します。次の図を見てください。

          図 : ライツアウトの点灯パターン

ボタンは 5 行 5 列に配置されています。図に示したように、中央のボタン 12 を押すと、そのボタンと上下左右のボタンの状態が反転します。

ライツアウトは、ライトオン・オフの 2 種類の状態しかないので、盤面はリストよりもビットを使って表した方が簡単です。ライトオン・オフの状態を 1 と 0 で表し、各ビットとボタンの座標を対応させると、盤面は 0 から 33554431 の整数値で表すことができます。

ボタンを押してライトの状態を反転する処理も簡単です。たとえば、中央のボタン 12 を押した場合、7, 11, 12, 13, 17 のライトを反転させます。この場合、5 つのボタンのビットをオンにした値 0x23880 (16進数) と、盤面を表す整数値の排他的論理和 (xor) を求めれば、5 つのライトの状態を反転することができます。次の例を見てください。

0       xor 0x23880 => 0x23880    % 消灯の状態でボタン 12 を押す (点灯する)
0x23880 xor 0x23880 => 0          % もう一度同じボタンを押す (消灯する)

このように、ライツアウトは同じボタンを二度押すと元の状態に戻ります。したがって、「同じボタンは二度押さなくてよい」ことがわかります。また、実際にボタンを押してみるとわかりますが、「ボタンを押す順番は関係がない」ことがわかります。たとえば、ボタン 0 と 1 を押す場合、0 -> 1 と押すのも 1 -> 0 と押すのも同じ結果になります。

この 2 つの法則から、ボタンを押す組み合わせは全部で 2 ^ 25 通りになります。ライツアウトを解くいちばん単純な方法は、ボタンを押す組み合わせを生成して、実際にライトが全部消えるかチェックすることです。ところが、この方法ではちょっと時間がかかるのです。実は、もっと高速に解く方法があるのです。

●ライツアウトの解法

ライツアウトは次の図に示すように、ボタンを上から 1 行ずつ消灯していくという、わかりやすい方法で解くことができます。

          図 : 1 行ずつボタンを消灯していく方法

(1) では、1 行目のボタンが 2 つ点灯しています。このボタンを消すには、真下にある 2 行目の B と D のボタンを押せばいいですね。すると (2) の状態になります。次に、2 行目のボタンを消します。3 行目の A, B, D, E のボタンを押して (3) の状態になります。

あとはこれを繰り返し、4 行目までのボタンを消したときに、5 行目のボタンも全部消えていれば成功となります。(4) のように、5 行目のボタンが消えない場合は失敗です。この場合は、1 行目のボタンを押して、点灯パターンを変更します。

2 - 5 行目のボタンの押し方は、1 行目の点灯パターンにより決定されるので、けっきょく 1 行目のボタンの押し方により、解けるか否かが決まります。この場合、ボタンの押し方は、2 ^ 5 = 32 通りしかありせん。つまり、たった 32 通り調べるだけで、ライツアウトの解を求めることができます。

このほかに、高橋謙一郎さんの コンピュータ＆パズル では、細江万太郎さんが考案されたライツアウトを連立方程式で解く方法が紹介されています。この方法には M.Hiroi も驚きました。

●ライツアウト解法プログラム

それではプログラムを作りましょう。最初に、ボタンを押したときにライトの状態を反転させるための値を pattern に定義します。

リスト : ボタンを押したときのパターン

pattern(0, 0x0000023). pattern(1, 0x0000047). pattern(2, 0x000008e). pattern(3, 0x000011c).
pattern(4, 0x0000218). pattern(5, 0x0000461). pattern(6, 0x00008e2). pattern(7, 0x00011c4).
pattern(8, 0x0002388). pattern(9, 0x0004310). pattern(10, 0x0008c20). pattern(11, 0x0011c40).
pattern(12, 0x0023880). pattern(13, 0x0047100). pattern(14, 0x0086200). pattern(15, 0x0118400).
pattern(16, 0x0238800). pattern(17, 0x0471000). pattern(18, 0x08e2000). pattern(19, 0x10c4000).
pattern(20, 0x0308000). pattern(21, 0x0710000). pattern(22, 0x0e20000). pattern(23, 0x1c40000).
pattern(24, 0x1880000).

pattern(N, Value) の引数 N がボタンの番号で、Values がライトの状態を反転させるための値です。

次は、ライツアウトを解くプログラム solver を作ります。

リスト : ライツアウトの解法

solver(Board) :-
    between(0, 31, N),
    push_button(N, 0, Board, NewBoard),
    clear_light(5, NewBoard, Result, N, PushPattern),
    Result == 0,
    print_answer(PushPattern).

1 行目のボタンの押し方は 32 通りあります。solver は失敗駆動ループにより 32 通りの押し方をすべてをチェックします。ボタンの押し方は 0 から 31 までの数値で表します。この値は 5 ビットで表すことができるので、ビットとボタンの位置を対応させて、ビットがオンであれば、そのボタンを押すことにします。この処理を述語 push_button で行います。結果は NewBoard にセットされます。

1 行ずつライトを消していく処理は述語 clear_light で行います。ボタンを押したあとの盤面は変数 Result に、ボタンを押した位置は変数 PushPattern にセットされます。PushPattern は、対応するビットをオンにすることで押したボタンの位置を表します。Result が 0 になればすべてのライトが消灯したので、print_answer で解を表示します。失敗駆動ループを構成するため、print_answer は必ず失敗することに注意してください。

次は、1 行目のボタンを押す push_button を作ります。

リスト : 1 行目の５つのボタンを押す

push_button(_, 5, Board, Board) :- !.
push_button(N, M, Board, Result) :-
    ((1 << M) /\ N) > 0,          % ビットオンならばボタンを押す
    pattern(M, Pattern),
    NewBoard is Board xor Pattern,
    M1 is M + 1, !, push_button(N, M1, NewBoard, Result).
push_button(N, M, Board, Result) :-
    M1 is M + 1, push_button(N, M1, Board, Result).

引数 N が押すボタンを表す値で、M がボタンの位置を表します。最初の規則が再帰の停止条件です。ボタンは 0 から 4 までの 5 つなので、M が 5 になればボタンを押す処理を終了します。

次の規則で、整数値 N の M 番目のビットがオンならば、M 番目のボタンを押します。ビットのチェックは、論理積 /\ を使えば簡単です。ビットシフト << を使って 1 を左へ M ビットシフトし、N との論理積を求めます。ビットがオフであれば論理積の結果は 0 になるので、0 より大きければビットはオンであることがわかります。

ボタンを押す処理も簡単です。pattern からライトを反転させる値を取り出し、xor でライトを反転させて新しい盤面 NewBoard を作るだけです。ビットがオフであれば、最後の規則が実行されて次のボタンをチェックします。それから、push_button は再試行する必要はないので、カットを使っていることに注意してください。

次は clear_light を作ります。

リスト : 上の行のライトを消す

clear_light(25, Board, Board, Push, Push) :- !.
clear_light(N, Board, Result, Push, PushResult) :-
    M is N - 5,
    (Board /\ (1 << M)) > 0,
    pattern(N, Pattern),
    NewBoard is Board xor Pattern,
    NewPush is Push \/ (1 << N),
    N1 is N + 1, !, clear_light(N1, NewBoard, Result, NewPush, PushResult).
clear_light(N, Board, Result, Push, PushResult) :-
    N1 is N + 1, clear_light(N1, Board, Result, Push, PushResult).

clear_light の引数 N がボタンの位置、Board が盤面の状態、Push が押したボタンの位置を表します。最初の規則が再帰の停止条件です。次の規則で、上のライトが点灯しているかチェックします。上のライトは M で表していて、その位置は N - 5 で求めることができます。

Board の M 番目のビットがオンであればライトが点灯しているので、N 番目のボタンを押して新しい盤面 NewBoard を作ります。押したボタンの位置は Push に記憶します。ボタン N を押した場合は、Push の N 番目のビットをオンにします。ビットシフト << で 1 を左へ N ビットシフトし、Push との論理和を求めれば、N 番目のビットだけをオンにすることができます。

ライトが点灯していない場合は、最後の規則が実行されて次のボタンを処理します。それから、clear_light も再試行する必要がないので、カットを使っていることに注意してください。

最後に、解を出力する print_answer を作ります。

リスト : 解の出力

print_answer(PushPattern) :-
    nl,
    between(0, 24, N),
    ((PushPattern /\ (1 << N)) > 0 -> write('1') ; write('0')),
    M is N mod 5,
    (M == 4 -> nl),
    fail.

print_answer は失敗駆動ループでプログラムします。PushPattern の各ビットをチェックして、オンであれば 1 を、オフであれば 0 を出力します。5 行 5 列に出力するため、N mod 5 の値が 4 であれば nl で改行を出力します。

●実行結果

これでプログラムは完成です。それでは実行してみましょう。ライトが全部点灯している状態 (0x1ffffff) を解いてみます。

?- solver(0x1ffffff).

11000
11011
00111
01110
01101

10110
01110
11100
11011
00011

01101
01110
00111
11011
11000

00011
11011
11100
01110
10110
false.

4 通りの解が出力されました。ボタンを押した回数は、どの解も 15 回になりました。実は、これがライツアウトの最長手数なのです。ライツアウトの場合、ライトの点灯パターンは 2 ^ 25 = 33554432 通りありますが、実際に解が存在するパターンは、その 1 / 4 の 8388608 通りしかありません。その中で最短回数が 15 回で解けるパターンは 7350 通りあり、そのうちのひとつが、ライトが全部点灯しているパターンなのです。

ライツアウトの最長手数に興味のある方は、Puzzle DE Programming ライツアウト の 最長手数を求める を読んでみてください。

●プログラムリスト

%
% lo.pl : ライツアウトの解法
%
%         Copyright (C) 2001-2023 Makoto Hiroi
%

% ボタンを押したときのパターン
pattern(0, 0x0000023).  pattern(1, 0x0000047).  pattern(2, 0x000008e).  pattern(3, 0x000011c).
pattern(4, 0x0000218).  pattern(5, 0x0000461).  pattern(6, 0x00008e2).  pattern(7, 0x00011c4).
pattern(8, 0x0002388).  pattern(9, 0x0004310).  pattern(10, 0x0008c20). pattern(11, 0x0011c40).
pattern(12, 0x0023880). pattern(13, 0x0047100). pattern(14, 0x0086200). pattern(15, 0x0118400).
pattern(16, 0x0238800). pattern(17, 0x0471000). pattern(18, 0x08e2000). pattern(19, 0x10c4000).
pattern(20, 0x0308000). pattern(21, 0x0710000). pattern(22, 0x0e20000). pattern(23, 0x1c40000).
pattern(24, 0x1880000).

% 上の行のライトを消す
clear_light(25, Board, Board, Push, Push) :- !.
clear_light(N, Board, Result, Push, PushResult) :-
    M is N - 5,
    (Board /\ (1 << M)) > 0,
    pattern(N, Pattern),
    NewBoard is Board xor Pattern,
    NewPush is Push \/ (1 << N),
    N1 is N + 1, !, clear_light(N1, NewBoard, Result, NewPush, PushResult).
clear_light(N, Board, Result, Push, PushResult) :-
    N1 is N + 1, clear_light(N1, Board, Result, Push, PushResult).

% 1 行目のボタンを押す
push_button(_, 5, Board, Board) :- !.
push_button(N, M, Board, Result) :-
    ((1 << M) /\ N) > 0,          % ビットオンならばボタンを押す
    pattern(M, Pattern),
    NewBoard is Board xor Pattern,
    M1 is M + 1, !, push_button(N, M1, NewBoard, Result).
push_button(N, M, Board, Result) :-
    M1 is M + 1, push_button(N, M1, Board, Result).

% 解の表示
print_answer(PushPattern) :-
    nl,
    between(0, 24, N),
    ((PushPattern /\ (1 << N)) > 0 -> write('1') ; write('0')),
    M is N mod 5,
    (M == 4 -> nl),
    fail.

% 解法
solver(Board) :-
    between(0, 31, N),
    push_button(N, 0, Board, NewBoard),
    clear_light(5, NewBoard, Result, N, PushPattern),
    Result == 0,
    print_answer(PushPattern).