Poker hand analyser
Create a program to parse a single 5 card poker hand and rank it according to this list of poker hands.
A poker hand is specified as a space separated list of 5 playing cards. Each input card has two characters indicating face and suit. For example 2d (two of diamonds).
- Faces are: a, 2, 3, 4, 5, 6, 7, 8, 9, 10, j, q, k
- Suits are: h (hearts), d (diamonds), c (clubs), and s (spades), or alternatively the unicode card-suit characters: ♥ ♦ ♣ ♠
Duplicate cards are illegal.
The program should analyse a single hand and produce one of the following outputs:
straight-flush four-of-a-kind full-house flush straight three-of-a-kind two-pair one-pair high-card invalid
Examples:
2♥ 2♦ 2♣ k♣ q♦: three-of-a-kind 2♥ 5♥ 7♦ 8♣ 9♠: high-card a♥ 2♦ 3♣ 4♣ 5♦: straight 2♥ 3♥ 2♦ 3♣ 3♦: full-house 2♥ 7♥ 2♦ 3♣ 3♦: two-pair 2♥ 7♥ 7♦ 7♣ 7♠: four-of-a-kind 10♥ j♥ q♥ k♥ a♥: straight-flush 4♥ 4♠ k♠ 5♦ 10♠: one-pair q♣ 10♣ 7♣ 6♣ 4♣: flush
The programs output for the above examples should be displayed here on this page.
For extra credit:
- use the playing card characters introduced with Unicode 6.0 (U+1F0A1 - U+1F0DE).
- allow two jokers
- use the symbol joker
- duplicates would be allowed (for jokers only)
- five-of-a-kind would then be the highest hand
Extra Credit Examples:
joker 2♦ 2♠ k♠ q♦: three-of-a-kind joker 5♥ 7♦ 8♠ 9♦: straight joker 2♦ 3♠ 4♠ 5♠: straight joker 3♥ 2♦ 3♠ 3♦: four-of-a-kind joker 7♥ 2♦ 3♠ 3♦: three-of-a-kind joker 7♥ 7♦ 7♠ 7♣: five-of-a-kind joker j♥ q♥ k♥ A♥: straight-flush joker 4♣ k♣ 5♦ 10♠: one-pair joker k♣ 7♣ 6♣ 4♣: flush joker 2♦ joker 4♠ 5♠: straight joker Q♦ joker A♠ 10♠: straight joker Q♦ joker A♦ 10♦: straight-flush joker 2♦ 2♠ joker q♦: four-of-a-kind
Perl 6
This solution handles jokers. It has been written as a Perl 6 grammar. <lang perl6>use v6;
grammar PokerHand {
# Perl6 Grammar to parse and rank 5-card poker hands # E.g. PokerHand.parse("2♥ 3♥ 2♦ 3♣ 3♦"); # 2013-12-21: handle 'joker' wildcards; maximum of two rule TOP { <hand> :my ($n, $flush, $straight); { $n = n-of-a-kind($<hand>); $flush = flush($<hand>); $straight = straight($<hand>); } <rank($n, $flush, $straight)> } rule hand { :my %*PLAYED; { %*PLAYED = () } [ <face-card> | <joker> ]**5 } token face-card {<face><suit> <?{ my $card = ~$/.lc; # disallow duplicates ++%*PLAYED{$card} <= 1; }> }
token joker {:i 'joker' <?{ my $card = ~$/.lc; # allow two jokers in a hand ++%*PLAYED{$card} <= 2; }> } token face {:i <[2..9]> | 10 | j | q | k | a } proto token suit {*} token suit:sym<♥> {<sym>} token suit:sym<♦> {<sym>} token suit:sym<♠> {<sym>} token suit:sym<♣> {<sym>} token rank($n, $flush, $straight) { $<five-of-a-kind> = <?{$n[0] == 5}> || $<straight-flush> = <?{$straight && $flush}> || $<four-of-a-kind> = <?{$n[0] == 4}> || $<full-house> = <?{$n[0] == 3 && $n[1] == 2}> || $<flush> = <?{$flush}> || $<straight> = <?{$straight}> || $<three-of-a-kind> = <?{$n[0] == 3}> || $<two-pair> = <?{$n[0] == 2 && $n[1] == 2}> || $<one-pair> = <?{$n[0] == 2}> || $<high-card> = <?> } sub n-of-a-kind($/) { my %n; for @<face-card> -> $/ { %n{ ~$<face> }++ }
my @c = %n.values.sort: {$^b <=> $^a}; @c[0]++ for @<joker>;
return @c; } sub flush($/) { my %m; for @<face-card> -> $/ { %m{ ~$<suit> }++ } return +%m.keys == 1; } sub straight($/) { # allow both ace-low and ace-high straights my @seq = 'a', 2 .. 10, < j q k a >; my %got; for @<face-card> -> $/ { %got{ ~$<face>.lc }++; } for 0..(@seq.elems-5) { my $jokers = @<joker>.elems; my $run = 0;
for @seq[$_ .. $_+4] { last unless %got{ $_ } || $jokers-- > 0; $run++; } return True if $run >= 5; } return False; }
}
for ("2♥ 2♦ 2♣ k♣ q♦", # three-of-a-kind
"2♥ 5♥ 7♦ 8♣ 9♠", # high-card "a♥ 2♦ 3♣ 4♣ 5♦", # straight "2♥ 3♥ 2♦ 3♣ 3♦", # full-house "2♥ 7♥ 2♦ 3♣ 3♦", # two-pair "2♥ 7♥ 7♦ 7♣ 7♠", # four-of-a-kind "10♥ j♥ q♥ k♥ a♥", # straight-flush "4♥ 4♠ k♠ 5♦ 10♠", # one-pair "q♣ 10♣ 7♣ 6♣ 4♣", # flush ## EXTRA CREDIT ## "joker 2♦ 2♠ k♠ q♦", # three-of-a-kind "joker 5♥ 7♦ 8♠ 9♦", # straight "joker 2♦ 3♠ 4♠ 5♠", # straight "joker 3♥ 2♦ 3♠ 3♦", # four-of-a-kind "joker 7♥ 2♦ 3♠ 3♦", # three-of-a-kind "joker 7♥ 7♦ 7♠ 7♣", # five-of-a-kind "joker j♥ q♥ k♥ A♥", # straight-flush "joker 4♣ k♣ 5♦ 10♠", # one-pair "joker k♣ 7♣ 6♣ 4♣", # flush "joker 2♦ joker 4♠ 5♠", # straight "joker Q♦ joker A♠ 10♠", # straight "joker Q♦ joker A♦ 10♦", # straight-flush "joker 2♦ 2♠ joker q♦", # four of a kind ) { PokerHand.parse($_); my $rank = $<rank> ?? $<rank>.caps !! 'invalid'; say "$_: $rank";
}</lang>
- Output:
2♥ 2♦ 2♣ k♣ q♦: three-of-a-kind 2♥ 5♥ 7♦ 8♣ 9♠: high-card a♥ 2♦ 3♣ 4♣ 5♦: straight 2♥ 3♥ 2♦ 3♣ 3♦: full-house 2♥ 7♥ 2♦ 3♣ 3♦: two-pair 2♥ 7♥ 7♦ 7♣ 7♠: four-of-a-kind 10♥ j♥ q♥ k♥ a♥: straight-flush 4♥ 4♠ k♠ 5♦ 10♠: one-pair q♣ 10♣ 7♣ 6♣ 4♣: flush joker 2♦ 2♠ k♠ q♦: three-of-a-kind joker 5♥ 7♦ 8♠ 9♦: straight joker 2♦ 3♠ 4♠ 5♠: straight joker 3♥ 2♦ 3♠ 3♦: four-of-a-kind joker 7♥ 2♦ 3♠ 3♦: three-of-a-kind joker 7♥ 7♦ 7♠ 7♣: five-of-a-kind joker j♥ q♥ k♥ A♥: straight-flush joker 4♣ k♣ 5♦ 10♠: one-pair joker k♣ 7♣ 6♣ 4♣: flush joker 2♦ joker 4♠ 5♠: straight joker Q♦ joker A♠ 10♠: straight joker Q♦ joker A♦ 10♦: straight-flush joker 2♦ 2♠ joker q♦: four-of-a-kind
Python
Goes a little further in also giving the ordered tie-breaker information from the wikipedia page. <lang python>from collections import namedtuple
class Card(namedtuple('Card', 'face, suit')):
def __repr__(self): return .join(self)
suit = '♥ ♦ ♣ ♠'.split()
- ordered strings of faces
faces = '2 3 4 5 6 7 8 9 10 j q k a' lowaces = 'a 2 3 4 5 6 7 8 9 10 j q k'
- faces as lists
face = faces.split() lowace = lowaces.split()
def straightflush(hand):
f,fs = ( (lowace, lowaces) if any(card.face == '2' for card in hand) else (face, faces) ) ordered = sorted(hand, key=lambda card: (f.index(card.face), card.suit)) first, rest = ordered[0], ordered[1:] if ( all(card.suit == first.suit for card in rest) and ' '.join(card.face for card in ordered) in fs ): return 'straight-flush', ordered[-1].face return False
def fourofakind(hand):
allfaces = [f for f,s in hand] allftypes = set(allfaces) if len(allftypes) != 2: return False for f in allftypes: if allfaces.count(f) == 4: allftypes.remove(f) return 'four-of-a-kind', [f, allftypes.pop()] else: return False
def fullhouse(hand):
allfaces = [f for f,s in hand] allftypes = set(allfaces) if len(allftypes) != 2: return False for f in allftypes: if allfaces.count(f) == 3: allftypes.remove(f) return 'full-house', [f, allftypes.pop()] else: return False
def flush(hand):
allstypes = {s for f, s in hand} if len(allstypes) == 1: allfaces = [f for f,s in hand] return 'flush', sorted(allfaces, key=lambda f: face.index(f), reverse=True) return False
def straight(hand):
f,fs = ( (lowace, lowaces) if any(card.face == '2' for card in hand) else (face, faces) ) ordered = sorted(hand, key=lambda card: (f.index(card.face), card.suit)) first, rest = ordered[0], ordered[1:] if ' '.join(card.face for card in ordered) in fs: return 'straight', ordered[-1].face return False
def threeofakind(hand):
allfaces = [f for f,s in hand] allftypes = set(allfaces) if len(allftypes) <= 2: return False for f in allftypes: if allfaces.count(f) == 3: allftypes.remove(f) return ('three-of-a-kind', [f] + sorted(allftypes, key=lambda f: face.index(f), reverse=True)) else: return False
def twopair(hand):
allfaces = [f for f,s in hand] allftypes = set(allfaces) pairs = [f for f in allftypes if allfaces.count(f) == 2] if len(pairs) != 2: return False p0, p1 = pairs other = [(allftypes - set(pairs)).pop()] return 'two-pair', pairs + other if face.index(p0) > face.index(p1) else pairs[::-1] + other
def onepair(hand):
allfaces = [f for f,s in hand] allftypes = set(allfaces) pairs = [f for f in allftypes if allfaces.count(f) == 2] if len(pairs) != 1: return False allftypes.remove(pairs[0]) return 'one-pair', pairs + sorted(allftypes, key=lambda f: face.index(f), reverse=True)
def highcard(hand):
allfaces = [f for f,s in hand] return 'high-card', sorted(allfaces, key=lambda f: face.index(f), reverse=True)
handrankorder = (straightflush, fourofakind, fullhouse,
flush, straight, threeofakind, twopair, onepair, highcard)
def rank(cards):
hand = handy(cards) for ranker in handrankorder: rank = ranker(hand) if rank: break assert rank, "Invalid: Failed to rank cards: %r" % cards return rank
def handy(cards='2♥ 2♦ 2♣ k♣ q♦'):
hand = [] for card in cards.split(): f, s = card[:-1], card[-1] assert f in face, "Invalid: Don't understand card face %r" % f assert s in suit, "Invalid: Don't understand card suit %r" % s hand.append(Card(f, s)) assert len(hand) == 5, "Invalid: Must be 5 cards in a hand, not %i" % len(hand) assert len(set(hand)) == 5, "Invalid: All cards in the hand must be unique %r" % cards return hand
if __name__ == '__main__':
hands = ["2♥ 2♦ 2♣ k♣ q♦", "2♥ 5♥ 7♦ 8♣ 9♠", "a♥ 2♦ 3♣ 4♣ 5♦", "2♥ 3♥ 2♦ 3♣ 3♦", "2♥ 7♥ 2♦ 3♣ 3♦", "2♥ 7♥ 7♦ 7♣ 7♠", "10♥ j♥ q♥ k♥ a♥"] + [ "4♥ 4♠ k♠ 5♦ 10♠", "q♣ 10♣ 7♣ 6♣ 4♣", ] print("%-18s %-15s %s" % ("HAND", "CATEGORY", "TIE-BREAKER")) for cards in hands: r = rank(cards) print("%-18r %-15s %r" % (cards, r[0], r[1]))</lang>
- Output:
HAND CATEGORY TIE-BREAKER '2♥ 2♦ 2♣ k♣ q♦' three-of-a-kind ['2', 'k', 'q'] '2♥ 5♥ 7♦ 8♣ 9♠' high-card ['9', '8', '7', '5', '2'] 'a♥ 2♦ 3♣ 4♣ 5♦' straight '5' '2♥ 3♥ 2♦ 3♣ 3♦' full-house ['3', '2'] '2♥ 7♥ 2♦ 3♣ 3♦' two-pair ['3', '2', '7'] '2♥ 7♥ 7♦ 7♣ 7♠' four-of-a-kind ['7', '2'] '10♥ j♥ q♥ k♥ a♥' straight-flush 'a' '4♥ 4♠ k♠ 5♦ 10♠' one-pair ['4', 'k', '10', '5'] 'q♣ 10♣ 7♣ 6♣ 4♣' flush ['q', '10', '7', '6', '4']
REXX
version 1
<lang rexx>/* REXX ---------------------------------------------------------------
- 10.12.2013 Walter Pachl
- --------------------------------------------------------------------*/
d.1='2h 2d 2s ks qd'; x.1='three-of-a-kind' d.2='2h 5h 7d 8s 9d'; x.2='high-card' d.3='ah 2d 3s 4s 5s'; x.3='straight' d.4='2h 3h 2d 3s 3d'; x.4='full-house' d.5='2h 7h 2d 3s 3d'; x.5='two-pair' d.6='2h 7h 7d 7s 7c'; x.6='four-of-a-kind' d.7='th jh qh kh ah'; x.7='straight-flush' d.8='4h 4c kc 5d tc'; x.8='one-pair' d.9='qc tc 7c 6c 4c'; x.9='flush' d.10='ah 2h 3h 4h' d.11='ah 2h 3h 4h 5h 6h' d.12='2h 2h 3h 4h 5h' d.13='xh 2h 3h 4h 5h' d.14='2x 2h 3h 4h 5h' Do ci=1 To 14
Call poker d.ci,x.ci end
Exit
poker: Parse Arg deck,expected have.=0 f.=0; fmax=0 s.=0; smax=0 cnt.=0 If words(deck)<5 Then Return err('less than 5 cards') If words(deck)>5 Then Return err('more than 5 cards') Do i=1 To 5
c=word(deck,i) Parse Var c f +1 s If have.f.s=1 Then Return err('duplicate card:' c) have.f.s=1 m=pos(f,'a23456789tjqk') If m=0 Then Return err('invalid face' f 'in' c) cnt.m=cnt.m+1 n=pos(s,'hdcs') If n=0 Then Return err('invalid suit' s 'in' c) f.m=f.m+1; fmax=max(fmax,f.m) s.n=s.n+1; smax=max(smax,s.n) End
cntl= cnt.14=cnt.1 Do i=1 To 14
cntl=cntl||cnt.i End
Select
When fmax=4 Then res='four-of-a-kind' When fmax=3 Then Do If x_pair() Then res='full-house' Else res='three-of-a-kind' End When fmax=2 Then Do If x_2pair() Then res='two-pair' Else res='one-pair' End When smax=5 Then Do If x_street() Then res='straight-flush' Else res='flush' End When x_street() Then res='straight' Otherwise res='high-card' End
Say deck res If res<>expected Then
Say copies(' ',14) expected
Return
x_pair:
Do p=1 To 13 If f.p=2 Then return 1 End Return 0
x_2pair:
pp=0 Do p=1 To 13 If f.p=2 Then pp=pp+1 End Return pp=2
x_street:
Return pos('11111',cntl)>0
err:
Say deck 'Error:' arg(1) Return 0</lang>
- Output:
2h 2d 2s ks qd three-of-a-kind 2h 5h 7d 8s 9d high-card ah 2d 3s 4s 5s straight 2h 3h 2d 3s 3d full-house 2h 7h 2d 3s 3d two-pair 2h 7h 7d 7s 7c four-of-a-kind th jh qh kh ah straight-flush 4h 4c kc 5d tc one-pair qc tc 7c 6c 4c flush ah 2h 3h 4h Error: less than 5 cards ah 2h 3h 4h 5h 6h Error: more than 5 cards 2h 2h 3h 4h 5h Error: duplicate card: 2h xh 2h 3h 4h 5h Error: invalid face x in xh 2x 2h 3h 4h 5h Error: invalid suit x in 2x
version 2
This REXX version supports:
- upper/lower/mixed case for suits and pips
- allows commas or blanks for card separation
- alternate names for a aces and tens
- alphabetic letters for suits and/or glyphs
- specification of number of cards in a hand
- the dealt hands can be in a file (blank lines are ignored)
- dealt hands in the file can have comments after a semicolon (;)
<lang rexx>/*REXX program analyzes an N-card poker hand, displays what the hand is.*/ parse arg iFID .; if iFID== then iFID='POKERHAN.DAT'
/* [↓] read the poker hands dealt*/ do while lines(iFID)\==0; ox=linein(iFID); if ox= then iterate say right(ox,max(30,length(ox))) ' ◄─── ' analyze(ox) end /*while*/ /* [↑] analyze/validate the hand.*/
exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────ANALYZE subroutine──────────────────*/ analyze: procedure; arg x ';',mc; hand=translate(x,'♥♦♣♠1',"HDCSA,") kinds=0; suit.=0; flush=0; pairs=0; @.=0; run=copies(0,13); pips=run if mc== then mc=5; n=words(hand); if n\==mc then return 'invalid'
/* [↓] PIP can be 1 or 2 chars.*/ do j=1 for n; _=word(hand,j); pip=left(_,length(_)-1); ws=right(_,1) if pip==10 then pip='T' /*allow alternate form for a TEN.*/ @._=@._+1; #=pos(pip,123456789TJQK) /*bump card ctr, get pip index*/ if pos(ws,"♥♣♦♠")==0 | #==0 | @._\==1 then return 'invalid' suit.ws=suit.ws+1; flush=max(flush,suit.ws); run=overlay(.,run,#) _=substr(pips,#,1)+1; pips=overlay(_,pips, #); kinds=max(kinds,_) end /*i*/ /*keep track of N-of-a-kind. [↑] */
pairs=countstr(2,pips) /*count #pairs (2s in PIPS)*/ straight=pos(....., run||left(run,1))\==0 /*RUN contains a straight?*/
select when flush==5 & straight then return 'straight-flush' when kinds==4 then return 'four-of-a-kind' when kinds==3 & pairs==1 then return 'full-house' when flush==5 then return 'flush' when straight then return 'straight' when kinds==3 then return 'three-of-a-kind' when kinds==2 & pairs==2 then return 'two-pair' when kinds==2 then return 'one-pair' otherwise return 'high-card' end /*select*/</lang>
Programming note: some older REXXes don't have the countstr BIF, so that REXX statement (above, line 21) can be replaced with: <lang rexx>pairs=13-length(space(translate(pips,,2),0)) /*count # of 2's in PIPS.*/</lang> input file:
2♥ 2♦ 2♠ k♠ q♦ 2♥ 5♥ 7♦ 8♠ 9♦ a♥ 2♦ 3♠ 4♠ 5♠ 2♥ 3♥ 2♦ 3♠ 3♦ 2♥ 7♥ 2♦ 3♠ 3♦ 2♥ 7♥ 7♦ 7♠ 7♣ 10♥ j♥ q♥ k♥ A♥ 4♥ 4♣ k♣ 5♦ 10♠ q♣ t♣ 7♣ 6♣ 4♣ J♥ Q♦ K♠ A♠ 10♠ ah 2h 3h 4h
output using the (above) input file:
2♥ 2♦ 2♠ k♠ q♦ ◄─── three-of-a-kind 2♥ 5♥ 7♦ 8♠ 9♦ ◄─── high-card a♥ 2♦ 3♠ 4♠ 5♠ ◄─── straight 2♥ 3♥ 2♦ 3♠ 3♦ ◄─── full-house 2♥ 7♥ 2♦ 3♠ 3♦ ◄─── two-pair 2♥ 7♥ 7♦ 7♠ 7♣ ◄─── four-of-a-kind 10♥ j♥ q♥ k♥ A♥ ◄─── straight-flush 4♥ 4♣ k♣ 5♦ 10♠ ◄─── one-pair q♣ t♣ 7♣ 6♣ 4♣ ◄─── flush J♥ Q♦ K♠ A♠ 10♠ ◄─── straight ah 2h 3h 4h ◄─── invalid
version 3 (with jokers)
This REXX version has three additional features:
- "invalid" hands have additional diagnostic information
- supports up to two jokers
- the joker card may be abbreviated (and in upper/lower/mixed case)
<lang rexx>/*REXX program analyzes an N-card poker hand, displays what the hand is.*/ /*─────────────────────────────── poker hands may contain up to 2 jokers*/ parse arg iFID .; if iFID== then iFID='POKERHAJ.DAT'
/* [↓] read the poker hands dealt*/ do while lines(iFID)\==0; ox=linein(iFID); if ox= then iterate say right(ox,max(30,length(ox))) ' ◄─── ' analyze(ox) end /*while*/ /* [↑] analyze/validate the hand.*/
exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────ANALYZE subroutine──────────────────*/ analyze: procedure; arg x ';',mc; hand=translate(x,'♥♦♣♠1',"HDCSA,") kinds=0; suit.=0; flush=0; pairs=0; @.=0; run=copies(0,13); pips=run if mc== then mc=5; n=words(hand) /*N is the # of cards in hand.*/ if n\==mc then return 'invalid number of cards, must be' mc
/* [↓] PIP can be 1 or 2 chars.*/ do j=1 for n; _=word(hand,j); pip=left(_,length(_)-1); ws=right(_,1) if pip==10 then pip='T' /*allow alternate form for a TEN*/ if abbrev('JOKER',_,1) then _="JK" /*allow altername forms of JOKER*/ @._=@._+1; #=pos(pip,123456789TJQK) /*bump card ctr, get pip index*/ if _=='JK' then do if @.j>2 then return 'invalid, too many jokers' iterate end if pos(ws,"♥♣♦♠")==0 then return 'invalid suit in card:' _ if #==0 then return 'invalid pip in card:' _ if @._\==1 then return 'invalid, duplicate card:' _ suit.ws=suit.ws+1; flush=max(flush,suit.ws); run=overlay(.,run,#) _=substr(pips,#,1)+1; pips=overlay(_,pips, #); kinds=max(kinds,_) end /*i*/ /*keep track of N-of-a-kind. [↑] */
run=run || left(run,1) /*Ace can be high or low. */ jok=@.jk; kinds=kinds+jok; flush=flush+jok /*N-of-a-kind, joker adjust*/ straight= pos(..... , run)\==0 |, /*RUN contains a straight? */
(pos(.... , run)\==0 & jok>=1) |, /* " " " " */ (pos(..0.. , run)\==0 & jok>=1) |, /* " " " " */ (pos(...0. , run)\==0 & jok>=1) |, /* " " " " */ (pos(.0... , run)\==0 & jok>=1) |, /* " " " " */ (pos(... , run)\==0 & jok>=2) |, /* " " " " */ (pos(..0. , run)\==0 & jok>=2) |, /* " " " " */ (pos(.0.. , run)\==0 & jok>=2) |, /* " " " " */ (pos(.00.. , run)\==0 & jok>=2) |, /* " " " " */ (pos(..00. , run)\==0 & jok>=2) |, /* " " " " */ (pos(.0.0. , run)\==0 & jok>=2) /* " " " " */
pairs=countstr(2,pips) /*count #pairs (2s in PIPS)*/ if jok\==0 then pairs=pairs-1 /*adjust #pairs with jokers*/
select when kinds>=5 then return 'five-of-a-kind' when flush>=5 & straight then return 'straight-flush' when kinds>=4 then return 'four-of-a-kind' when kinds>=3 & pairs>=1 then return 'full-house' when flush>=5 then return 'flush' when straight then return 'straight' when kinds>=3 then return 'three-of-a-kind' when kinds==2 & pairs==2 then return 'two-pair' when kinds==2 then return 'one-pair' when kinds==2 then return 'one-pair' otherwise return 'high-card' end /*select*/</lang>
Programming note: the method used for analyzing hands that contain jokers are limited to a maximum of two jokers. A different methodology would be needed for a generic number of jokers (and/or wild cards [such as deuces and one-eyed jacks]).
input file:
joker 2♦ 2♠ k♠ q♦ joker 5♥ 7♦ 8♠ 9♦ joker 2♦ 3♠ 4♠ 5♠ joker 3♥ 2♦ 3♠ 3♦ joker 7♥ 2♦ 3♠ 3♦ joker 7♥ 7♦ 7♠ 7♣ joker j♥ q♥ k♥ A♥ joker 4♣ k♣ 5♦ 10♠ joker t♣ 7♣ 6♣ 4♣ joker Q♦ K♠ A♠ 10♠ joker 2h 3h 4h 2♥ 2♦ 2♠ k♠ jok 2♥ 5♥ 7♦ 8♠ jok a♥ 2♦ 5♠ 4♠ jok 2♥ 3♥ 2♦ 3♠ jok 2♥ 7♥ 2♦ 3♠ jok 2♥ 7♥ 7♦ 7♠ jok 10♥ j♥ q♥ k♥ jok 4♥ 4♣ k♣ 5♦ jok q♣ t♣ 7♣ 6♣ jok J♥ Q♦ K♠ A♠ jok
output using the (above) input file:
joker 2♦ 2♠ k♠ q♦ ◄─── three-of-a-kind joker 5♥ 7♦ 8♠ 9♦ ◄─── straight joker 2♦ 3♠ 4♠ 5♠ ◄─── straight joker 3♥ 2♦ 3♠ 3♦ ◄─── four-of-a-kind joker 7♥ 2♦ 3♠ 3♦ ◄─── three-of-a-kind joker 7♥ 7♦ 7♠ 7♣ ◄─── five-of-a-kind joker j♥ q♥ k♥ A♥ ◄─── straight-flush joker 4♣ k♣ 5♦ 10♠ ◄─── one-pair joker t♣ 7♣ 6♣ 4♣ ◄─── flush joker Q♦ K♠ A♠ 10♠ ◄─── straight joker 2h 3h 4h ◄─── invalid number of cards, must be 5 2♥ 2♦ 2♠ k♠ jok ◄─── four-of-a-kind 2♥ 5♥ 7♦ 8♠ jok ◄─── one-pair a♥ 2♦ 5♠ 4♠ jok ◄─── straight 2♥ 3♥ 2♦ 3♠ jok ◄─── full-house 2♥ 7♥ 2♦ 3♠ jok ◄─── three-of-a-kind 2♥ 7♥ 7♦ 7♠ jok ◄─── four-of-a-kind 10♥ j♥ q♥ k♥ jok ◄─── straight-flush 4♥ 4♣ k♣ 5♦ jok ◄─── three-of-a-kind q♣ t♣ 7♣ 6♣ jok ◄─── flush J♥ Q♦ K♠ A♠ jok ◄─── straight
Tcl
<lang tcl>package require Tcl 8.6 namespace eval PokerHandAnalyser {
proc analyse {hand} {
set norm [Normalise $hand] foreach type { invalid straight-flush four-of-a-kind full-house flush straight three-of-a-kind two-pair one-pair } { if {[Detect-$type $norm]} { return $type } } # Always possible to use high-card if the hand is legal at all return high-card
}
# This normalises to an internal representation that is a list of pairs, # where each pair is one number for the pips (ace == 14, king == 13, # etc.) and another for the suit. This greatly simplifies detection. proc Normalise {hand} {
set PipMap {j 11 q 12 k 13 a 14} set SuitMap {♥ 2 h 2 ♦ 1 d 1 ♣ 0 c 0 ♠ 3 s 3} set hand [string tolower $hand] set cards [regexp -all -inline {(?:[akqj98765432]|10)[hdcs♥♦♣♠]} $hand] lsort -command CompareCards [lmap c [string map {} $cards] { list [string map $PipMap [string range $c 0 end-1]] \ [string map $SuitMap [string index $c end]] }]
} proc CompareCards {a b} {
lassign $a pipA suitA lassign $b pipB suitB expr {$pipA==$pipB ? $suitB-$suitA : $pipB-$pipA}
}
# Detection code. Note that the detectors all assume that the preceding # detectors have been run first; this simplifies the logic a lot, but does # mean that the individual detectors are not robust on their own. proc Detect-invalid {hand} {
if {[llength $hand] != 5} {return 1} foreach c $hand { if {[incr seen($c)] > 1} {return 1} } return 0
} proc Detect-straight-flush {hand} {
foreach c $hand { lassign $c pip suit if {[info exist prev] && $prev-1 != $pip} { # Special case: ace low straight flush ("steel wheel") if {$prev != 14 && $suit != 5} { return 0 } } set prev $pip incr seen($suit) } return [expr {[array size seen] == 1}]
} proc Detect-four-of-a-kind {hand} {
foreach c $hand { lassign $c pip suit if {[incr seen($pip)] > 3} {return 1} } return 0
} proc Detect-full-house {hand} {
foreach c $hand { lassign $c pip suit incr seen($pip) } return [expr {[array size seen] == 2}]
} proc Detect-flush {hand} {
foreach c $hand { lassign $c pip suit incr seen($suit) } return [expr {[array size seen] == 1}]
} proc Detect-straight {hand} {
foreach c $hand { lassign $c pip suit if {[info exist prev] && $prev-1 != $pip} { # Special case: ace low straight ("wheel") if {$prev != 14 && $suit != 5} { return 0 } } set prev $pip } return 1
} proc Detect-three-of-a-kind {hand} {
foreach c $hand { lassign $c pip suit if {[incr seen($pip)] > 2} {return 1} } return 0
} proc Detect-two-pair {hand} {
set pairs 0 foreach c $hand { lassign $c pip suit if {[incr seen($pip)] > 1} {incr pairs} } return [expr {$pairs > 1}]
} proc Detect-one-pair {hand} {
foreach c $hand { lassign $c pip suit if {[incr seen($pip)] > 1} {return 1} } return 0
}
}</lang> Demonstrating: <lang tcl>foreach hand {
"2♥ 2♦ 2♣ k♣ q♦" "2♥ 5♥ 7♦ 8♣ 9♠" "a♥ 2♦ 3♣ 4♣ 5♦" "2♥ 3♥ 2♦ 3♣ 3♦" "2♥ 7♥ 2♦ 3♣ 3♦" "2♥ 7♥ 7♦ 7♣ 7♠" "10♥ j♥ q♥ k♥ a♥" "4♥ 4♠ k♠ 5♦ 10♠" "q♣ 10♣ 7♣ 6♣ 4♣"
} {
puts "${hand}: [PokerHandAnalyser::analyse $hand]"
}</lang>
- Output:
2♥ 2♦ 2♣ k♣ q♦: three-of-a-kind 2♥ 5♥ 7♦ 8♣ 9♠: high-card a♥ 2♦ 3♣ 4♣ 5♦: straight 2♥ 3♥ 2♦ 3♣ 3♦: full-house 2♥ 7♥ 2♦ 3♣ 3♦: two-pair 2♥ 7♥ 7♦ 7♣ 7♠: four-of-a-kind 10♥ j♥ q♥ k♥ a♥: straight-flush 4♥ 4♠ k♠ 5♦ 10♠: one-pair q♣ 10♣ 7♣ 6♣ 4♣: flush