Poker hand analyser: Difference between revisions

From Rosetta Code
Content added Content deleted
(J)
(J: support jokers and bugfix for straights (joker code could be organized more nicely))
Line 63: Line 63:
<lang J>parseHand=: <;._2@,&' '@u:~&7 NB. hand must be well formed
<lang J>parseHand=: <;._2@,&' '@u:~&7 NB. hand must be well formed
Suits=: <"> 7 u: '♥♦♣♦' NB. or Suits=: 'hdcs'
Suits=: <"> 7 u: '♥♦♣♦' NB. or Suits=: 'hdcs'
Faces=: ;: 'a 2 3 4 5 6 7 8 9 10 j q k'
Faces=: <;._1 ' 2 3 4 5 6 7 8 9 10 j q k a'


suits=: {:&.>
suits=: {:&.>
faces=: }:&.>
faces=: }:&.>
flush=: 1 =&#&~. suits
flush=: 1 =&#&~. suits
straight=: 1 = Faces +/@E.~ /:~@:faces
straight=: 1 = (i.#Faces) +/@E.~ Faces /:~@i. faces
kinds=: #/.~ @:faces
kinds=: #/.~ @:faces
five=: 5 e. kinds NB. jokers or other cheat
four=: 4 e. kinds
four=: 4 e. kinds
three=: 3 e. kinds
three=: 3 e. kinds
Line 76: Line 77:
highcard=: 5 = 1 +/ .= kinds
highcard=: 5 = 1 +/ .= kinds


IF=: 2 :',&(<m) ^: v'
IF=: 2 :'(,&(<m) ^: v)"1'
Or=: 2 :'u ^:(5 = #) @ v'
Or=: 2 :'u ^:(5 e. $) @: v'


Deck=: ,Faces,&.>/Suits
rateHand=: [:;:inv [:] 1 :(0 :0-.LF) parseHand
Joker=: <'joker'
joke=: [: ,/^:(#@$ - 2:) (({. ,"1 Deck ,"0 1 }.@}.)^:(5>[)~ i.&Joker)"1^:2@,:
rateHand=: [:;:inv [: (, [: {:@-.&a:@,@|: -1 :(0 :0-.LF)@joke) parseHand
('invalid' IF 1:) Or
('invalid' IF 1:) Or
('high-card' IF highcard) Or
('high-card' IF highcard) Or
Line 89: Line 93:
('full-house' IF (two * three)) Or
('full-house' IF (two * three)) Or
('four-of-a-kind' IF four) Or
('four-of-a-kind' IF four) Or
('straight-flush' IF (straight * flush))
('straight-flush' IF (straight * flush)) Or
('five-of-a-kind' IF five)
)</lang>
)</lang>


Output for required examples:
Output for required examples:


2♥ 2♦ 2♣ k♣ q♦ three-of-a-kind
2♥ 2♦ 2♣ k♣ q♦ three-of-a-kind
2♥ 5♥ 7♦ 8♣ 9♠ high-card
2♥ 5♥ 7♦ 8♣ 9♠ high-card
a♥ 2♦ 3♣ 4♣ 5♦ high-card
a♥ 2♦ 3♣ 4♣ 5♦ high-card
2♥ 3♥ 2♦ 3♣ 3♦ full-house
2♥ 3♥ 2♦ 3♣ 3♦ full-house
2♥ 7♥ 2♦ 3♣ 3♦ two-pair
2♥ 7♥ 2♦ 3♣ 3♦ two-pair
2♥ 7♥ 7♦ 7♣ 7♠ four-of-a-kind
2♥ 7♥ 7♦ 7♣ 7♠ four-of-a-kind
10♥ j♥ q♥ k♥ a♥ flush
10♥ j♥ q♥ k♥ a♥ straight-flush
4♥ 4♠ k♠ 5♦ 10♠ one-pair
4♥ 4♠ k♠ 5♦ 10♠ one-pair
q♣ 10♣ 7♣ 6♣ 4♣ flush
q♣ 10♣ 7♣ 6♣ 4♣ flush


Output for extra-credit examples
FIXME: Supporting jokers is a relatively trivial extension but I should get breakfast before implementing that.

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


=={{header|Perl 6}}==
=={{header|Perl 6}}==

Revision as of 01:38, 30 December 2013

Poker hand analyser is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

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:

  1. use the playing card characters introduced with Unicode 6.0 (U+1F0A1 - U+1F0DE).
  2. 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 2. 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

J

<lang J>parseHand=: <;._2@,&' '@u:~&7 NB. hand must be well formed Suits=: <"> 7 u: '♥♦♣♦' NB. or Suits=: 'hdcs' Faces=: <;._1 ' 2 3 4 5 6 7 8 9 10 j q k a'

suits=: {:&.> faces=: }:&.> flush=: 1 =&#&~. suits straight=: 1 = (i.#Faces) +/@E.~ Faces /:~@i. faces kinds=: #/.~ @:faces five=: 5 e. kinds NB. jokers or other cheat four=: 4 e. kinds three=: 3 e. kinds two=: 2 e. kinds twoPair=: 2 = 2 +/ .= kinds highcard=: 5 = 1 +/ .= kinds

IF=: 2 :'(,&(<m) ^: v)"1' Or=: 2 :'u ^:(5 e. $) @: v'

Deck=: ,Faces,&.>/Suits Joker=: <'joker' joke=: [: ,/^:(#@$ - 2:) (({. ,"1 Deck ,"0 1 }.@}.)^:(5>[)~ i.&Joker)"1^:2@,: rateHand=: [:;:inv [: (, [: {:@-.&a:@,@|: -1 :(0 :0-.LF)@joke) parseHand

('invalid' IF 1:) Or
('high-card' IF highcard) Or
('one-pair' IF two) Or
('two-pair' IF twoPair) Or
('three-of-a-kind' IF three) Or
('straight' IF straight) Or
('flush' IF flush) Or
('full-house' IF (two * three)) Or
('four-of-a-kind' IF four) Or
('straight-flush' IF (straight * flush)) Or
('five-of-a-kind' IF five)

)</lang>

Output for required examples:

 2♥ 2♦ 2♣ k♣ q♦ three-of-a-kind
 2♥ 5♥ 7♦ 8♣ 9♠ high-card
 a♥ 2♦ 3♣ 4♣ 5♦ high-card
 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

Output for 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 jqka]> | 10 }
   token suit {<[♥♦♠♣]>}
   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>.lc }++
       }
       my @c = %n.values.sort.reverse;
       @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()

  1. 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'

  1. 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

Works with: Tcl version 8.6

<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