コミニュケーションゲームに野球のポジション当てゲームというのがあるのですが、Prologで解いてみました。
解き方の基本
このゲームの一般的な解き方は、横軸:ポジション、縦軸:選手名、の様なクロス表にして、それぞれのマスに「○」か「×」を埋めていきます。こういう解き方の場合、Prologよりも命令型プログラミング言語の方が良さそうです。行列を上手く表現できる言語を選ぶと良いでしょう。
今回はPrologで解くので、Prologの基礎を学びやすい、という意味でベタに総当たり的に解きます。
具体的には9名分の変数リストを用意して、そこに9ポジションを割り当てる組み合わせを全て試して、情報カードに矛盾が無いか調べます。
Poss = [pitcher,catcher,first,second,third,short,left,center,right],
Names = [XXX, Suzuki, Sakurai, XXX, XXX, Kinoshita, XXX, Ogawa, Yamada],
permutation(Poss, Names),
名前リストのXXXの箇所は、引用元に配慮し伏字にしましたが、実際は名前を表す変数になります。
permutationでポジションと選手名の全ての組み合わせを試します。
組み合わせの数は、$_9 P_9 = 9! = 362880$となります。つまり３６万回以上のバックトラックになります。結構な数に思えますが余程の低スペックPCでもなければこの程度は秒で終わります。
計算量は $O(N!)$ とアルゴリズムとしてはかなり低パフォーマンスですね。クロス表で解く方法なら、$O(N^2)$程度の計算量ですから、普通は後者で解くのかもしれませんが、今回はNがたかだか９なので気にしないでいきましょう。
それぞれの情報カードの種類を分類する
このゲームの情報カードは次の３つに分類できます。
- 同一性: ○○選手は△△(ポジション)である・ない
- 事実関係: ○○選手は既婚・未婚
- 推移関係: ○○は△△より背が高い・低い
この3種類のコードの書き方を以下に説明します。
同一性(○○選手は△△である・ない)の妥当性
1.藤山選手はサードと同じアパートに住んでいるということだ。
この文から藤山とサードは別人と分かります。Prologでこう書きます。
third \== Fujiyama,
論理的に言うと藤山がサードでも間違いでは無いです。こう言う曖昧表現このゲーム多いですが、論理的に厳密に解釈していると答えが出ません。論理思考の人にはスッキリしないでしょうが、まぁこういうゲームです。
7.外野選手のうち一人はどうも木下選手か松村選手らしい。
((foranymemberis( [left, center, right], ==, Kinoshita),
forallmemberare( [left, center, right], \==, Matumura) %「1人は」なので他方を除外
);
(foranymemberis( [left, center, right], ==, Matumura),
forallmemberare( [left, center, right], \==, Kinoshita) %「1人は」なので他方を除外
)),
「1人は」のところは論理的に曖昧ですが、ここは「1人だけが」と解釈しないと答えに辿り着けません。
foranymemberisとforallmemberareいう述語は下の様に作りました。
% ListのいずれかのmemberはArg1とPredである
foranymemberis(List, Pred, Arg1) :-
forany(member(X, List), call(Pred, X, Arg1)).
% Listの全てのmemberはArg1とPredである
forallmemberare(List, Pred, Arg1) :-
forall(member(X, List), call(Pred, X, Arg1)).
forany(Cond,Action) :-
\+forall(Cond,\+Action).
9.選手達はよく揃ってゴルフに行くが、梅田・藤山・桜井の３選手はどうしてもキャッチャーとセカンドには勝てないようだ。
これは、梅田・藤山・桜井 と キャッチャー・セカンド はそれぞれ別人と解釈します。
allofeachare([catcher, second], \==, [Umeda, Fujiyama, Sakurai]),
述語allofeachareは下の通り。
% ListxとListyの互いの全てがPredである
allofeachare(Listx, Pred, Listy) :-
forall(member(X, Listx),
forall(member(Y, Listy), call(Pred, X, Y))).
13.山田選手は桜井選手より背が高く、木下選手は桜井選手より背が低い。しかし、この３人はいずれもファーストより低い。
ここの文は後の「推移関係の妥当性」でもう一度出てきますが、今のところは同一性にだけ着目して、「山田・桜井・木下はファーストではない」と解釈します。
maplist(\==(first), [Yamada, Sakurai, Kinoshita]),
15.バッテリーと内野の全員はXXX・XXX・XXXの３選手を除くとみんな小川選手より背が低い。
「XXX・XXX・XXX」の箇所は引用元に配慮して伏字にしています。
ここも後の「推移関係の妥当性」でも出てきますが、今は「XXX・XXX・XXXの３人はバッテリーか内野である」かつ「小川はバッテリーでも内野でもない」と解釈します。ここでも曖昧表現の拡大解釈ですが、そういうゲームと割り切りです。
Batt_infield = [pitcher, catcher, first, second, third, short],
member(XXX1, Batt_infield),
member(XXX2, Batt_infield),
member(XXX3, Batt_infield),
maplist(\==(Ogawa), Batt_infield),
事実関係(○○選手は既婚・未婚)の妥当性
既婚・未婚の情報をPrologでどう扱えば良いでしょうか。
「セカンドは未婚」や「サードは既婚」をmarried(second, 0),married(third, 1)という様に表現しましょう。
married(Ogawa, 1)の様に第一引数に変数(選手名)が来る事もあるので、married/2は動的に追加・削除しなければなりませんので:- dynamic( married/2 ).の1行が必要です。
既婚・未婚の追加・照合する述語q_marriedを作ります。
:- dynamic( married/2 ).
% 結婚しているか?
% Pos : ポジション
% note: 事実married(Pos, _)が無ければ作るし、あれば照合する
q_married(Pos, M) :-
if(clause(married(Pos, Mx), _),
Mx == M, %then 照合
assert(married(Pos, M)) %else 無いので作る
).
複数の人をまとめて追加・照合する述語q_married_allも作っておきます。
q_married_all(Poss, M) :-
forall(member(Pos, Poss), q_married(Pos, M)).
バックトラック毎にmarried/2を全消去しなければなりません。その為の述語clear_marriedは下の通り。
clear_married :-
if(retractall(married(_,_)), true, true).
使い方の例は
4.キャッチャーの長男とサードの次女は同じ小学校の同級生だそうだ。
子供がいる人は既婚だという前提条件があります。
q_married(catcher, 1), q_married(third, 1),
12．選手たちのうちで、独身なのは、鈴木・梅田・山田の３選手、それにセンターとライトの５人である。
Not_mar_s = [Suzuki, Umeda, Yamada, center, right],
subtract(Names, Not_mar_s, Mar_s), % この5人以外の4人を抽出
q_married_all(Not_mar_s, 0), % 5人は未婚
q_married_all(Mar_s, 1). % 残りの4人は既婚
残りの４人が既婚という条件を忘れがちなので注意。文の曖昧さから「残りの４人が既婚」と断言できませんが、実際こう解釈しないと答えは一つになりません。
推移関係(○○は△△より背が高い・低い)の妥当性
「foo選手はbar選手より背が高い」「baz選手はbar選手より背が低い」の様な関係を推移関係と言います。
「foo選手はbar選手より背が高い」「baz選手はfoo選手より背が高い」「bar選手はqux選手より背が低い」は妥当ですよね。
「foo選手はbar選手より背が高い」「baz選手はfoo選手より背が高い」「baz選手はbar選手より背が低い」は妥当でしょうか？
図の通り駄目ですね。この様な推移関係の妥当さをどう判定すれば良いでしょうか。
一旦野球の話は置いて、別の例で解説します。
「東京 は 日本 にある」「千代田区 は 東京 にある」の様な二項関係から、「千代田区 は 日本 にある」と言える場合、これらの二項関係は推移的であると言えます。
「東京は日本にある」と言う事実をloc(tokyo, japan).というふうに表してみます。
素朴なprologコードで表せば次の様になります。
loc(tokyo, japan).
loc(chiyoda_ku, tokyo).
loc(kanda, chiyoda_ku).
loc(yodobashi_camera, kanda).
locatedIn(A, B) :-
loc(A, B).
locatedIn(A, B) :-
loc(Inter, B),
locatedIn(A, Inter).
swipl transitive1.plでreplに入ってヨドバシカメラは日本にあるのか問うて見ましょう。
?- locatedIn(yodobashi_camera, japan).
true ;
false.
問題ないですね。trueの後に;を押したらfalse.となるのは他には解が無いと言っているので問題ありません。
ここで下の様に間違ったloc「東京はヨドバシカメラにある」を追加してしまったとしましょう。
loc(tokyo, yodobashi_camera).
先ほどと同じ問いをしてみます。
?- locatedIn(yodobashi_camera, japan).
true ;
true ;
true ;
;を何回押しても延々trueを出し続けてEnterを押すまで終わりません。
これは解が決まらない事を表しています。これで事実locに間違いがあると分かるのですが、プログラムに組み込むなら無限ループになり都合が悪いです。延々trueを出し続けるよりfalseを出して終わって欲しいですね。
この間違った二項関係の推移を有向グラフで表すと下の様になります。
東京からヨドバシカメラへの矢印が間違って追加されているので巡回路ができてしまいました。
この様な巡回路が存在したらすぐに分かる様にしましょう。
巡回路の無い有向グラフを「有向非巡回グラフ」と言い、この場合はトポロジカルソートが可能です。
これを利用し、グラフのトポロジカルソートを試み、失敗したら巡回路があるという事になります。
先ほどのコードはugraphsモジュールを使って書き直します。
今度は二項関係をA-Bの様に表し、リストで[tokyo-japan, chiyoda_ku-tokyo, kanda-chiyoda_ku, yodobashi_camera-kanda]というふうに表現します。ugraphsモジュールのadd_edgesでこれら二項関係のリストを有向グラフにします。トポロジカルソートはtop_sortで実行し、成功したら巡回路はないので、次にAからBへの経路があるかをreachable(A, Gph, Vs), member(B, Vs)で調べます。
下のコードには「東京はヨドバシカメラにある」という間違った事実を敢えて含めています。
:- use_module(library(ugraphs)).
locatedIn(A, B) :-
dif(A, B),
add_edges([], [tokyo-japan, chiyoda_ku-tokyo, kanda-chiyoda_ku, yodobashi_camera-kanda, tokyo-yodobashi_camera], Gph),
top_sort(Gph, _),
reachable(A, Gph, Vs),
member(B, Vs).
swipl transitive2.plでreplに入り
?- locatedIn(yodobashi_camera, japan).
false.
うまく間違いを見つけました。間違い「東京はヨドバシカメラにある」を取り除いてみます。
:- use_module(library(ugraphs)).
locatedIn(A, B) :-
dif(A, B),
- add_edges([], [tokyo-japan, chiyoda_ku-tokyo, kanda-chiyoda_ku, yodobashi_camera-kanda, tokyo-yodobashi_camera], Gph),
+ add_edges([], [tokyo-japan, chiyoda_ku-tokyo, kanda-chiyoda_ku, yodobashi_camera-kanda], Gph),
top_sort(Gph, _),
reachable(A, Gph, Vs),
member(B, Vs).
もう一度、ヨドバシカメラは日本にあるのか問います。
?- locatedIn(yodobashi_camera, japan).
true ;
false.
良いですね。ヨドバシカメラはどこにあるのか問います。
?- locatedIn(yodobashi_camera, X).
X = chiyoda_ku ;
X = japan ;
X = kanda ;
X = tokyo ;
false.
良いですね。
話を「野球のポジション当てゲーム」に戻します。
2 センターはライトより背は高いが、足はライトの方が早い。
Gph = [right-[center]], % 有向グラフ表現。左から右
足が速い・遅いは結果に影響しない不要な情報です。
13 山田選手は桜井選手より背が高く、木下選手は桜井選手より背が低い。しかし、この３人はいずれもファーストより低い。
「山田選手は桜井選手より背が高く、木下選手は桜井選手より背が低い」はリストで[Sakurai-Yamada, Kinoshita-Sakurai]とし、上で作ったGphにadd_edgesで追加します。
「3人はいずれもファーストより低い」はprologの有向グラフ表現ではリストで[first-[Yamada, Sakurai, Kinoshita]]、と表現されます。これを「〜〜より高い」に変換するのにtranspose_ugraphを使います。
変換後は[Yamada-[first], Sakurai-[first], Kinoshita-[first], first-[]]となります。
最初からリテラルにこう書けば良い話ではありますが、なるべく問題文をそのままコードにしたかったのです。
2つのグラフはugraph_unionで合体しています。
add_edges(Gph, [Sakurai-Yamada, Kinoshita-Sakurai], Gph1),
% 一旦「AはBより背が低い」と表して、反転させて「BはAより背が高い」とする
transpose_ugraph([first-[Yamada, Sakurai, Kinoshita]], Gph_t),
ugraph_union(Gph1, Gph_t, Gph2),
15 バッテリーと内野の全員はXXX1・XXX2・XXX3の３選手を除くとみんな小川選手より背が低い。
この[XXX1, XXX2, XXX3,の箇所は引用元に配慮して伏せ字ですが、実際には３人の選手名が入ります。
subtract([pitcher, catcher, first, second, third, short], [XXX1, XXX2, XXX3, Ogawa], Rest_of_3),
make_pairs_r(Ogawa, Rest_of_3, Pairs_ogawa),
add_edges(Gph2, Pairs_ogawa, Gph3),
リスト内の全員に対して○○選手よりみんな背が低いという様な、ペアのリストを作るための述語make_pairs_rを作りました。第一引数Xが第二引数Ysの要素の右側にくっついてペアのリストを生成します。
make_pairs_r(X, Ys, Out) :- make_pairs_r_(X, Ys, [], Out).
% 補助
make_pairs_r_(_, [], Ps, Out) :- Out = Ps.
make_pairs_r_(X, [Y|Ys], Ps, Out) :-
make_pairs_r_(X, Ys, [Y-X|Ps], Out).
15番は同時に「小川はXXX1・XXX2・XXX3より背が低い」とも言えます。
add_edges(Gph3, [Ogawa-XXX1, Ogawa-XXX2, Ogawa-XXX3], Gph_f),
最後にグラフに巡回路が無い事を確かめる為にトポロジカルソートをします。
top_sort(Gph_f, _).
ソートが成功すれば背が高い・低いの二項関係については正しい事になります。
コードの全体
swipl baseball.plでreplに入り、solve.で実行してください。
このコードはXXXの箇所を選手名の変数に変更しないと実行できません。
:- use_module(library(ugraphs)).
:- use_module(library(clpfd)).
%%%%%%%% ポジション(atom)定義 %%%%%%%%
poss(L) :- L = [pitcher,catcher,first,second,third,short,left,center,right].
ispos(Pos) :- atom(Pos), poss(L), member(Pos, L). %ポジションチェック
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%% 事実関連 既婚者または独身 %%%%%%%%%%
% married(Pos, M) Pos:ポジション, M: 1既婚 0未婚
:- dynamic( married/2 ). % 動的に追加・削除する場合はdynamic必要
% 結婚しているか?
% Pos : ポジション
% note: 事実married(Pos, _)が無ければ作るし、あれば照合する
q_married(Pos, M) :-
if(M in 0..1, true, throw(err_married1)),
if(ispos(Pos), true, (writeln(Pos), throw(err_married2))),
if(clause(married(Pos, Mx), _),
Mx == M, %then 照合
assert(married(Pos, M)) %else 無いので作る
).
% 消去
clear_married :-
if(retractall(married(_,_)), true, true).
% リストの人達は全てMである
q_married_all(Poss, M) :-
forall(member(Pos, Poss), q_married(Pos, M)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%% 制約タイプ1: 同一・非同一性制約 %%%%%%%%
constraint1(Names) :-
% 名前(変数)
Names = [XXX, Suzuki, Sakurai, XXX, XXX, Kinoshita, XXX, Ogawa, Yamada],
% 1. 藤山選手はサードと同じアパートに住んでいるということだ。
third \== Fujiyama,
% 3. 鈴木選手の妹さんはセカンドと婚約中だそうで、どうも挙式は来春だそうだ。
second \== Suzuki,
% 5. ショートとサードそれに桜井選手の３人はよく揃って競馬に行くそうだ。
short \== Sakurai, third \== Sakurai,
% 6. ピッチャーはとても麻雀が強く、今月も梅田選手と菊池選手から5000円ずつまきあげたそうだ。
pitcher \== Umeda, pitcher \== Kikuchi,
% 11. 松村選手はキャッチャーと、又、桜井選手はピッチャーととても仲が良いようである。
catcher \== Matumura, pitcher \== Sakurai,
% 7. 外野選手のうち一人はどうも木下選手か松村選手らしい。
( ( foranymemberis( [left, center, right], ==, Kinoshita),
forallmemberare( [left, center, right], \==, Matumura) %「1人は」なので他方を除外
);
( foranymemberis( [left, center, right], ==, Matumura),
forallmemberare( [left, center, right], \==, Kinoshita) %「1人は」なので他方を除外
)
),
% 9. 選手達はよく揃ってゴルフに行くが、梅田・藤山・桜井の３選手はどうしてもキャッチャーとセカンドには勝てないようだ。
allofeachare([catcher, second], \==, [Umeda, Fujiyama, Sakurai]),
% 12. 選手たちのうちで、独身なのは、鈴木・梅田・山田の３選手、それにセンターとライトの５人である。
allofeachare([center, right], \==, [Suzuki, Umeda, Yamada]),
% 13. 山田選手は桜井選手より背が高く、木下選手は桜井選手より背が低い。しかし、この３人はいずれもファーストより低い。
maplist(\==(first), [Yamada, Sakurai, Kinoshita]),
% 14. 選手たちのうちで酒を飲まないのは、XXX選手とXXX選手、それにショートの３人だけだそうだ。
maplist(\==(short), [XXX, XXX]),
% 15. バッテリーと内野の全員はXXX・XXX・XXXの３選手を除くとみんな小川選手より背が低い。
Batt_infield = [pitcher, catcher, first, second, third, short],
member(XXX, Batt_infield),
member(XXX, Batt_infield),
member(XXX, Batt_infield),
maplist(\==(Ogawa), Batt_infield),
% 16. 鈴木選手は外野手の３人と一緒に麻雀をよくするそうだ。
maplist(\==(Suzuki), [left, center, right]).
%%%%%%%% 制約タイプ2: 事実関係制約 %%%%%%%%
constraint2(Names) :-
% 名前(変数)
Names = [XXX, Suzuki, Sakurai, XXX, XXX, Kinoshita, XXX, Ogawa, Yamada],
% ここまでバックトラックしたならば事実 married/2 はクリアする必要がある
clear_married,
% 3. 鈴木選手の妹さんはセカンドと婚約中だそうで、どうも挙式は来春だそうだ。
q_married(second, 0),
% 4. キャッチャーの長男とサードの次女は同じ小学校の同級生だそうだ。
q_married(catcher, 1), q_married(third, 1),
% 8. 小川選手はどうも奥さんとうまくいっていないようだ。近々離婚するのではないかとの噂がとんでいる。
q_married(Ogawa, 1),
% 10. ピッチャーの奥さんはサードの妹さんだそうだ。
q_married(pitcher, 1),
% 12. 選手たちのうちで、独身なのは、鈴木・梅田・山田の３選手、それにセンターとライトの５人である。
Not_mar_s = [Suzuki, Umeda, Yamada, center, right],
subtract(Names, Not_mar_s, Mar_s), % この5人以外の4人を抽出
q_married_all(Not_mar_s, 0), % 5人は未婚
q_married_all(Mar_s, 1). % 残りの4人は既婚
%%%%%%%% 制約タイプ3: 推移関係制約 %%%%%%%%
constraint3(Names) :-
% ここでは推移関係を有向グラフのエッジで表して、巡回路が無ければ全ての関係が正しく成り立っていると判断する
% 有向グラフのトポロジカルソートが成功するなら巡回路は無い事になる
% 推移関係をペアで表し、A-Bとは「BはAより云々」
% 名前(変数)
Names = [XXX, Suzuki, Sakurai, XXX, XXX, Kinoshita, XXX, Ogawa, Yamada],
% 2. センターはライトより背は高いが、足はライトの方が早い。
% 足の速さは要らない情報
Gph = [right-[center]], % 有向グラフ表現。左から右
% 13. 山田選手は桜井選手より背が高く、木下選手は桜井選手より背が低い。しかし、この３人はいずれもファーストより低い。
add_edges(Gph, [Sakurai-Yamada, Kinoshita-Sakurai], Gph1),
% 一旦「AはBより背が低い」と表して、反転させて「BはAより背が高い」とする
transpose_ugraph([first-[Yamada, Sakurai, Kinoshita]], Gph_t), % 3人ともファーストより低い
ugraph_union(Gph1, Gph_t, Gph2),
% 15. バッテリーと内野の全員はXXX・XXX・XXXの３選手を除くとみんな小川選手より背が低い。
subtract([pitcher, catcher, first, second, third, short], [XXX, XXX, XXX, Ogawa], Rest_of_3),
make_pairs_r(Ogawa, Rest_of_3, Pairs_ogawa),
add_edges(Gph2, Pairs_ogawa, Gph3),
% 同時に小川はXXX・XXX・XXXより背が低いとも言える
add_edges(Gph3, [Ogawa-XXX, Ogawa-XXX, Ogawa-XXX], Gph_f),
% 2項関係推移グラフに巡回路が無い事を確かめる為にトポロジカルソートをする
top_sort(Gph_f, _).
solve :-
% ポジション
poss(Poss),
% 名前(変数)
Names = [XXX, Suzuki, Sakurai, XXX, XXX, Kinoshita, XXX, Ogawa, Yamada],
permutation(Poss, Names),
constraint1(Names),
constraint2(Names),
constraint3(Names),
% 結果表示
writeln("XXX, 鈴木, 桜井, XXX, XXX, 木下, XXX, 小川, 山田"),
writeln(Names).
%%%%%%%%%%%% 論理関連 %%%%%%%%%%%%
forany(Cond,Action) :-
\+forall(Cond,\+Action).
% ListxとListyの互いの全てがPredである
allofeachare(Listx, Pred, Listy) :-
forall(member(X, Listx),
forall(member(Y, Listy), call(Pred, X, Y))).
% ListのいずれかのmemberはArg1とPredである
foranymemberis(List, Pred, Arg1) :-
forany(member(X, List), call(Pred, X, Arg1)).
% Listの全てのmemberはArg1とPredである
forallmemberare(List, Pred, Arg1) :-
forall(member(X, List), call(Pred, X, Arg1)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%% if式 %%%%%%%%%%%%%%
if(Test, Then, _) :- Test, !, Then.
if(_ , _ , Else) :- Else.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%% グラフ関連 %%%%%%%%%%%%
% 第一引数が右側に来るペア列を作る
make_pairs_r(X, Ys, Out) :- make_pairs_r_(X, Ys, [], Out).
% 補助
make_pairs_r_(_, [], Ps, Out) :- Out = Ps.
make_pairs_r_(X, [Y|Ys], Ps, Out) :-
if((nonvar(X), nonvar(Y)), true, throw(err_make_pairs_r)),
make_pairs_r_(X, Ys, [Y-X|Ps], Out).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%