カードの役に関する同じ出題者の「どう書く」とCodeIQの問題です。
ポーカー
問題はこちら->https://qiita.com/Nabetani/items/cbc3af152ee3f50a822f
数字の並びだけが必要なので、num/2でそれを抜き出してリストにしますが、
10があるので結構面倒です。
パターンを一例ずつ並べておいて、数字の並びのすべての順列を調べる方法と、
もう少し工夫する方法で書きました。
テストケースはこちらから拝借しました。
https://qiita.com/rana_kualu/items/35d28d1c7dac8feb7713
順列
%SWI-Prolog 7.4.2
%start.
%:-initialization(start).
pattern(Num,'4K'):-member([N,N,N,N,_],Num),!.
pattern(Num,'FH'):-member([N,N,N,N1,N1],Num),!.
pattern(Num,'3K'):-member([N,N,N,_,_],Num),!.
pattern(Num,'2P'):-member([N,N,N1,N1,_],Num),!.
pattern(Num,'1P'):-member([N,N,_,_,_],Num),!.
pattern(_,'--').
poker(Num1,R):-findall(L,permutation(Num1,L),Num),pattern(Num,R).
start:-dat(L),go(L),!.
go([]).
go([[B,Q]|T]):-
atom_chars(B,L),num(L,L1),poker(L1,R),disp(R,Q),go(T).
num([],[]).
num(['1'|T],R):-!,num(T,R1),R=[10|R1].
num(['A'|T],R):-!,num(T,R1),R=[1|R1].
num([H|T],R):-num(T,R1),atom_codes(H,X),48<X,X<58,!,N is X-48,R=[N|R1].
num([H|T],R):-num(T,R1),atom_codes(H,X),X>73,X<83,!,N is X-63,R=[N|R1].
num([_|T],R):-num(T,R).
disp(R,A):-(R==A->Str=" pass ";Str=" fail "),write(Str),writeln(R).
dat([['D3C3C10D10S3', 'FH'],
['S8D10HJS10CJ', '2P'],
['DASAD10CAHA', '4K'],
['S10HJDJCJSJ', '4K'],
['S10HAD10DAC10', 'FH'],
['HJDJC3SJS3', 'FH'],
['S3S4H3D3DA', '3K'],
['S2HADKCKSK', '3K'],
['SASJDACJS10', '2P'],
['S2S10H10HKD2', '2P'],
['CKH10D10H3HJ', '1P'],
['C3D3S10SKS2', '1P'],
['S3SJDAC10SQ', '--'],
['C3C9SAS10D2', '--']]).
別法
重複を除かないソート後、パターンと照合します。
sub(F,L,R)ではFをLを含むリストL1と含まないリストL2に分割し、L1を、L3とLに分け、
L3とL2をあわせたリストがRになります(Lが先頭にない場合のため)
pat('4K',F):-sub(F,[N,N,N,N],[_]).
pat(H,F):-sub(F,[N,N,N],[N1,N2]),(N1=:=N2->H='FH';H='3K').
pat(H,F):-sub(F,[N,N],L1),(sub(L1,[N1,N1],[_])->H='2P';H='1P').
pat('--',_).
sub(F,L,R):-append(L1,L2,F),append(L3,L,L1),append(L3,L2,R).
poker(L,R):-msort(L,L1),pat(R,L1).
%start以下は上と同じ
ポーカーの残り
問題はこちら->http://nabetani.sakura.ne.jp/hena/ord10pokarest/
できるだけ下位の役を用いて上位の役を決めるようにしました。
hand/3のXは取り除いたカードの位置です。
まずランク優先でソートし、nth1(X,L,_,L1)でX番目のカードを除いた残りがL1です。
4FではL1をスート優先でソートすると、全て同じなので一枚だけ残ります。
4SではL1をランク優先でソートすると、同じ数がない場合のみ4枚残り、
最初と最後の数の差が3または最初と二枚目の差が10になります。
%SWI-Prolog 7.4.2
%start.
%:-initialization(start).
hand("RF",L,_):-
hand("SF",L,_),hand("4S",L,2),!.
hand("SF",L,_):-
hand("FL",L,_),hand("ST",L,_),!.
hand("FL",L,_):-
hand("4F",L,1),hand("4F",L,5),!.
hand("ST",L,_):-
hand("4S",L,1),(hand("4S",L,2);hand("4S",L,5)),!.
hand("4SF",L,_):-hand("4F",L,X),hand("4S",L,X),!.
hand("4F",L,X):-
nth1(X,L,_,L1),sort(2,@<,L1,[_]),!.
hand("4S",L,X):-
nth1(X,L,_,L1),sort(1,@<,L1,[X1-_,X2-_,X3-_,X4-_]),
(X4-X1=:=3;X2-X1=:=10),!.
hand("-",_,_).
solve(L,R):-sort(1,@=<,L,L1),hand(R,L1,_).
start:-str(S),split_string(S,"\s\n","\s",L),pre(L).
pre([]).
pre([_,B,Q|T]):-
atom_codes(B,L),split(L,[],[],L1),partition(integer,L1,LI,LA),
maplist(pair,LI,LA,L2),solve(L2,R),disp(R,Q),pre(T).
disp(R,A):-(R==A->Str=" pass ";Str=" fail "),write(Str),writeln(R).
pair(A,B,A-B).
split([],_,L,R):-reverse(L,R).
split([H|T],N0,L0,R):-
H>97,!,(N0\=[]->(number_codes(N,N0),L2=[N|L0]);
L2=L0),atom_codes(S,[H]),L1=[S|L2],split(T,[],L1,R).
split([H|T],_,L0,R):-
H>64,!,(H=:=65->L1=[1|L0];(H=:=74->L1=[11|L0];
(H=:=75->L1=[13|L0];L1=[12|L0]))),split(T,[],L1,R).
split([H|T],N0,L0,R):-
append(N0,[H],N1),split(T,N1,L0,R).
str("0 Qs9s3dJd10h 4S
1 KdAdJd10dQd RF
2 QhJhKhAh10h RF
3 10dAdJsQdKd ST
4 Kd10dAdJd3d FL
5 4d3d2dAd5d SF
6 5d5d2d3dAd FL
7 4d2sAd5d3d ST
8 As10dJdQdKd ST
9 10d10dQdAsJd 4F
10 AcJd10dQdKd ST
11 Kd2sJdAdQd 4SF
12 JdAdQcKd2s 4S
13 KdAdKdJd2s 4F
14 As2dKdQdJd 4F
15 AsKdQd2dJh 4S
16 QhAd2s3dKd -
17 Ad4dKh3s2d 4S
18 3d2dAh5d4s ST
19 QcKdAs2dJd 4S
20 2dQcJdAs10d -
21 4d7d5s3c2d 4S
22 7d5s4dAd3c -
23 3s8s10sQs6s FL
24 6hAh3h2h8h FL
25 3h4hJh9hQh FL
26 3s6s5s2sQs FL
27 9d3cKdQc2c -
28 5sKs7hQcKh -
29 Ad6d7h7c9h -
30 10h4cAh6s10c -
31 9sKsJcQs10d ST
32 5d3c2cAs4c ST
33 KcQs9c10sJs ST
34 9d8s10hJdQd ST
35 6c5s10h7d4c 4S
36 QhJcKsAh8c 4S
37 JsQc3h10cKs 4S
38 10c9h7hAd8d 4S
39 3d4dKd8d5c 4F
40 10h3hQh9h2s 4F
41 Qh5h7h9h6c 4F
42 6s8s7s3sKc 4F
43 10h8h9hJhQh SF
44 10h9hQhKhJh SF
45 6d4d7d5d3d SF
46 6h9h7h5h8h SF
47 Ac6s4s3s5s 4SF
48 3c9d2c5c4c 4SF
49 Kh2sQh10hJh 4SF
50 4h5h2h3h4s 4SF
51 Js10sAsQsKs RF
52 10dKdQdAdJd RF").
4Sでは前のプログラムのsub/3を用いて以下のようにも書けます。
rank([1, 2, 3, 4,5,6,7,8,9,10, 11, 12, 13,1]).
sub(F,L,R):-append(L1,L2,F),append(L3,L,L1),append(L3,L2,R).
hand("4S",L,X):-
nth1(X,L,_,L0),pairs_keys(L0,L1),rank(R),
append(L2,L3,L1),append(L3,L2,L4),sub(R,L4,_),!.
CodeIQ 0: カードゲームの役を判定する
問題はこちら
http://nabetani.hatenablog.com/entry/2018/04/26/231837
テストケースを拝借。これでも一部のよう。
http://antimon2.hatenablog.jp/entry/2013/10/15/215428
上のプログラムを書いた時の知見を活かし、下位上位の関係がはっきりしませんので、
sortしてパターンマッチしただけです。
%SWI-Prolog 7.4.2
%begin.
%:-initialization(begin).
conv(['A'],1).
conv(['J'],11).
conv(['Q'],12).
conv(['K'],13).
conv([S],X):-atom_number(S,X).
conv([_,_],10).
ston(L,R):-atom_chars(L,[H|T]),conv(T,X),R=X:H.
hand('An',[X:_,X:_,Z:_,Z:_,Y:_,Y:_]):-Z==X;Z==Y.
hand('sDT',[X:A,X:B,X:C,Y:A,Y:B,Y:C]).
hand('DT',[X:_,X:_,X:_,Y:_,Y:_,Y:_]).
hand('scTP',[X:A,X:B,Y:A,Y:B,Z:A,Z:B]):-Z=:=X+2;Y=:=X+11.
hand('cTP',[X:_,X:_,Y:_,Y:_,Z:_,Z:_]):-Z=:=X+2;Y=:=X+11.
hand('sTP',[X:A,X:B,Y:A,Y:B,Z:A,Z:B]).
hand('TP',[X:_,X:_,Y:_,Y:_,Z:_,Z:_]).
hand('-',_).
solve(L,R):-maplist(ston,L,L2),sort(L2,L3),hand(R,L3),!.
go([]):-!.
go([A|T]):-
concat_atom(L,",",A),reverse(L,[B|L1]),solve(L1,R),
write(A),write("->"),write(R),
(R==B->Str=" ok ";Str=" no "),write(" "),write(Str),write("\n"),go(T).
begin:-str0(S),split_string(S,"\n","",L),go(L),!.
%これはテストケースの一部のよう
str0("HJ,D10,H2,H10,S2,CJ,TP
D9,C9,S9,H4,S4,H9,An
C9,DK,CK,S9,HK,SK,An
D2,C2,D10,H2,C10,S2,An
DA,S6,D6,H6,HA,C6,An
C2,D8,C8,H8,S8,H2,An
D7,DK,SK,CK,HK,C7,An
DA,S10,H10,HA,C10,D10,An
DK,HK,S6,H6,SK,CK,An
H5,D2,H2,C2,D5,S2,An
S5,D3,C5,S3,H3,C3,An
D5,C3,D3,H5,H3,C5,sDT
H2,C2,S2,S8,H8,C8,sDT
D3,CA,SA,C3,S3,DA,sDT
H10,SJ,DJ,D10,S10,HJ,sDT
D10,D3,S3,C3,C10,S10,sDT
HA,CA,S2,SA,C2,H2,sDT
HJ,C9,H9,D9,DJ,CJ,sDT
H3,H2,D2,S2,D3,S3,sDT
D2,SJ,HJ,H2,DJ,S2,sDT
H6,DA,S6,HA,SA,D6,sDT
D9,S9,HJ,CJ,DJ,H9,DT
H4,C5,S5,S4,D5,C4,DT
HA,DA,H3,CA,C3,S3,DT
C8,C3,H8,S3,D8,D3,DT
C3,D8,S8,D3,H3,H8,DT
C6,D9,H6,S9,H9,D6,DT
C7,DJ,HJ,CJ,S7,H7,DT
D9,H2,S2,C9,S9,D2,DT
HQ,CQ,H8,C8,SQ,D8,DT
D9,S9,HA,CA,C9,DA,DT
S2,H2,S3,SA,HA,H3,scTP
DA,SA,DK,DQ,SQ,SK,scTP
H2,C3,H3,HA,CA,C2,scTP
C5,S5,C3,C4,S4,S3,scTP
C9,H9,C10,HJ,H10,CJ,scTP
D9,H10,H9,HJ,D10,DJ,scTP
H6,S5,S6,H5,S7,H7,scTP
C6,C8,H6,C7,H8,H7,scTP
S6,C4,S4,C5,S5,C6,scTP
C6,H6,H7,C7,C8,H8,scTP
HJ,S9,H10,H9,SJ,C10,cTP
SA,HK,CK,DA,SQ,HQ,cTP
C2,SA,D2,D3,C3,CA,cTP
C4,S4,H5,C5,H3,D3,cTP
S3,H4,S5,C5,C3,S4,cTP
CK,HQ,SQ,HK,DJ,SJ,cTP
DQ,HK,CJ,SJ,CK,SQ,cTP
DJ,H9,D10,H10,C9,HJ,cTP
S4,H6,S5,H4,S6,D5,cTP
S8,D7,C8,C7,C9,S9,cTP
H7,H10,H4,S7,S4,S10,sTP
DA,SA,S2,D2,DK,SK,sTP
C7,H3,C3,HA,H7,CA,sTP
SK,S10,S3,DK,D3,D10,sTP
CK,C7,H7,C5,H5,HK,sTP
SQ,D8,D3,S3,DQ,S8,sTP
C9,D9,DQ,D3,C3,CQ,sTP
C7,H5,CQ,C5,H7,HQ,sTP
D5,C5,D2,C8,D8,C2,sTP
C2,HK,H2,CA,CK,HA,sTP
CA,S2,SA,SJ,HJ,H2,TP
D2,S2,DA,DK,HA,CK,TP
D3,C3,HQ,D10,CQ,H10,TP
S6,D9,H8,H9,C6,D8,TP
D9,D5,CQ,SQ,C5,C9,TP
SQ,D2,C7,S2,HQ,H7,TP
H6,S10,C10,S5,C6,H5,TP
HJ,D7,S2,D2,C7,CJ,TP
D4,D9,SA,HA,C9,S4,TP
D7,SQ,D3,HQ,S3,C7,TP
S3,H5,S4,SA,C8,SJ,-
D3,C10,CK,SJ,CA,DK,-
C10,S5,S10,H10,DK,S7,-
C10,D10,S10,C6,H10,C8,-
D6,D2,H9,C6,D10,C2,-
SQ,C6,H6,DQ,D6,H4,-
H3,D7,SQ,S5,H9,C9,-
SQ,DJ,H9,C10,D7,D5,-
SK,D3,S6,H6,C7,C6,-").