このディレクトリの索引
http://pc12.2ch.net/test/read.cgi/tech/1258320456/47
#  【 課題 】四人一首問題。「かるた部」の練習の一環として、 
#  百人一首の中から第一文字が「や」の四枚を選んで、徹底的に練習することに 
#  しました。四枚とは、 
#  やすらはでねなましものをさよふけてかたぶくまでのつきをみしかな 
#  やへむぐらしげれるやどのさびしきにひとをもみをみうらみざらまし 
#  やまざとはふゆぞさびしさまさりけるひとめもくさもかれぬとおもへば 
#  やまがはにかぜのかけたるしがらみはながれもあへぬもみぢなりけり 
#  ルールは、 
#  1) 二人ゲームである。 
#  2) 四枚のなかから無作為に二枚を選び自分と相手の札とする。 
#  3) 読み手は四枚全部読み上げる。いたがって空札(取る札がない)が二枚含まれる。 
#  4) 一枚取った時点で勝負はつくが、残りの一枚も競うこととする。 
#   
#  [問題] 乱数を使ってそれぞれの持ち札を決め、それを表示します。 
#  つぎに、読み札の順番を決めます。これはこの段階では表示しません。 
#  一首、読み、それを表示し、 
#  1) 空札 : 何文字目まで読まれてそれがわかったか 
#  2) 相手札 : 同上 
#  3) 自分札 : 同上 
#  を表示しなさい。これを繰り返し、取り札がなくなったらゲームオーバー。 
#  4) 二つのモードで作りなさい 
#   1) 読まれた札を二人とも記憶している。 
#   2) 読まれた札は忘れてしまう。 
#  実際には取り札には下の句が書かれていますが、ここでは一首全体をお互い理解しているものとします。 
# 
# 

歌([や,す,ら,は,で,ね,な,ま,し,も,の,を,さ,よ,ふ,け,て,か,た,ぶ,く,ま,で,の,つ,き,を,み,し,か,な]).
歌([や,へ,む,ぐ,ら,し,げ,れ,る,や,ど,の,さ,び,し,き,に,ひ,と,を,も,み,を,み,う,ら,み,ざ,ら,ま,し]).
歌([や,ま,ざ,と,は,ふ,ゆ,ぞ,さ,び,し,さ,ま,さ,り,け,る,ひ,と,め,も,く,さ,も,か,れ,ぬ,と,お,も,へ,ば]).
歌([や,ま,が,は,に,か,ぜ,の,か,け,た,る,し,が,ら,み,は,な,が,れ,も,あ,へ,ぬ,も,み,ぢ,な,り,け,り]).


四人一首(_) :-
    findall(X,歌(X),_歌ならび),
    一枚読む(_歌ならび,    
             _歌ならび,
             _自分の手持ち札ならび,
             _相手の手持ち札ならび,
             _読み札,
             _どちら,
             _どんな札か,
             _何字目でそれがわかったか),
    四人一首表示(_自分の手持ち札ならび,
                 _相手の手持ち札ならび),
                 _読み札,
                 _どちら,
                 _何字目でそれがわかったか).    


一枚読む([_読み札|_残り読み札],
          _まだ読まれていない札ならび,
          _自分の手持ち札,
          _相手の手持ち札,
          _読み札,
          _どちら,
          _どんな札か,
          _何字目でそれがわかったか) :-
    間を取る,
    現在の決まり字(_まだ読ませていない札ならび,_自分の手持ち札ならび,_相手の手持ち札ならび,_決まり字ならび),
    間を取る,
    決まり字で空札または札を取る(_読み札,_決まり字ならび,_どんな札か,_何字目でそれがわかったか),
    決まり字はどこにある(_どんな札か,_自分の手持ち札ならび,_相手の手持ち札ならび,_どちら).


一枚読む([_読み札|_残り読み札],
          _まだ読まれていない札ならび1,
          _自分の手持ち札1,
          _相手の手持ち札1,
          _読み札,
          _どちら,
          _どんな札か,
          _何字目でそれがわかったか) :-
    現在の決まり字(_まだ読まれていない札ならび,_自分の手持ち札ならび1,_相手の手持ち札ならび1,_決まり字ならび1),
    決まり字で空札または札を取る(_読み札,_決まり字ならび1,_どんな札か1,_何字目でそれがわかったか1),
    決まり字はどこにある(_どんな札か1,_自分の手持ち札ならび1,_相手の手持ち札ならび1,_どちら1),
    ならびから削除(_読み札,_まだ読まれていない札ならび,_まだ読まれていない札ならび2),
    ならびから削除(_読み札,_自分の手持ち札1,_自分の手持ち札2),
    ならびから削除(_読み札,_相手の手持ち札1,_相手の手持ち札2),
    一枚読む(_残り読み札,
             _まだ読まれていない札ならび2,
             _自分の手持ち札2,
             _相手の手持ち札2,
             _読み札,
             _どちら,
             _どんな札か,
             _何字目でそれがわかったか).


現在の決まり字(_まだ読まれていない札ならび,_自分の手元札ならび,_相手の手元札ならび,_決まり字ならび) :-
    append(_自分の手持ち札ならび,_相手の手持ち札ならび,_手持ち札として存在する札ならび),
    決まり字判断(_手持ち札として存在する札ならび,_まだ読まれていない札ならび,_決まり字ならび).


決まり字判断([],_,[]) :- !.
決まり字判断([_手持ち札|R1],_まだ読まれていない札ならび,[[_手持ち札,Len,_決まり字]|R2]) :-
  先頭から共通部分の次の文字までで最長のもの(_手持ち札,_まだ読まれていない札ならび,Len,_決まり字),
  決まり字判断(R1,_まだ読まれていない札ならび,R2).


先頭から共通部分の次の文字までで最長のもの(_手持ち札,_まだ読まれていない札ならび,Len,_決まり字) :-
  findmax([Len,_決まり字],
    (  member(_札,_まだ読まれていない札ならび),
      \+(_札=_手持ち札),
      先頭から共通部分の次の文字まで(1,_手持ち札,_札,_決まり字,Len)),[Len,_決まり字]),!.
先頭から共通部分の次の文字までで最長のもの([_決まり字|_],_,[1,_決まり字]).


先頭から共通部分の次の文字まで(N,[A|R1],[A|R2],[A|R3],Len) :-
  N2 is N + 1,
  先頭から共通部分の次の文字まで(R1,R2,R3,Len),!.
先頭から共通部分の次の文字まで(Len,[A|R1],_,[A],Len).


決まり字で空札または札を取る(_読み札,_決まり字ならび,_どんな札か,_何字目でそれがわかったか) :-
    atom_chars(_読み札,Chars1),
    append(L1,[_文字|L2],Chars1),
    札をとるか(L1,_文字,_決まり字ならび,_どんな札か,_何字目でそれがわかったか).


札をとるか(L1,_文字,_決まり字ならび,_どんな札か,_何字目でそれがわかったか) :-
    append(L1,[_文字],_決まり字),
    member([_どんな札か,_何字目でそれがわかったか,_決まり字],_決まり字ならび).


決まり字はどこにある(_札,_自分の手持ち札ならび,自分の手持ち札) :-
    member(_札,_自分の札ならび).
決まり字はどこにある(_札,_自分の手持ち札ならび,相手の手持ち札) :-
    member(_札,_相手の手持ち札ならび).


間を取る.


四人一首表示(_自分の手持ち札ならび,
             _相手の手持ち札ならび),
             _読み札,
             _どちら,
             _何字目でそれがわかったか) :-
    write('私の札は\n'),
    writeAln(_自分の手持ち札ならび),
    write('相手の札は\n'),
    writeAln(_相手の手持ち札ならび),
    write('読み札は\n'),
    writeAn(_読み札),
    write_formatted('どこにあるか %t\n何字目でそれがわかったか %t字目\n',[_どちら,_何字目でそれがわかったか]),!.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
writeAln([]).
writeAln([L|R]) :- concat_atom(L,A),write_formatted('%t\n',[A]),writeAln(R).

writeAn(L) :- concat_atom(L,A),write_formatted('%t\n',[A]).