ネットで見つけた以下の川渡り問題をPrologで解いてみました。
おなじみのやつですね。
Art of Prologとかm.hiroiさんのホームページでも載っていました。
問題：
ある家族がいて、舟を使って川を向こう岸へ渡ろうとしています。
この家族は父、母、息子１、息子２、娘１、娘２、メイド、犬、じっちゃん、
赤ん坊の１０人家族(犬も１人と数えます)です。
舟は１艘(そう)しかなく、１度に２人まで乗ることができます。
また、この舟をこげるのは父と母とメイドとじっちゃんの４人です。
父は、母がいなくなると娘を殺してしまいます。
母は、父がいなくなると息子を殺してしまいます。
じっちゃんは、親がいないと息子や娘、赤ん坊を殺してしまいます。
息子や娘は、親がいないと赤ん坊を殺してしまいます。
犬は、メイドがいないと家族をみんな殺してしまいます。
みんなが無事に川を渡り切るには、どのような手順で渡ればよいでしょうか？
プログラム解説：
盤面生成→チェック → 再帰で次の盤面生成 → チェック → … → クリアするまで繰り返し
失敗すれば バックトラックで次の選択肢を試す
Prologで何も考えずに深さ優先探索で解いています。
枝刈りを行っていず効率の悪いプログラムですが、この程度の問題だと全然問題ないようです。
現在の状態は以下の形式のcompound termで表しています。
state(左岸にいる人のリスト,船に乗っている人のリスト,右岸にいる人のリスト,船の位置(left , right , crossing のいずれか))
assertで生成したstateを登録するようにして、登録済のstateには遷移しないようにしています(意味のない行ったり来たりを防ぐ)
assertする際 順列ではなく組み合わせで登録したいため、リスト内をソートしてから登録しています。
この程度のプログラムだとあまり考えず機械的作業で量産できるようになってきた。
プログラム：
main:-
retractall(state(_,_,_,_)), % assertされた全stateの初期化
A=state([father,mother,son,son,daughter,daughter,maid,dog,granpa,baby],[],[],left), % Initial State
sort_state(A,A1),
assert(A1),
solve(A1).
% クリア
solve(state([],[],_,right)):-
write('cleared!').
% 次の盤面の生成、リストの並び替え、生成した盤面が問題ないかチェック、問題なければ登録、再帰呼び出しにより次のステップへ
solve(A):-
nextstate(A,A1),
sort_state(A1,A2),
chk(A2),
assert(A2),
solve(A2),
nl,
write(A2).
% 盤面の各リストを並び替える
sort_state(state(Left,Ship,Right,Pos),state(Left1,Ship1,Right1,Pos)):-
msort(Left,Left1),
msort(Ship,Ship1),
msort(Right,Right1).
% 盤面のチェック
chk(state(Left,Ship,Right,Pos)):-
not(state(Left,Ship,Right,Pos)),% 生成された state がまだassertされていないことを確認
not(chk_kill(Left)), % 左岸で殺される人がいないかチェック
not(chk_kill(Ship)), % 船で殺される人がいないかチェック
not(chk_kill(Right)), % 右岸で殺される人がいないかチェック
chk_ship(Ship). % 船に運転できる人が乗っているかチェック
% 父は、母がいなくなると娘を殺してしまいます。
chk_kill(List):-
memberchk(father,List),
memberchk(daughter,List),
not(memberchk(mother,List)).
% 母は、父がいなくなると息子を殺してしまいます。
chk_kill(List):-
memberchk(mother,List),
memberchk(son,List),
not(memberchk(father,List)).
% じっちゃんは、親がいないと息子や娘、赤ん坊を殺してしまいます。
chk_kill(List):-
memberchk(granpa,List),
(memberchk(son,List);memberchk(daughter,List);memberchk(baby,List)),
not(memberchk(father,List)),
not(memberchk(mother,List)).
% 息子や娘は、親がいないと赤ん坊を殺してしまいます。
chk_kill(List):-
memberchk(baby,List),
(memberchk(son,List);memberchk(daughter,List)),
not(memberchk(father,List)),
not(memberchk(mother,List)).
% 犬は、メイドがいないと家族をみんな殺してしまいます。
chk_kill(List):-
memberchk(dog,List),
not(memberchk(maid,List)),
( memberchk(son,List);
memberchk(daughter,List);
memberchk(baby,List);
memberchk(father,List);
memberchk(mother,List);
memberchk(granpa,List)
).
% この舟をこげるのは父と母とメイドとじっちゃんの４人
chk_ship([]).
chk_ship(List):-
(
memberchk(father,List);
memberchk(mother,List);
memberchk(maid,List);
memberchk(granpa,List)
).
% 左岸から２人を選んで船に乗せる
nextstate(state(Left,[],Right,left),NextState):-
select(Sel1,Left,Left1),
select(Sel2,Left1,Left2),
NextState=state(Left2,[Sel1,Sel2],Right,crossing).
% 左岸から１人を選んで船に乗せる
nextstate(state(Left,[],Right,left),NextState):-
select(Sel1,Left,Left1),
NextState=state(Left1,[Sel1],Right,crossing).
% 右岸から２人を選んで船に乗せる
nextstate(state(Left,[],Right,right),NextState):-
select(Sel1,Right,Right1),
select(Sel2,Right1,Right2),
NextState=state(Left,[Sel1,Sel2],Right2,crossing).
% 右岸から１人を選んで船に乗せる
nextstate(state(Left,[],Right,right),NextState):-
select(Sel1,Right,Right1),
NextState=state(Left,[Sel1],Right1,crossing).
% 船に乗っている人を左岸に降ろす
nextstate(state(Left,Ship,Right,crossing),NextState):-
append(Left,Ship,Left1),
NextState=state(Left1,[],Right,left).
% 船に乗っている人を右岸に降ろす
nextstate(state(Left,Ship,Right,crossing),NextState):-
append(Right,Ship,Right1),
NextState=state(Left,[],Right1,right).
実行結果：
（下から上に答えに近づいていきます）
4 ?- time(main).
cleared!
state([],[],[baby,daughter,daughter,dog,father,granpa,maid,mother,son,son],right)
state([],[dog,maid],[baby,daughter,daughter,father,granpa,mother,son,son],crossing)
state([dog,maid],[],[baby,daughter,daughter,father,granpa,mother,son,son],left)
state([dog],[maid],[baby,daughter,daughter,father,granpa,mother,son,son],crossing)
state([dog],[],[baby,daughter,daughter,father,granpa,maid,mother,son,son],right)
state([dog],[maid,son],[baby,daughter,daughter,father,granpa,mother,son],crossing)
state([dog,maid,son],[],[baby,daughter,daughter,father,granpa,mother,son],left)
state([son],[dog,maid],[baby,daughter,daughter,father,granpa,mother,son],crossing)
state([son],[],[baby,daughter,daughter,dog,father,granpa,maid,mother,son],right)
state([son],[father,son],[baby,daughter,daughter,dog,granpa,maid,mother],crossing)
state([father,son,son],[],[baby,daughter,daughter,dog,granpa,maid,mother],left)
state([son,son],[father],[baby,daughter,daughter,dog,granpa,maid,mother],crossing)
state([son,son],[],[baby,daughter,daughter,dog,father,granpa,maid,mother],right)
state([son,son],[father,granpa],[baby,daughter,daughter,dog,maid,mother],crossing)
state([father,granpa,son,son],[],[baby,daughter,daughter,dog,maid,mother],left)
state([father,son,son],[granpa],[baby,daughter,daughter,dog,maid,mother],crossing)
state([father,son,son],[],[baby,daughter,daughter,dog,granpa,maid,mother],right)
state([father,son,son],[dog,maid],[baby,daughter,daughter,granpa,mother],crossing)
state([dog,father,maid,son,son],[],[baby,daughter,daughter,granpa,mother],left)
state([dog,maid,son,son],[father],[baby,daughter,daughter,granpa,mother],crossing)
state([dog,maid,son,son],[],[baby,daughter,daughter,father,granpa,mother],right)
state([dog,maid,son,son],[father,granpa],[baby,daughter,daughter,mother],crossing)
state([dog,father,granpa,maid,son,son],[],[baby,daughter,daughter,mother],left)
state([father,granpa,son,son],[dog,maid],[baby,daughter,daughter,mother],crossing)
state([father,granpa,son,son],[],[baby,daughter,daughter,dog,maid,mother],right)
state([father,granpa,son,son],[baby,mother],[daughter,daughter,dog,maid],crossing)
state([baby,father,granpa,mother,son,son],[],[daughter,daughter,dog,maid],left)
state([baby,father,granpa,son,son],[mother],[daughter,daughter,dog,maid],crossing)
state([baby,father,granpa,son,son],[],[daughter,daughter,dog,maid,mother],right)
state([baby,father,granpa,son,son],[dog,maid],[daughter,daughter,mother],crossing)
state([baby,dog,father,granpa,maid,son,son],[],[daughter,daughter,mother],left)
state([baby,dog,father,maid,son,son],[granpa],[daughter,daughter,mother],crossing)
state([baby,dog,father,maid,son,son],[],[daughter,daughter,granpa,mother],right)
state([baby,dog,father,maid,son,son],[granpa,mother],[daughter,daughter],crossing)
state([baby,dog,father,granpa,maid,mother,son,son],[],[daughter,daughter],left)
state([baby,dog,father,granpa,maid,son,son],[mother],[daughter,daughter],crossing)
state([baby,dog,father,granpa,maid,son,son],[],[daughter,daughter,mother],right)
state([baby,dog,father,granpa,maid,son,son],[daughter,mother],[daughter],crossing)
state([baby,daughter,dog,father,granpa,maid,mother,son,son],[],[daughter],left)
state([baby,daughter,father,granpa,mother,son,son],[dog,maid],[daughter],crossing)
state([baby,daughter,father,granpa,mother,son,son],[],[daughter,dog,maid],right)
state([baby,daughter,father,granpa,mother,son,son],[daughter,maid],[dog],crossing)
state([baby,daughter,daughter,father,granpa,maid,mother,son,son],[],[dog],left)
state([baby,daughter,daughter,father,granpa,mother,son,son],[maid],[dog],crossing)
state([baby,daughter,daughter,father,granpa,mother,son,son],[],[dog,maid],right)
state([baby,daughter,daughter,father,granpa,mother,son,son],[dog,maid],[],crossing)
% 85,495 inferences, 0.031 CPU in 0.031 seconds (100% CPU, 2740207 Lips)
true ;
% 32,876 inferences, 0.031 CPU in 0.031 seconds (100% CPU, 1053711 Lips)
false.
