#はじめに
1981年のマイコン雑誌、月刊RAMに掲載された懸賞問題をPrologで解きました。自作、O-Prologのテストも兼ねています。
#懸賞問題
18＊18のマス目に１から６の数が書き込まれています。左上の位置にサイコロを置いて、これをすべることなく転がして出る目が下に書いてある数字と一致させながら、右下までいく経路を見つけるというものです。
図
問題文（原文）
最初の置き方
#Prologの出番
左に行ってみて行き詰ったら、元に戻して、下に行ってみてだめなら、戻して、右にいってみる、上に行ってみる。こういうバックトラックによる探索にはPrologがうってつけです。
迷路脱出の手法には右手手法、左手手法があります。常に右手（あるいは左手）が壁にから離れないようにして進むという方法です。しかし、この方法はこの問題には通用しないように工夫されています。同じ場所にもう一度やってきて交差するようになっているのです。
#盤面
リストのリストにより配列を表現するようにしました。[[1,2,3][4,5,6][7,8,9]]みたいな感じです。aref(1,2,X) のようにしてやると(1,2)の位置の数を取り出せる述語、aref/3を用意しました。左上が(0.0)で右下が(17,17)です。
#サイコロ
実際にサイコロを作って、転がしたときの面の関係を整理しました。Prologの述語で簡潔明瞭に記述することができます。diceU/2 diceD/2 diceR/2 diceL/2 がそのコードです。F,B,U,D,L,R はそれぞれfront back up down left right の略です。サイコロの面の状態とその推移規則を記述しています。
#探索のルール
一度訪れた場所にはどのようにしてやってきたのかを記録するようにしてあります。arrive/3という述語で動的に記憶しておきます。
例
arrive(1,2,right).
(1,2)の場所には右に移動せよ、というルールに従って訪れているという意味です。これには２つの使い道があります。ひとつは、直前に左から右へと移動してきたのに、また移った先で左に戻ってしまったのでは堂々巡りになります。
もうひとつは図のように交差する場合です。
以前に一度、訪れている場合にはまた、同じ方向に移動してしまうとループ、堂々巡りになってしまいます。これを回避するために使用しています。
#再帰
solve/0はサイコロの初期値を取得、訪れた場所データを初期化して、本体であるsolve1/3を呼び出します。solve1は上、右、下、左の順に移動可能かどうかを探索していきます。Prologにはバックトラックがありますから、失敗したら自動的に戻ってきてやり直します。最終的に(17,17)の位置に到達したときが迷路を脱出した時です。答えを出力して終わります。
出題者によると答えは4通りあるそうです。
#実行例
C:\MinGW\mingw32\bin\O-Prolog>opl
O-Prolog Ver 1.61(Chika)
| ?- ['maze.pl'].
yes
| ?- solve.
[[[17,17],3],[[16,17],6],[[16,16],5],[[16,15],1],[[16,14],2],[[15,14],4],[[14,14],5],[[13,14],3],[[13,15],1],[[14,15],5],[[15,15],6],[[15,16],4],[[15,17],1],[[14,17],5],[[13,17],6],[[13,16],4],[[13,15],1],[[12,15],2],[[12,14],3],[[11,14],6],[[10,14],4],[[9,14],1],[[8,14],3],[[8,15],2],[[8,16],4],[[9,16],1],[[9,17],5],[[8,17],4],[[7,17],2],[[7,16],1],[[6,16],3],[[6,15],5],[[5,15],6],[[4,15],2],[[4,14],4],[[4,13],5],[[4,12],3],[[5,12],6],[[5,11],2],[[5,10],1],[[4,10],3],[[3,10],6],[[2,10],4],[[2,9],5],[[2,8],3],[[3,8],6],[[3,7],2],[[3,6],1],[[3,5],5],[[4,5],4],[[5,5],2],[[6,5],3],[[6,4],6],[[6,3],4],[[6,2],1],[[5,2],2],[[5,1],3],[[5,0],5],[[6,0],1],[[7,0],2],[[8,0],6],[[8,1],3],[[9,1],5],[[10,1],4],[[11,1],2],[[11,2],1],[[11,3],5],[[11,4],6],[[11,5],2],[[12,5],3],[[13,5],5],[[13,6],1],[[13,7],2],[[12,7],3],[[12,8],6],[[11,8],5],[[10,8],1],[[10,7],3],[[10,6],6],[[10,5],4],[[10,4],1],[[9,4],2],[[8,4],6],[[8,5],4],[[8,6],1],[[8,7],3],[[7,7],5],[[6,7],4],[[6,8],6],[[7,8],5],[[8,8],1],[[9,8],2],[[9,7],4],[[9,6],5],[[8,6],1],[[7,6],2],[[6,6],6],[[6,7],4],[[5,7],5],[[4,7],3],[[3,7],2],[[2,7],4],[[2,6],6],[[1,6],5],[[0,6],1],[[0,5],3],[[0,4],6],[[1,4],5],[[1,3],4],[[2,3],1],[[3,3],3],[[3,2],2],[[2,2],1],[[2,1],4],[[2,0],6],[[1,0],5]]yes
|
リストの左側が迷路の脱出口、右側が迷路の入り口です。
リストの各要素は [[行位置、列位置],数]の形式となっています。
#思い出
この月刊誌が私が最初に買ったコンピューター関連の本です。けっこうハイレベルの記事が多かったですね。Lispのことも掲載されていました。基本的にマイコンは自分で作るという時代の雑誌でした。この懸賞問題にはとても興味を惹かれした。当時のPC-8001では再帰がうまくできなかったのですが、回答者はかなりハイレベルな人たちのようで、うまく工夫しながら再帰、バックトラックをしていました。
あれから37年が経ちました。自分でProlog処理系を作り、その処理系を使って問題を解くことができました。感無量です。
#全コード
data/1 盤面のデータ
aref/3 (R,C)の位置のデータをXにunifyする。
solve/0 探索本体
solve/4 (S,T)位置において上、左、下、右の順に移動できるか確認して、移動可なら移動する。その際、arrive/3に動的に情報を記憶しておく。
:- dynamic(arrive/3).
data([[1,4,1,3,6,3,1,4,6,6,2,1,5,6,2,1,1,4],
[5,4,2,4,5,5,5,5,5,3,2,3,5,4,2,3,5,5],
[6,4,1,1,1,4,6,4,3,5,4,2,4,1,5,6,6,4],
[2,4,2,3,5,5,1,2,6,2,6,5,1,2,6,3,2,2],
[1,1,6,3,1,4,1,3,6,4,3,4,3,5,4,2,1,3],
[5,3,2,5,1,2,5,5,1,2,1,2,6,1,3,6,6,5],
[1,6,1,4,6,3,6,4,6,4,3,3,1,2,3,5,3,4],
[2,2,6,5,1,2,2,5,5,5,6,5,1,2,6,2,1,2],
[6,3,6,4,6,4,1,3,1,1,3,4,3,5,3,2,4,4],
[5,5,5,4,2,3,5,4,2,3,1,2,6,6,1,6,1,5],
[1,4,6,3,1,4,6,3,1,6,4,3,4,2,4,5,1,3],
[5,2,1,5,6,2,2,4,5,3,6,5,1,2,6,5,1,2],
[6,3,6,4,1,3,6,3,6,1,6,4,3,5,3,2,4,4],
[2,5,2,4,2,5,1,2,5,4,2,3,6,6,3,1,4,6],
[1,4,1,1,6,3,1,3,6,6,1,6,3,2,5,5,2,5],
[1,5,6,3,5,3,5,4,2,3,5,4,3,1,4,6,4,1],
[3,1,3,6,3,3,6,3,1,1,2,1,6,3,2,1,5,6],
[6,5,1,2,6,5,1,5,1,2,6,5,5,3,2,4,5,3]]).
aref(R,C,X) :-
data(M),
row(R,M,V),
col(C,V,X).
row(0,[V|Vs],V).
row(N,[V|Vs],X) :-
N1 is N-1,
row(N1,Vs,X).
col(0,[E|Es],E).
col(N,[E|Es],X) :-
N1 is N-1,
col(N1,Es,X).
diceU([F,B,U,D,L,R],[D,U,F,B,L,R]).
diceD([F,B,U,D,L,R],[U,D,B,F,L,R]).
diceL([F,B,U,D,L,R],[R,L,U,D,F,B]).
diceR([F,B,U,D,L,R],[L,R,U,D,B,F]).
%initial dice
dice([1,6,5,2,4,3]).
solve :- abolish(arrive/3),dice(X),solve1(0,0,X,[]).
solve1(17,17,X,Root) :- write(Root).
%goto up
solve1(S,T,X,Root) :-
S > 0,
S1 is S - 1,
\+(arrive(S,T,down)),
\+(arrive(S1,T,up)),
diceU(X,[F,B,U,D,L,R]),
aref(S1,T,F),
assertz(arrive(S1,T,up)),
solve1(S1,T,[F,B,U,D,L,R],[[[S1,T],F]|Root]).
%goto right
solve1(S,T,X,Root) :-
T < 17,
T1 is T + 1,
\+(arrive(S,T,left)),
\+(arrive(S,T1,right)),
diceR(X,[F,B,U,D,L,R]),
aref(S,T1,F),
assertz(arrive(S,T1,right)),
solve1(S,T1,[F,B,U,D,L,R],[[[S,T1],F]|Root]).
%goto down
solve1(S,T,X,Root) :-
S < 17,
S1 is S + 1,
\+(arrive(S,T,up)),
\+(arrive(S1,T,down)),
diceD(X,[F,B,U,D,L,R]),
aref(S1,T,F),
assertz(arrive(S1,T,down)),
solve1(S1,T,[F,B,U,D,L,R],[[[S1,T],F]|Root]).
%goto left
solve1(S,T,X,Root) :-
T > 0,
T1 is T - 1,
\+(arrive(S,T,right)),
\+(arrive(S,T1,left)),
diceL(X,[F,B,U,D,L,R]),
aref(S,T1,F),
assertz(arrive(S,T1,left)),
solve1(S,T1,[F,B,U,D,L,R],[[[S,T1],F]|Root]).