フィジカルの練習問題(難)

「Tokyo美人物語」にエビちゃんが出ていない合間を縫ってきしださんからの問題の続きを．

というかkoichikさん向け(^^

小船の問題。

父・母・息子×2・娘×2・メイド・犬がいる

２人乗りの船ひとつで全員向こう岸に渡りたい(犬も一人と数える)

父は母がいないとき娘を食べる

母は父がいないとき息子を食べる

犬はメイドがいないとき家族全員を食べる

船をこげるのは父・母・メイドだけ

みんなが渡れる手順を求めるプログラムを作成せよ。

まずは落ち穂拾いから．
金曜日の日記で妥当な状態を表す述語を作成したのですが，その最後の述語

invalid_state(S) :-
	member(dog, S),
	not(member(made, S)).

これだけだと犬が単独の状態が不正に扱われてしまいます．というか，不正にされてしまって困ったことになったのですが．
そんなわけで (どんなわけで？)，

invalid_state([dog]) :-
	!, fail.
invalid_state(S) :-
	member(dog, S),
	not(member(made, S)).

とすることで犬だけの場合は妥当扱いにしました．心より恥じる．

さて，次は船での移動を表す述語を用意します．
こっちからあっちへ移動できるリスト (集合) を go/1 で，あっちからこっちへ移動できるリスト (集合) を back/1 で表します．
ちょっと悩んだのですが，パターンも少ないことだし単純に定義．

go([f, m]).
go([f, s1]).
go([f, s2]).
go([f, made]).
go([m, d1]).
go([m, d2]).
go([m, made]).
go([made, s1]).
go([made, s2]).
go([made, d1]).
go([made, d2]).
go([made, dog]).

back([f]).
back([m]).
back([made]).
back(L) :-
	go(L).

ちなみに f は父， m は母，s1・s2 は息子1・2，d1・d2は娘1・2，made はメイド，dog は犬．

これで残りは安全に移動可能な組み合わせの探索．
こっちからあっちへ移動可能な組み合わせを示す述語は forward，あっちからこっちへ移動可能な組み合わせを示す述語は backward とします．
で，いろいろ試行錯誤した結果はこうなりました．

forward(H, T, _, _, _, _, R) :-
	go(B),
	difference(H, B, H2),
	H2 = [],
	union(T, B, T2),
	equal_sets(T2, [f, m, s1, s2, d1, d2, made, dog]),
	R = [[H, '>>', B, '>>', T2]], !.
forward(H, T, FHA, FTA, BHA, BTA, R) :-
	go(B),
	subset(B, H),
	difference(H, B, H2),
	element_set(H2, FHA),
	remove_set(FHA, H2, FHA2),
	union(T, B, T2),
	element_set(T2, FTA),
	remove_set(FTA, T2, FTA2),
	backward(H2, T2, FHA2, FTA2, BHA, BTA, R2),
	append([H, '>>', B, '>>', T2], R2, R).

backward(H, T, FHA, FTA, BHA, BTA, R) :-
	back(B),
	subset(B, T),
	difference(T, B, T2),
	element_set(T2, BTA),
	remove_set(BTA, T2, BTA2),
	union(H, B, H2),
	element_set(H2, BHA),
	remove_set(BHA, H2, BHA2),
	forward(H2, T2, FHA, FTA, BHA2, BTA2, R2),
	append([H, '<<', B, '<<', T], R2, R).

引数の H はこっち側の状態を表すリスト，T はあっち側の状態を表すリスト，FHA はこっちからあっちへ移動した後に選択可能なこっち側の状態のリスト，FTA はこっちからあっちへ移動した後に選択可能なあっち側のリスト，BHA はあっちからこっちへ移動した後に選択可能なこっち側のリスト，BTA はあっちからこっちへ移動した後に選択可能なあっち側のリスト，R は移動した結果のリスト．
基本的な考え方は前回示したとおり．

H₀ = S	T₀ = {}
H₁ = H₀ - B₁	T₁ = T₀ + B₁
H₂ = H₁ + B₂	T₂ = T₁ - B₂
H₃ = H₂ - B₃	T₃ = T₂ + B₃
・・・	・・・
H_n = H_n-1 - B_n = {}	T_n = T_n-1 + B_n = S

考え方は Prolog っぽいとはまでは言えなくても，まぁまぁいい感じだと思うのだけど，結果のコードが激しく手続き的なのはいかがなものか？

そして最初の一撃を加えるための述語．

start(R) :-
	valid_state_set(S),
	I = [f, m, s1, s2, d1, d2, made, dog],
	remove_set(S, I, S1),
	forward(I, [], S, S, S1, S, R).

こいつが H₀ および T₀ を与えます．

forward/7 や backward/7 で使っている element_set はある集合が集合の集合の要素 (であるところの集合) かテストする述語，remove_set/3 はある集合を集合の集合から削除する述語です．

element_set(X, [Y|_]) :-
	equal_sets(X, Y).
element_set(X, [_|Set]) :-
	element_set(X, Set).

remove_set([X|Set1], Set, Set1) :-
	equal_sets(X, Set), !.
remove_set([X|Set1], Set, [X|Set2]) :-
	remove_set(Set1, Set, Set2).

Java なら要素が Object だろうが Set だろうが同じ Set のオペレーションが使えるわけですが．．．なんか不便だなぁ．ちゃんとうまい手があるのだろうか？

その他，写経本から持ってきたもの．

element(X, [X|_]).
element(X, [_|Set]) :-
	element(X, Set).

difference([], _, []).
difference([X|Set1], Set2, Diff) :-
	element(X, Set2), !,
	difference(Set1, Set2, Diff).
difference([X|Set1], Set2, [X|Diff]) :-
	difference(Set1, Set2, Diff).

equal_sets(Set1, Set2) :-
	difference(Set1, Set2, []),
	difference(Set2, Set1, []).

intersect([], _, []).
intersect([X|Set1], Set2, [X|Int]) :-
	element(X, Set2), !,
	intersect(Set1, Set2, Int).
intersect([_|Set1], Set2, Int) :-
	intersect(Set1, Set2, Int).

union([], Set, Set).
union([X|Set1], Set2, Union) :-
	element(X, Set2), !,
	union(Set1, Set2, Union).
union([X|Set1], Set2, [X|Union]) :-
	union(Set1, Set2, Union).

こいつを実行した結果 (ちょっと整形してます)．

5 ?- start(R).

R = [
	[[f, m, s1, s2, d1, d2, made, dog], >>, [made, dog], >>, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], <<, [made], <<, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], >>, [made, s1], >>, [dog, made, s1]], 
	[[f, m, s2, d1, d2, made, dog], <<, [made, dog], <<, [dog, made, s1]], 
	[[f, m, s2, d1, d2, made, dog], >>, [f, s2], >>, [s1, f, s2]], 
	[[m, d1, d2, made, dog, f], <<, [f], <<, [s1, f, s2]], 
	[[m, d1, d2, made, dog, f], >>, [f, m], >>, [s1, s2, f, m]], 
	[[d1, d2, made, dog, m], <<, [m], <<, [s1, s2, f, m]], 
	[[d1, d2, made, dog, m], >>, [made, dog], >>, [s1, s2, f, made, dog]], 
	[[d1, d2, m, f], <<, [f], <<, [s1, s2, f, made, dog]], 
	[[d1, d2, m, f], >>, [f, m], >>, [s1, s2, made, dog, f, m]], 
	[[d1, d2, m], <<, [m], <<, [s1, s2, made, dog, f, m]], 
	[[d1, d2, m], >>, [m, d1], >>, [s1, s2, made, dog, f, m, d1]], 
	[[d2, made, dog], <<, [made, dog], <<, [s1, s2, made, dog, f, m, d1]], 
	[[d2, made, dog], >>, [made, d2], >>, [s1, s2, f, m, d1, made, d2]], 
	[[dog, made], <<, [made], <<, [s1, s2, f, m, d1, made, d2]], 
	[[dog, made], >>, [made, dog], >>, [s1, s2, f, m, d1, d2, made, dog]]
] ;

R = [
	[[f, m, s1, s2, d1, d2, made, dog], >>, [made, dog], >>, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], <<, [made], <<, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], >>, [made, s1], >>, [dog, made, s1]], 
	[[f, m, s2, d1, d2, made, dog], <<, [made, dog], <<, [dog, made, s1]], 
	[[f, m, s2, d1, d2, made, dog], >>, [f, s2], >>, [s1, f, s2]], 
	[[m, d1, d2, made, dog, f], <<, [f], <<, [s1, f, s2]], 
	[[m, d1, d2, made, dog, f], >>, [f, m], >>, [s1, s2, f, m]], 
	[[d1, d2, made, dog, m], <<, [m], <<, [s1, s2, f, m]], 
	[[d1, d2, made, dog, m], >>, [made, dog], >>, [s1, s2, f, made, dog]], 
	[[d1, d2, m, f], <<, [f], <<, [s1, s2, f, made, dog]], 
	[[d1, d2, m, f], >>, [f, m], >>, [s1, s2, made, dog, f, m]], 
	[[d1, d2, m], <<, [m], <<, [s1, s2, made, dog, f, m]], 
	[[d1, d2, m], >>, [m, d2], >>, [s1, s2, made, dog, f, m, d2]], 
	[[d1, made, dog], <<, [made, dog], <<, [s1, s2, made, dog, f, m, d2]], 
	[[d1, made, dog], >>, [made, d1], >>, [s1, s2, f, m, d2, made, d1]], 
	[[dog, made], <<, [made], <<, [s1, s2, f, m, d2, made, d1]], 
	[[dog, made], >>, [made, dog], >>, [s1, s2, f, m, d2, d1, made, dog]]
] ;

R = [
	[[f, m, s1, s2, d1, d2, made, dog], >>, [made, dog], >>, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], <<, [made], <<, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], >>, [made, s2], >>, [dog, made, s2]], 
	[[f, m, s1, d1, d2, made, dog], <<, [made, dog], <<, [dog, made, s2]], 
	[[f, m, s1, d1, d2, made, dog], >>, [f, s1], >>, [s2, f, s1]], 
	[[m, d1, d2, made, dog, f], <<, [f], <<, [s2, f, s1]], 
	[[m, d1, d2, made, dog, f], >>, [f, m], >>, [s2, s1, f, m]], 
	[[d1, d2, made, dog, m], <<, [m], <<, [s2, s1, f, m]], 
	[[d1, d2, made, dog, m], >>, [made, dog], >>, [s2, s1, f, made, dog]], 
	[[d1, d2, m, f], <<, [f], <<, [s2, s1, f, made, dog]], 
	[[d1, d2, m, f], >>, [f, m], >>, [s2, s1, made, dog, f, m]], 
	[[d1, d2, m], <<, [m], <<, [s2, s1, made, dog, f, m]], 
	[[d1, d2, m], >>, [m, d1], >>, [s2, s1, made, dog, f, m, d1]], 
	[[d2, made, dog], <<, [made, dog], <<, [s2, s1, made, dog, f, m, d1]], 
	[[d2, made, dog], >>, [made, d2], >>, [s2, s1, f, m, d1, made, d2]], 
	[[dog, made], <<, [made], <<, [s2, s1, f, m, d1, made, d2]], 
	[[dog, made], >>, [made, dog], >>, [s2, s1, f, m, d1, d2, made, dog]]
] ;

R = [
	[[f, m, s1, s2, d1, d2, made, dog], >>, [made, dog], >>, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], <<, [made], <<, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], >>, [made, s2], >>, [dog, made, s2]], 
	[[f, m, s1, d1, d2, made, dog], <<, [made, dog], <<, [dog, made, s2]], 
	[[f, m, s1, d1, d2, made, dog], >>, [f, s1], >>, [s2, f, s1]], 
	[[m, d1, d2, made, dog, f], <<, [f], <<, [s2, f, s1]], 
	[[m, d1, d2, made, dog, f], >>, [f, m], >>, [s2, s1, f, m]], 
	[[d1, d2, made, dog, m], <<, [m], <<, [s2, s1, f, m]], 
	[[d1, d2, made, dog, m], >>, [made, dog], >>, [s2, s1, f, made, dog]], 
	[[d1, d2, m, f], <<, [f], <<, [s2, s1, f, made, dog]], 
	[[d1, d2, m, f], >>, [f, m], >>, [s2, s1, made, dog, f, m]], 
	[[d1, d2, m], <<, [m], <<, [s2, s1, made, dog, f, m]], 
	[[d1, d2, m], >>, [m, d2], >>, [s2, s1, made, dog, f, m, d2]], 
	[[d1, made, dog], <<, [made, dog], <<, [s2, s1, made, dog, f, m, d2]], 
	[[d1, made, dog], >>, [made, d1], >>, [s2, s1, f, m, d2, made, d1]], 
	[[dog, made], <<, [made], <<, [s2, s1, f, m, d2, made, d1]], 
	[[dog, made], >>, [made, dog], >>, [s2, s1, f, m, d2, d1, made, dog]]
] ;

R = [
	[[f, m, s1, s2, d1, d2, made, dog], >>, [made, dog], >>, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], <<, [made], <<, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], >>, [made, d1], >>, [dog, made, d1]], 
	[[f, m, s1, s2, d2, made, dog], <<, [made, dog], <<, [dog, made, d1]], 
	[[f, m, s1, s2, d2, made, dog], >>, [m, d2], >>, [d1, m, d2]], 
	[[f, s1, s2, made, dog, m], <<, [m], <<, [d1, m, d2]], 
	[[f, s1, s2, made, dog, m], >>, [f, m], >>, [d1, d2, f, m]], 
	[[s1, s2, made, dog, f], <<, [f], <<, [d1, d2, f, m]], 
	[[s1, s2, made, dog, f], >>, [made, dog], >>, [d1, d2, m, made, dog]], 
	[[s1, s2, f, m], <<, [m], <<, [d1, d2, m, made, dog]], 
	[[s1, s2, f, m], >>, [f, m], >>, [d1, d2, made, dog, f, m]], 
	[[s1, s2, f], <<, [f], <<, [d1, d2, made, dog, f, m]], 
	[[s1, s2, f], >>, [f, s1], >>, [d1, d2, made, dog, m, f, s1]], 
	[[s2, made, dog], <<, [made, dog], <<, [d1, d2, made, dog, m, f, s1]], 
	[[s2, made, dog], >>, [made, s2], >>, [d1, d2, m, f, s1, made, s2]], 
	[[dog, made], <<, [made], <<, [d1, d2, m, f, s1, made, s2]], 
	[[dog, made], >>, [made, dog], >>, [d1, d2, m, f, s1, s2, made, dog]]
] ;

R = [
	[[f, m, s1, s2, d1, d2, made, dog], >>, [made, dog], >>, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], <<, [made], <<, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], >>, [made, d1], >>, [dog, made, d1]], 
	[[f, m, s1, s2, d2, made, dog], <<, [made, dog], <<, [dog, made, d1]], 
	[[f, m, s1, s2, d2, made, dog], >>, [m, d2], >>, [d1, m, d2]], 
	[[f, s1, s2, made, dog, m], <<, [m], <<, [d1, m, d2]], 
	[[f, s1, s2, made, dog, m], >>, [f, m], >>, [d1, d2, f, m]], 
	[[s1, s2, made, dog, f], <<, [f], <<, [d1, d2, f, m]], 
	[[s1, s2, made, dog, f], >>, [made, dog], >>, [d1, d2, m, made, dog]], 
	[[s1, s2, f, m], <<, [m], <<, [d1, d2, m, made, dog]], 
	[[s1, s2, f, m], >>, [f, m], >>, [d1, d2, made, dog, f, m]], 
	[[s1, s2, f], <<, [f], <<, [d1, d2, made, dog, f, m]], 
	[[s1, s2, f], >>, [f, s2], >>, [d1, d2, made, dog, m, f, s2]], 
	[[s1, made, dog], <<, [made, dog], <<, [d1, d2, made, dog, m, f, s2]], 
	[[s1, made, dog], >>, [made, s1], >>, [d1, d2, m, f, s2, made, s1]], 
	[[dog, made], <<, [made], <<, [d1, d2, m, f, s2, made, s1]], 
	[[dog, made], >>, [made, dog], >>, [d1, d2, m, f, s2, s1, made, dog]]
] ;

R = [
	[[f, m, s1, s2, d1, d2, made, dog], >>, [made, dog], >>, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], <<, [made], <<, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], >>, [made, d2], >>, [dog, made, d2]], 
	[[f, m, s1, s2, d1, made, dog], <<, [made, dog], <<, [dog, made, d2]], 
	[[f, m, s1, s2, d1, made, dog], >>, [m, d1], >>, [d2, m, d1]], 
	[[f, s1, s2, made, dog, m], <<, [m], <<, [d2, m, d1]], 
	[[f, s1, s2, made, dog, m], >>, [f, m], >>, [d2, d1, f, m]], 
	[[s1, s2, made, dog, f], <<, [f], <<, [d2, d1, f, m]], 
	[[s1, s2, made, dog, f], >>, [made, dog], >>, [d2, d1, m, made, dog]], 
	[[s1, s2, f, m], <<, [m], <<, [d2, d1, m, made, dog]], 
	[[s1, s2, f, m], >>, [f, m], >>, [d2, d1, made, dog, f, m]], 
	[[s1, s2, f], <<, [f], <<, [d2, d1, made, dog, f, m]], 
	[[s1, s2, f], >>, [f, s1], >>, [d2, d1, made, dog, m, f, s1]], 
	[[s2, made, dog], <<, [made, dog], <<, [d2, d1, made, dog, m, f, s1]], 
	[[s2, made, dog], >>, [made, s2], >>, [d2, d1, m, f, s1, made, s2]], 
	[[dog, made], <<, [made], <<, [d2, d1, m, f, s1, made, s2]], 
	[[dog, made], >>, [made, dog], >>, [d2, d1, m, f, s1, s2, made, dog]]
] ;

R = [
	[[f, m, s1, s2, d1, d2, made, dog], >>, [made, dog], >>, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], <<, [made], <<, [made, dog]], 
	[[f, m, s1, s2, d1, d2, made], >>, [made, d2], >>, [dog, made, d2]], 
	[[f, m, s1, s2, d1, made, dog], <<, [made, dog], <<, [dog, made, d2]], 
	[[f, m, s1, s2, d1, made, dog], >>, [m, d1], >>, [d2, m, d1]], 
	[[f, s1, s2, made, dog, m], <<, [m], <<, [d2, m, d1]], 
	[[f, s1, s2, made, dog, m], >>, [f, m], >>, [d2, d1, f, m]], 
	[[s1, s2, made, dog, f], <<, [f], <<, [d2, d1, f, m]], 
	[[s1, s2, made, dog, f], >>, [made, dog], >>, [d2, d1, m, made, dog]], 
	[[s1, s2, f, m], <<, [m], <<, [d2, d1, m, made, dog]], 
	[[s1, s2, f, m], >>, [f, m], >>, [d2, d1, made, dog, f, m]], 
	[[s1, s2, f], <<, [f], <<, [d2, d1, made, dog, f, m]], 
	[[s1, s2, f], >>, [f, s2], >>, [d2, d1, made, dog, m, f, s2]], 
	[[s1, made, dog], <<, [made, dog], <<, [d2, d1, made, dog, m, f, s2]], 
	[[s1, made, dog], >>, [made, s1], >>, [d2, d1, m, f, s2, made, s1]], 
	[[dog, made], <<, [made], <<, [d2, d1, m, f, s2, made, s1]], 
	[[dog, made], >>, [made, dog], >>, [d2, d1, m, f, s2, s1, made, dog]]
] ;

No

8 パターン見つけてくれました．
どれも 17 手．もっと手数の多いパターンは見つからなかったよ．なんか間違ってるかなぁ？

これはこれで楽しかったのですが，写経と両立するのはちょっと大変なので，明日からはまた写経に戻ろうと思います．