challenge ポーカーの役判定

引数に手札を与えると、ポーカーの役を表示するプログラムを作ってください。

条件:

  • スートはS,D,H,C、ランクはA,2~9,T,J,Q,Kのそれぞれ一文字で表します。
  • 手札は S2D5H3CQS9 のように10文字で指定されます。特にソートはされていません。
  • 手札にジョーカーは含まれません。
  • ストレートで取りうるランクの種類はA2345, 23456 ... 9TJQK, TJQKAの10種類で、JQKA2のようにK-A-2をまたぐものはストレートではありません。

実行例:

% ./poker SQSJSASKST
Royal flush

% ./poker D9D7D6D5D8
Straight flush

% ./poker C2D2S2H3H2
Four of a kind

% ./poker C2D3S2H3H2
Full house

% ./poker S9S4S8STSJ
Flush

% ./poker C4H7D5S6H3
Straight

% ./poker S6H6C5DQC6
Three of a kind

% ./poker S6HQC5DQC6
Two pair

% ./poker S6H4C5DQC6
One pair

% ./poker SJSQSKSAC2
No pair

お題にしようと思っていたのに間違えてしまいました。今から変更可能でしょうか?

(説明)
当初間違ってトピックに投稿していたので、このようなコメントを付けていたのですが、
このコメントに気づいた管理人さんにお題に移していただきました。
(最初の2つだけ投稿日時が早いのはそのためです)

Posted feedbacks - Prolog

面倒なので、大文字ではなくて、小文字でカードを記述しています。スマートに出来るかと思ったけど、結局力業でした。

実行結果:
$ pl -qs 121.pl
sqsjsaskst->Royal flush
d9d7d6d5d8->Straight flush
c2d2s2h3h2->four of a kind
c2d3s2h3h2->Full house
s9s4s8stsj->Flush
c4h7d5s6h3->Straight
s6h6c5dqc6->Three of a kind
s6hqc5dqc6->Two pair
s6h4c5dqc6->One pair
sjsqsksac2->No Pair
?-

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
straight([(_,A)|As]):-seq(A,As).

seq(_,[]).
seq(P,[(_,N)|Ns]):-succ(P,N),seq(N,Ns).

flush([(A,_)|As]):-flush0(A,As).
flush0(_,[]).
flush0(A,[(A,_)|As]):-flush0(A,As).

count([],[]).
count([(_,N)|Ns],R):-count(Ns,Rs),countw(N,Rs,R).

countw(N,[],[(N,1)]).
countw(N,[(N,C0)|R],[(N,C)|R]):-succ(C0,C).
countw(N,[P|R0],[P|R]):-countw(N,R0,R).

sortcard(C,Cs):-predsort(cmp,C,Cs).
cmp(>,(_,N1),(_,N2)):-N1>N2,!.
cmp(<,_,_):-!.

p([(S,1),(S,10),(S,11),(S,12),(S,13)],'Royal flush'):-!.
p(C, 'Straight flush'):-straight(C),flush(C),!.
p(C, 'Flush'):-flush(C),!.
p(C, 'Straight'):-straight(C),!.
p(C, R) :- count(C,C1), maplist(arg(2),C1,C2),msort(C2,C3),n(C3, R).
p(_, 'No Pair').

n([2,3],'Full house'):-!.
n([1,4],'four of a kind'):-!.
n([1,1,3],'Three of a kind'):-!.
n([1,2,2],'Two pair'):-!.
n([1,1,1,2],'One pair'):-!.

tcard1([],[]).
tcard1([S,Na|Cs],[(S,N)|Cs1]):-nth1(N,[a,'2','3','4','5','6','7','8','9',t,j,q,k],Na),tcard1(Cs,Cs1).

poker(C,R):-atom_chars(C,Cs),tcard1(Cs,R0),sortcard(R0,R1),p(R1,R),!.

test(C):-poker(C,R),write(C->R),nl.

:-maplist(test,[sqsjsaskst,
                d9d7d6d5d8,
                c2d2s2h3h2,
                c2d3s2h3h2,
                s9s4s8stsj,
                c4h7d5s6h3,
                s6h6c5dqc6,
                s6hqc5dqc6,
                s6h4c5dqc6,
                sjsqsksac2]).

permutationとパターンマッチで簡単に.効率は犠牲に...

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
pokerHand([X,X,X,X,X], R, 'Royal flush') :-
    permutation(R, ['T','J','Q','K','A']).

pokerHand([X,X,X,X,X], R, 'Straight flush') :-
    sub_atom('A23456789TJQK', _, 5, _, A),
    atom_chars(A, P), permutation(R, P).

pokerHand([X,X,X,X,X], _, 'Flush').

pokerHand(_, R, 'Straight') :-
    sub_atom('A23456789TJQKA', _, 5, _, A),
    atom_chars(A, P), permutation(R, P).

pokerHand(_, R, 'Four of a kind' ) :- permutation(R, [X,X,X,X,_]).
pokerHand(_, R, 'Full house'     ) :- permutation(R, [X,X,X,Y,Y]).
pokerHand(_, R, 'Three of a kind') :- permutation(R, [X,X,X,_,_]).
pokerHand(_, R, 'Two pair'       ) :- permutation(R, [X,X,Y,Y,_]).
pokerHand(_, R, 'One pair'       ) :- permutation(R, [X,X,_,_,_]).
pokerHand(_, _, 'No pair'        ).

poker(Card) :-
    atom_chars(Card, [S1,R1,S2,R2,S3,R3,S4,R4,S5,R5]),
    pokerHand([S1,S2,S3,S4,S5], [R1,R2,R3,R4,R5], H), !,
    writeln(H).

Index

Feed

Other

Link

Pathtraq

loading...