このディレクトリの索引
#  <問題> 
#  ポーカーの役、ストレートとフラッシュについての問題です。 
#  どちらの役が出現し難いかを示すPrologプログラムを書きなさい。 
# 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  この解答は http://hibari.2ch.net/test/read.cgi/tech/1289016056/85 に示されたリンクから
%  取り出したものです。www.dotup.orgの掲載時間は有限で後に参照できなくなってしまうことが
%  多いので、ここに転記させていただきました。したがって、
%  このプログラムの著作権は上記2chに書き込まれた匿名の方に帰属すると考えます。
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2010-11-23 7:17 %%%%

/*汎用*/
append([], Z, Z).
append([W|X1], Y, [W|Z1]) :- append(X1, Y, Z1).

last([], []).
last([A], A).
last([A|B], C) :- last(B, C).

/* 1〜52 でスペードの 1〜クラブの13を表す。ジョーカーは除いている。 */

/******* フラッシュを数える *******/

/* 「マーク(スート)が同じである」組み合わせの定義 */
isSameMark(C, D) :- 
  toMark(C, CMark), toMark(D, DMark), CMark = DMark.

/* 「カードのコード(1〜52) とマーク」の組み合わせの定義 */
toMark(C, Mark) :-
  ( 1 =< C, C =< 13, Mark = spade);
  (14 =< C, C =< 26, Mark = heart);
  (27 =< C, C =< 39, Mark = dia  );
  (40 =< C, C =< 52, Mark = club ).

/* 5枚のカードでフラッシュ役になる組み合わせの定義。
   ストレート群からストレートフラッシュを除く時使う。 */
isFlush([A,B,C,D,E]) :-
  isSameMark(A, B), isSameMark(B, C), isSameMark(C, D), isSameMark(D, E).

/* フラッシュとなりうるパターンの定義。*/
/* すなわち、空リストに対して 1枚目候補(あくまで候補)を
   スペードの1とした場合の、その後とりうる全パターンのこと。*/
flushSearch(Patterns) :- flushSearch(1, [], Patterns).

/* 長さ5でかつストレートフラッシュで無いものであるとき
   パターンとみなす(フラッシュか否かの判断は、
   計算回数を短縮するため既に行われている) */
flushSearch(_, Path, Patterns) :-
  length(Path, 5), \+ isStraight(Path), Patterns = [Path].

/* これは strSearch群との対象性のために最初作ってただけ。結局無駄 */
flushSearch(C, N, Path, Patterns) :- flushSearch(C, [N|Path], Patterns).

/* 与えられたリストに、C を足した場合と、Cを足さなかった場合にわけて、
   フラッシュとなりうるパターンを収集して混ぜ合わせる。
   なお、前回足したもの(F) と今回足すもの(C) との2枚で
   フラッシュ役が成立しなければ、
   もはやフラッシュが作られることはありえない。
   それを配慮して計算回数を節約している。
   C は 1 から順繰りに重複無く試行される */
flushSearch(C, Path, Patterns) :- 
  length(Path, Length),
  Length < 5, 
  (Length = 0; (Path = [F|R], isSameMark(C, F))),
  C1 is C + 1, 
  (C  =< 52, flushSearch(C1, C, Path, Patterns1); Patterns1 = []), 
  (C1 =< 52, flushSearch(C1,    Path, Patterns2); Patterns2 = []), 
  append(Patterns1, Patterns2, Patterns).

/* ストレートを数える */

/* 「D の次に C が来うる」という組み合わせ */
isNext(C, D) :- 
  toNumber(C, CNum), toNumber(D, DNum),
  ( (CNum = 1, DNum = 13); (C1 is DNum + 1, C1 = CNum) ).

/* カードのコードをエース〜キングに変換する */
toNumber(Card, CNum) :- 
  (Card =< 13, CNum = Card); 
  (13 < Card, CM is Card - 13, toNumber(CM, CNum) ).

/* ストレート役を構成する組み合わせの定義。
   フラッシュ群からストレートフラッシュを除く時使う。
  なお、flushSearch の実装により、このリストはかならず降順である。
  また、必ずフラッシュなので、5,30,3,15,1 的なことは起こらない */
isStraight([A,B,C,D,E]) :-
  (isNext(A, B); isNext(E, A)), isNext(B, C), isNext(C, D), isNext(D, E).

/* flushSearch と似たような構成をしている。
   最初にリストに追加するのは エース〜10 である。
   また、最後にリストに追加したものの次は、+1かキングの次のエースである。
   つまり、カード種別が予測できるため、
   追加直後の再帰呼出しで配慮し(NX,Nのところ)、計算時間を短縮している */
strSearch(Patterns) :- strSearch(1, [], Patterns).
strSearch(_, Path, Patterns) :- 
  length(Path, 5), \+ isFlush(Path), Patterns = [Path].
strSearch(_, New, Path, Patterns) :- 
  length(Path, Length),
  toNumber(New, NewNum),
  (
   (Length = 0, NewNum =< 10);
   (Path = [Last|Rest], isNext(NewNum, Last))
  ),
  NX is NewNum + 1,((NX = 14, N = 1);(N = NX)),
  strSearch(N, [New|Path], Patterns).
strSearch(Top, Path, Patterns) :- 
  length(Path, Length),
  Length < 5,
  ((Length=0,C1 is Top + 1);(C1 is Top + 13)),
  (Top =< 52, strSearch( 1, Top, Path, Patterns1); Patterns1 = []), 
  (C1  =< 52, strSearch(C1,      Path, Patterns2); Patterns2 = []), 
  append(Patterns1, Patterns2, Patterns).

/* 件数カウントおよび比較結果の表示 */
flushCount(N) :- flushSearch(L), length(L, N).
strCount(N)   :- strSearch(L),   length(L, N).
difficult(D)  :- flushCount(F), strCount(S), ((S