Qiitaに論理パズルをprologで解いた記事がありましたので、私も解いてみました。
まず犯人は誰だ?という問題です。
元の問題と答え->https://ameblo.jp/tarai-400m/entry-10090476565.html
Qiitaの解答例->https://qiita.com/Soichir0/items/de7d8d9ac16f5b704e19
登場人物と証言のリストを作ります。登場人物名は元の問題に従っています。
member/2で犯人の候補を選びます。
select/3でうその候補(notで真になる)を二つ選び、、他の証言も並べます。
後はバックトラックで、すべての条件を満たす人物が選ばれるのを待つだけです。
%swi-prolog version 7.4.2
%ans.
%:-initialization(ans). %ideone
ans:-L=[a:(X\==a,X\==c),b:(X\==b,X\==a),c:(X==a;X==e),d:(X==b;X==e),e:(X==c;X==d)],
member(X:_,L),select(Y:R1,L,L1),not(R1),select(Z:R2,L1,[R3,R4,R5]),not(R2),R3,R4,R5,
write(criminal->X:lier->Y+Z).
これを「事実」と「規則」をきちんと書いて解きました。
なるべく素直にと思ったら、assert/1とabolish/1が必要になってしまいました。
%ans.
%:-initialization(ans). %ideone
per(a).
per(b).
per(c).
per(d).
per(e).
cri(X).
say(a,(not(cri(a)),not(cri(c)))).
say(b,(not(cri(b)),not(cri(a)))).
say(c,(cri(a);cri(e))).
say(d,(cri(b);cri(e))).
say(e,(cri(c);cri(d))).
hon(X):-per(X),say(X,R),R.
lie(X):-per(X),say(X,R),not(R).
rule(A,E,F):-
per(A),abolish(cri/1),assert(cri(A)),hon(B),hon(C),hon(D),
lie(E),lie(F),B\==C,C\==D,D\==B,F\==E,!.
ans:-rule(A,E,F),write(criminal->A:lier->E+F).
もう少し端折ってper/1を省くこともできます。per(A)の代わりにsay(A,_)を使います。
次にシマウマのパズルです。
問題と解答例->https://qiita.com/Soichir0/items/daa0b9df8a2500ae0a04
まず6項目を含むリストを考えます。
家の並び方の処理が面倒そうなので、最初に左からの順番で分けた五つのリストを作ります。
その後、それぞれの条件の入ったリストをひたすらmember/2でユニフィケーションさせます。
問題の条件には縞馬と水がありませんので、
最後にそれの入ったリストをユニフィケーションさせます。
%ans.
%:-initialization(ans). %ideone
%Na:(d,j,s,g,b),Or:(1,2,3,4,5),Co:(r,g,y,b,cr),Dr:(t,c,m,w,j),An:(d,f,h,s,z),Fo:(k,ak,ks,bs,sl)
ans:-P=[[_,1,_,_,_,_],[_,2,_,_,_,_],[_,3,_,_,_,_],[_,4,_,_,_,_],[_,5,_,_,_,_]],
member([d,1,_,_,_,_],P),member([j,_,_,_,_,bs],P),member([s,_,r,_,_,_],P),
member([g,_,_,_,d,_],P),member([b,_,_,t,_,_],P),member([_,_,g,c,_,_],P),
member([_,O1,g,_,_,_],P),member([_,O2,cr,_,_,_],P),plus(O2,1,O1),
member([_,_,_,_,s,k],P),member([_,_,y,_,_,ak],P),member([_,3,_,m,_,_],P),
member([_,O3,_,_,_,ks],P),member([_,O4,_,_,f,_],P),abs(O4-O3,1),
member([_,O5,_,_,_,ak],P),member([_,O6,_,_,h,_],P),abs(O6-O5,1),
member([_,_,_,j,_,sl],P),member([_,O7,b,_,_,_],P),abs(O7-1,1),
member([Ze,_,_,_,z,_],P),member([Wa,_,_,w,_,_],P),write(water->Wa:zebra->Ze),!.
「事実」と「規則」をきちんと書くのが常道なのでしょうが、
頭をあまり働かせなくても手を動かせば解けてしまう方法を使ってしまいます。
最後は川渡りパズル「危険な家族」です。
問題と解答例->https://qiita.com/Soichir0/items/e6f5a9fa736a727ab48d
まず問題に従って、r1/1,2で乗船できる人、r2/1からr4/1で同居できる人の規則を作ります。
次にgo/4で渡河の処理をしますが、第一引数と第二引数を交換することにより、
左から右と右から左の処理を交互に行います。
select/3で乗船する人を選ぶと同時に移動処理もしています。
渡河する際に、移動する人が乗船可能か、移動後の左右の人々(F,T)が同居可能か調べます。
可能ならば、TLに左右の岸の人のリストを船の位置(リストの先頭に付加)とともに追加します。
TLは移動の記録を保存するとともに、堂々巡りを避けるため、
過去に同じ状態がなかったか調べるのにも使います。
別解が7つありますので、処理系があれば「;」+「Enter」で別解がでます。「Enter」で終了です。
適切な処理系があれば「;」(+「Enter」)で別解が出ます。「.」(「Enter」)で終了です。
できるだけ問題の文章に沿って規則を書いてみました。
%ans.
%:-initialization(ans). %ideone
r1([X]):-(X==fa;X==mo;X==but).
r1([X,Y]):-X=fa;(X=mo,Y\=fa);(X=but,Y\=fa,Y\=mo).
r2(L):-not((member(fa,L),not(member(mo,L)),(member(da1,L);member(da2,L)))).
r3(L):-not((member(mo,L),not(member(fa,L)),(member(so1,L);member(so2,L)))).
r4(L):-not((select(dog,L,L1),L1\=[],delete(L1,but,L1))).
rule(L):-r2(L),r3(L),r4(L).
go(_,l:[],TL,TL).
go(U1:F1,U2:T1,TL1,R):-
select(X,F1,F),B=[X],r1(B),T=[X|T1],rule(F),rule(T),
sort(T,TS),not(member(U2:TS,TL1)),TL2=[U2:TS|TL1],
sort(F,FS),TL=[U2:FS|TL2],go(U2:T,U1:F,TL,R).
go(U1:F1,U2:T1,TL1,R):-
select(X,F1,F2),select(Y,F2,F),B=[X,Y],r1(B),rule(B),rule(F),
append([X,Y],T1,T),rule(T),sort(T,TS),not(member(U2:TS,TL1)),
TL2=[U2:TS|TL1],sort(F,FS),TL=[U2:FS|TL2],go(U2:T,U1:F,TL,R).
disp([]).
disp([A,B|T]):-A=_:A1,B=_:B1,writeln(B1-A1),disp1(T).
disp1([C,D|T]):-C=_:C1,D=_:D1,writeln(C1-D1),disp(T).
ans:-L=l:[but,da1,da2,dog,fa,mo,so1,so2],go(L,r:[],[r:[],L],R),disp(R).
パターンマッチを利用した解法も書いてみました。
fm/1は父母と子供の、dogが犬と人の安全な関係です。1が存在0が不在を表します。
boat/2はボートに乗れる人の規則です。
leav/2は出発する人の削除、arri/2は到着する人の追加です。
acro/4が上のgo/4に相当しますが、
乗船する人をboat/2でまとめて処理していますので簡潔になっています。
またnth1を多用してしまいました。
%ans.
%:-initialization(ans). %ideone
%[but,dog,so1,so2,fa,mo,da1,da2]
fm([_,_,_,_,X,X,_,_]):-!.
fm([_,_,_,_,1,0,0,0]):-!.
fm([_,_,0,0,0,1,_,_]).
dog([0,1,0,0,0,0,0,0]):-!.
dog([1,_,_,_,_,_,_,_]):-!.
dog([0,0,_,_,_,_,_,_]).
safe(L):-fm(L),dog(L).
boat([X],L):-(X=1;X=5;X=6),nth1(X,L,1).
boat([1,Y],L):-nth1(1,L,1),between(2,8,Y),nth1(Y,L,1).
boat([5,Y],L):-nth1(5,L,1),(Y=3;Y=4;Y=6),nth1(Y,L,1).
boat([6,Y],L):-nth1(6,L,1),(Y=7;Y=8),nth1(Y,L,1).
leav([],L,L).
leav([H|T],L,R):-leav(T,L,R1),nth1(H,R1,1,L1),nth1(H,R,0,L1).
arri([],L,L).
arri([H|T],L,R):-arri(T,L,R1),nth1(H,R1,0,L1),nth1(H,R,1,L1).
acro(r:[1,1,1,1,1,1,1,1],_,TL,TL).
acro(U1:F1,U2:T1,TL1,R):-
boat(L,F1),leav(L,F1,F),safe(F),arri(L,T1,T),safe(T),
not(member(U2:T,TL1)),TL2=[U2:T|TL1],TL=[U2:F|TL2],acro(U2:T,U1:F,TL,R).
ans:-L=l:[1,1,1,1,1,1,1,1],L1=r:[0,0,0,0,0,0,0,0],acro(L,L1,[L1,L],R),
maplist(cha,R,R1),out(R1).
out([]).
out([A,B|T]):-writeln(B-A),out1(T).
out1([C,D|T]):-writeln(C-D),out(T).
cha(_:L,R):-cha1(L,[but,dog,so1,so2,fa,mo,da1,da2],R).
cha1([],_,[]).
cha1([LH|LT],[SH|ST],R):-cha1(LT,ST,R1),(LH=1->R=[SH|R1];R=[" "|R1]).