Poker hand analyser

From Rosetta Code
Jump to: navigation, search
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

Contents

[edit] C++

 
#include <iostream>
#include <sstream>
#include <algorithm>
#include <vector>
 
using namespace std;
 
class poker
{
public:
poker() { face = "A23456789TJQK"; suit = "SHCD"; }
string analyze( string h )
{
memset( faceCnt, 0, 13 ); memset( suitCnt, 0, 4 ); vector<string> hand;
transform( h.begin(), h.end(), h.begin(), toupper ); istringstream i( h );
copy( istream_iterator<string>( i ), istream_iterator<string>(), back_inserter<vector<string> >( hand ) );
if( hand.size() != 5 ) return "invalid hand."; vector<string>::iterator it = hand.begin();
sort( it, hand.end() ); if( hand.end() != adjacent_find( it, hand.end() ) ) return "invalid hand.";
while( it != hand.end() )
{
if( ( *it ).length() != 2 ) return "invalid hand.";
int n = face.find( ( *it ).at( 0 ) ), l = suit.find( ( *it ).at( 1 ) );
if( n < 0 || l < 0 ) return "invalid hand.";
faceCnt[n]++; suitCnt[l]++; it++;
}
cout << h << ": "; return analyzeHand();
}
private:
string analyzeHand()
{
bool p1 = false, p2 = false, t = false, f = false, fl = false, st = false;
for( int x = 0; x < 13; x++ )
switch( faceCnt[x] )
{
case 2: if( p1 ) p2 = true; else p1 = true; break;
case 3: t = true; break;
case 4: f = true;
}
for( int x = 0; x < 4; x++ )if( suitCnt[x] == 5 ){ fl = true; break; }
 
if( !p1 && !p2 && !t && !f )
{
int s = 0;
for( int x = 0; x < 13; x++ )
{
if( faceCnt[x] ) s++; else s = 0;
if( s == 5 ) break;
}
st = ( s == 5 ) || ( s == 4 && faceCnt[0] && !faceCnt[1] );
}
 
if( st && fl ) return "straight-flush";
else if( f ) return "four-of-a-kind";
else if( p1 && t ) return "full-house";
else if( fl ) return "flush";
else if( st ) return "straight";
else if( t ) return "three-of-a-kind";
else if( p1 && p2 ) return "two-pair";
else if( p1 ) return "one-pair";
return "high-card";
}
string face, suit;
unsigned char faceCnt[13], suitCnt[4];
};
 
int main( int argc, char* argv[] )
{
poker p;
cout << p.analyze( "2h 2d 2s ks qd" ) << endl; cout << p.analyze( "2h 5h 7d 8s 9d" ) << endl;
cout << p.analyze( "ah 2d 3s 4s 5s" ) << endl; cout << p.analyze( "2h 3h 2d 3s 3d" ) << endl;
cout << p.analyze( "2h 7h 2d 3s 3d" ) << endl; cout << p.analyze( "2h 7h 7d 7s 7c" ) << endl;
cout << p.analyze( "th jh qh kh ah" ) << endl; cout << p.analyze( "4h 4c kc 5d tc" ) << endl;
cout << p.analyze( "qc tc 7c 6c 4c" ) << endl << endl; return system( "pause" );
}
 
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

[edit] D

[edit] Basic Version

No bonus for this simple version.

Translation of: C++
import std.stdio, std.string, std.algorithm, std.range;
 
string analyzeHand(in string inHand) pure /*nothrow @safe*/ {
enum handLen = 5;
static immutable face = "A23456789TJQK", suit = "SHCD";
static immutable errorMessage = "invalid hand.";
 
/*immutable*/ const hand = inHand.toUpper.split.sort().release;
if (hand.length != handLen)
return errorMessage;
if (hand.uniq.walkLength != handLen)
return errorMessage ~ " Duplicated cards.";
 
ubyte[face.length] faceCount;
ubyte[suit.length] suitCount;
foreach (immutable card; hand) {
if (card.length != 2)
return errorMessage;
immutable n = face.countUntil(card[0]);
immutable l = suit.countUntil(card[1]);
if (n < 0 || l < 0)
return errorMessage;
faceCount[n]++;
suitCount[l]++;
}
 
return analyzeHandHelper(faceCount, suitCount);
}
 
private string analyzeHandHelper(const ref ubyte[13] faceCount,
const ref ubyte[4] suitCount)
pure nothrow @safe @nogc {
bool p1, p2, t, f, fl, st;
 
foreach (immutable fc; faceCount)
switch (fc) {
case 2: (p1 ? p2 : p1) = true; break;
case 3: t = true; break;
case 4: f = true; break;
default: // Ignore.
}
 
foreach (immutable sc; suitCount)
if (sc == 5) {
fl = true;
break;
}
 
if (!p1 && !p2 && !t && !f) {
uint s = 0;
foreach (immutable fc; faceCount) {
if (fc)
s++;
else
s = 0;
if (s == 5)
break;
}
 
st = (s == 5) || (s == 4 && faceCount[0] && !faceCount[1]);
}
 
if (st && fl) return "straight-flush";
else if (f) return "four-of-a-kind";
else if (p1 && t) return "full-house";
else if (fl) return "flush";
else if (st) return "straight";
else if (t) return "three-of-a-kind";
else if (p1 && p2) return "two-pair";
else if (p1) return "one-pair";
else return "high-card";
}
 
void main() {
// S = Spades, H = Hearts, C = Clubs, D = Diamonds.
foreach (immutable hand; ["2H 2D 2S KS QD",
"2H 5H 7D 8S 9D",
"AH 2D 3S 4S 5S",
"2H 3H 2D 3S 3D",
"2H 7H 2D 3S 3D",
"2H 7H 7D 7S 7C",
"TH JH QH KH AH",
"4H 4C KC 5D TC",
"QC TC 7C 6C 4C"])
writeln(hand, ": ", hand.analyzeHand);
}
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

[edit] 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@,:
punchLine=: {:@-.&a:@,@|:
rateHand=: [:;:inv [: (, [: punchLine -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)
)

Note that * acts as "logical and" on logical values (if you need to deal with boolean values in the original sense - which were not constrained to logical values - you should use *. instead of * to achieve boolean multiplication, but that's not needed here).

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

[edit] Java

Works with: Java version 7

This code does not qualify for extra credit. Although it supports wildcards, it does not allow for duplicates.

import java.util.Arrays;
import java.util.Collections;
import java.util.HashSet;
 
public class PokerHandAnalyzer {
 
final static String faces = "AKQJT98765432";
final static String suits = "HDSC";
final static String[] deck = buildDeck();
 
public static void main(String[] args) {
System.out.println("Regular hands:\n");
for (String input : new String[]{"2H 2D 2S KS QD",
"2H 5H 7D 8S 9D",
"AH 2D 3S 4S 5S",
"2H 3H 2D 3S 3D",
"2H 7H 2D 3S 3D",
"2H 7H 7D 7S 7C",
"TH JH QH KH AH",
"4H 4C KC 5D TC",
"QC TC 7C 6C 4C",
"QC TC 7C 7C TD"}) {
System.out.println(analyzeHand(input.split(" ")));
}
 
System.out.println("\nHands with wildcards:\n");
for (String input : new String[]{"2H 2D 2S KS WW",
"2H 5H 7D 8S WW",
"AH 2D 3S 4S WW",
"2H 3H 2D 3S WW",
"2H 7H 2D 3S WW",
"2H 7H 7D WW WW",
"TH JH QH WW WW",
"4H 4C KC WW WW",
"QC TC 7C WW WW",
"QC TC 7H WW WW"}) {
System.out.println(analyzeHandWithWildcards(input.split(" ")));
}
}
 
private static Score analyzeHand(final String[] hand) {
if (hand.length != 5)
return new Score("invalid hand: wrong number of cards", -1, hand);
 
if (new HashSet<>(Arrays.asList(hand)).size() != hand.length)
return new Score("invalid hand: duplicates", -1, hand);
 
int[] faceCount = new int[faces.length()];
long straight = 0, flush = 0;
for (String card : hand) {
 
int face = faces.indexOf(card.charAt(0));
if (face == -1)
return new Score("invalid hand: non existing face", -1, hand);
straight |= (1 << face);
 
faceCount[face]++;
 
if (suits.indexOf(card.charAt(1)) == -1)
return new Score("invalid hand: non-existing suit", -1, hand);
flush |= (1 << card.charAt(1));
}
 
// shift the bit pattern to the right as far as possible
while (straight % 2 == 0)
straight >>= 1;
 
// straight is 00011111; A-2-3-4-5 is 1111000000001
boolean hasStraight = straight == 0b11111 || straight == 0b1111000000001;
 
// unsets right-most 1-bit, which may be the only one set
boolean hasFlush = (flush & (flush - 1)) == 0;
 
if (hasStraight && hasFlush)
return new Score("straight-flush", 9, hand);
 
int total = 0;
for (int count : faceCount) {
if (count == 4)
return new Score("four-of-a-kind", 8, hand);
if (count == 3)
total += 3;
else if (count == 2)
total += 2;
}
 
if (total == 5)
return new Score("full-house", 7, hand);
 
if (hasFlush)
return new Score("flush", 6, hand);
 
if (hasStraight)
return new Score("straight", 5, hand);
 
if (total == 3)
return new Score("three-of-a-kind", 4, hand);
 
if (total == 4)
return new Score("two-pair", 3, hand);
 
if (total == 2)
return new Score("one-pair", 2, hand);
 
return new Score("high-card", 1, hand);
}
 
private static WildScore analyzeHandWithWildcards(String[] hand) {
if (Collections.frequency(Arrays.asList(hand), "WW") > 2)
throw new IllegalArgumentException("too many wildcards");
 
return new WildScore(analyzeHandWithWildcardsR(hand, null), hand.clone());
}
 
private static Score analyzeHandWithWildcardsR(String[] hand,
Score best) {
 
for (int i = 0; i < hand.length; i++) {
if (hand[i].equals("WW")) {
for (String card : deck) {
if (!Arrays.asList(hand).contains(card)) {
hand[i] = card;
best = analyzeHandWithWildcardsR(hand, best);
}
}
hand[i] = "WW";
break;
}
}
Score result = analyzeHand(hand);
if (best == null || result.weight > best.weight)
best = result;
return best;
}
 
private static String[] buildDeck() {
String[] dck = new String[suits.length() * faces.length()];
int i = 0;
for (char s : suits.toCharArray()) {
for (char f : faces.toCharArray()) {
dck[i] = "" + f + s;
i++;
}
}
return dck;
}
 
private static class Score {
final int weight;
final String name;
final String[] hand;
 
Score(String n, int w, String[] h) {
weight = w;
name = n;
hand = h != null ? h.clone() : h;
}
 
@Override
public String toString() {
return Arrays.toString(hand) + " " + name;
}
}
 
private static class WildScore {
final String[] wild;
final Score score;
 
WildScore(Score s, String[] w) {
score = s;
wild = w;
}
 
@Override
public String toString() {
return String.format("%s%n%s%n", Arrays.toString(wild),
score.toString());
}
}
}

Output:

Regular hands:

[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
[QC, TC, 7C, 7C, TD] invalid hand: duplicates

Hands with wildcards:

[2H, 2D, 2S, KS, WW]
[2H, 2D, 2S, KS, 2C] four-of-a-kind

[2H, 5H, 7D, 8S, WW]
[2H, 5H, 7D, 8S, 8H] one-pair

[AH, 2D, 3S, 4S, WW]
[AH, 2D, 3S, 4S, 5H] straight

[2H, 3H, 2D, 3S, WW]
[2H, 3H, 2D, 3S, 3D] full-house

[2H, 7H, 2D, 3S, WW]
[2H, 7H, 2D, 3S, 2S] three-of-a-kind

[2H, 7H, 7D, WW, WW]
[2H, 7H, 7D, 7S, 7C] four-of-a-kind

[TH, JH, QH, WW, WW]
[TH, JH, QH, AH, KH] straight-flush

[4H, 4C, KC, WW, WW]
[4H, 4C, KC, 4D, 4S] four-of-a-kind

[QC, TC, 7C, WW, WW]
[QC, TC, 7C, AC, KC] flush

[QC, TC, 7H, WW, WW]
[QC, TC, 7H, QH, QD] three-of-a-kind

[edit] Perl

I dont like jokers. Instead I decided to give hands proper names. For example, "Kings full of Tens" rather than just "full-house".

 
use strict;
use warnings;
use utf8;
use feature 'say';
use open qw<:encoding(utf-8) :std>;
 
package Hand {
sub describe {
my $str = pop;
my $hand = init($str);
return "$str: INVALID" if !$hand;
return analyze($hand);
}
 
sub init {
(my $str = lc shift) =~ tr/234567891jqka♥♦♣♠//cd;
return if $str !~ m/\A (?: [234567891jqka] [♥♦♣♠] ){5} \z/x;
for (my ($i, $cnt) = (0, 0); $i < 10; $i += 2, $cnt = 0) {
my $try = substr $str, $i, 2;
++$cnt while $str =~ m/$try/g;
return if $cnt > 1;
}
my $suits = $str =~ tr/234567891jqka//dr;
my $ranks = $str =~ tr/♥♦♣♠//dr;
return {
hand => $str,
suits => $suits,
ranks => $ranks,
};
}
 
sub analyze {
my $hand = shift;
my @ranks = split //, $hand->{ranks};
my %cards;
for (@ranks) {
$_ = 10, next if $_ eq '1';
$_ = 11, next if $_ eq 'j';
$_ = 12, next if $_ eq 'q';
$_ = 13, next if $_ eq 'k';
$_ = 14, next if $_ eq 'a';
} continue {
++$cards{ $_ };
}
my $kicker = 0;
my (@pairs, $set, $quads, $straight, $flush);
 
while (my ($card, $count) = each %cards) {
if ($count == 1) {
$kicker = $card if $kicker < $card;
}
elsif ($count == 2) {
push @pairs, $card;
}
elsif ($count == 3) {
$set = $card;
}
elsif ($count == 4) {
$quads = $card;
}
else {
die "Five of a kind? Cheater!\n";
}
}
$flush = 1 if $hand->{suits} =~ m/\A (.) \1 {4}/x;
$straight = check_straight(@ranks);
return get_high($kicker, \@pairs, $set, $quads, $straight, $flush,);
}
 
sub check_straight {
my $sequence = join ' ', sort { $a <=> $b } @_;
return 1 if index('2 3 4 5 6 7 8 9 10 11 12 13 14', $sequence) != -1;
return 'wheel' if index('2 3 4 5 14 6 7 8 9 10 11 12 13', $sequence) == 0;
return undef;
}
 
sub get_high {
my ($kicker, $pairs, $set, $quads, $straight, $flush) = @_;
$kicker = to_s($kicker, 's');
return 'straight-flush: Royal Flush!'
if $straight && $flush && $kicker eq 'Ace' && $straight ne 'wheel';
return "straight-flush: Steel Wheel!"
if $straight && $flush && $straight eq 'wheel';
return "straight-flush: $kicker high"
if $straight && $flush;
return 'four-of-a-kind: '. to_s($quads, 'p')
if $quads;
return 'full-house: '. to_s($set, 'p') .' full of '. to_s($pairs->[0], 'p')
if $set && @$pairs;
return "flush: $kicker high"
if $flush;
return 'straight: Wheel!'
if $straight && $straight eq 'wheel';
return "straight: $kicker high"
if $straight;
return 'three-of-a-kind: '. to_s($set, 'p')
if $set;
return 'two-pairs: '. to_s($pairs->[0], 'p') .' and '. to_s($pairs->[1], 'p')
if @$pairs == 2;
return 'one-pair: '. to_s($pairs->[0], 'p')
if @$pairs == 1;
return "high-card: $kicker";
}
 
my %to_str = (
2 => 'Two', 3 => 'Three', 4 => 'Four', 5 => 'Five', 6 => 'Six',
7 => 'Seven', 8 => 'Eight', 9 => 'Nine', 10 => 'Ten', 11 => 'Jack',
12 => 'Queen', 13 => 'King', 14 => 'Ace',
);
my %to_str_diffs = (2 => 'Deuces', 6 => 'Sixes',);
 
sub to_s {
my ($num, $verb) = @_;
# verb is 'singular' or 'plural' (or 's' or 'p')
if ($verb =~ m/\A p/xi) {
return $to_str_diffs{ $num } if $to_str_diffs{ $num };
return $to_str{ $num } .'s';
}
return $to_str{ $num };
}
}
 
my @cards = (
'10♥ j♥ q♥ k♥ a♥',
'2♥ 3♥ 4♥ 5♥ a♥',
'2♥ 2♣ 2♦ 3♣ 2♠',
'10♥ K♥ K♦ K♣ 10♦',
'q♣ 10♣ 7♣ 6♣ 3♣',
'5♣ 10♣ 7♣ 6♣ 4♣',
'9♥ 10♥ q♥ k♥ j♣',
'a♥ a♣ 3♣ 4♣ 5♦',
'2♥ 2♦ 2♣ k♣ q♦',
'6♥ 7♥ 6♦ j♣ j♦',
'2♥ 6♥ 2♦ 3♣ 3♦',
'7♥ 7♠ k♠ 3♦ 10♠',
'4♥ 4♠ k♠ 2♦ 10♠',
'2♥ 5♥ j♦ 8♣ 9♠',
'2♥ 5♥ 7♦ 8♣ 9♠',
'a♥ a♥ 3♣ 4♣ 5♦', # INVALID: duplicate aces
);
 
say Hand::describe($_) for @cards;
 

output

straight-flush: Royal Flush!
straight-flush: Steel Wheel!
four-of-a-kind: Deuces
full-house: Kings full of Tens
flush: Queen high
flush: Ten high
straight: King high
one-pair: Aces
three-of-a-kind: Deuces
two-pairs: Sixes and Jacks
two-pairs: Threes and Deuces
one-pair: Sevens
one-pair: Fours
high-card: Jack
high-card: Nine
a♥  a♥  3♣ 4♣ 5♦: INVALID

[edit] Perl 6

This solution handles jokers. It has been written as a Perl 6 grammar.

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 %faces := bag @<face-card>.map( -> $/ {~$<face>.lc} );
my @counts = %faces.values.sort.reverse;
@counts[0] += @<joker>;
return @counts;
}
 
sub flush($/) {
my %suits := set @<face-card>.map( -> $/ {~$<suit>} );
return +%suits == 1;
}
 
sub straight($/) {
# allow both ace-low and ace-high straights
my @seq = < a 2 3 4 5 6 7 8 9 10 j q k a >;
my $faces = set @<face-card>.map( -> $/ {~$<face>.lc} );
my $jokers = +@<joker>;
 
for 0..(+@seq - 5) {
 
my $run = set @seq[$_ .. $_+4];
 
return True
if +($faces$run) == 5 - $jokers;
}
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";
}
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

[edit] Prolog

Works with: GNU Prolog version 1.4.4

Not very efficient version.

:- initialization(main).
 
 
faces([a,k,q,j,10,9,8,7,6,5,4,3,2]).
 
face(F) :- faces(Fs), member(F,Fs).
suit(S) :- member(S, ['♥','♦','♣','♠']).
 
 
best_hand(Cards,H) :-
straight_flush(Cards,C) -> H = straight-flush(C)
; many_kind(Cards,F,4) -> H = four-of-a-kind(F)
; full_house(Cards,F1,F2) -> H = full-house(F1,F2)
; flush(Cards,S) -> H = flush(S)
; straight(Cards,F) -> H = straight(F)
; many_kind(Cards,F,3) -> H = three-of-a-kind(F)
; two_pair(Cards,F1,F2) -> H = two-pair(F1,F2)
; many_kind(Cards,F,2) -> H = one-pair(F)
; many_kind(Cards,F,1) -> H = high-card(F)
; H = invalid
.
 
straight_flush(Cards, c(F,S)) :- straight(Cards,F), flush(Cards,S).
 
full_house(Cards,F1,F2) :-
many_kind(Cards,F1,3), many_kind(Cards,F2,2), F1 \= F2.
 
flush(Cards,S) :- maplist(has_suit(S), Cards).
has_suit(S, c(_,S)).
 
straight(Cards,F) :-
select(c(F,_), Cards, Cs), pred_face(F,F1), straight(Cs,F1).
straight([],_).
pred_face(F,F1) :- F = 2 -> F1 = a ; faces(Fs), append(_, [F,F1|_], Fs).
 
two_pair(Cards,F1,F2) :-
many_kind(Cards,F1,2), many_kind(Cards,F2,2), F1 \= F2.
 
many_kind(Cards,F,N) :-
face(F), findall(_, member(c(F,_), Cards), Xs), length(Xs,N).
 
 
% utils/parser
parse_line(Cards) --> " ", parse_line(Cards).
parse_line([C|Cs]) --> parse_card(C), parse_line(Cs).
parse_line([]) --> [].
 
parse_card(c(F,S)) --> parse_face(F), parse_suit(S).
 
parse_suit(S,In,Out) :- suit(S), atom_codes(S,Xs), append(Xs,Out,In).
parse_face(F,In,Out) :- face(F), face_codes(F,Xs), append(Xs,Out,In).
 
face_codes(F,Xs) :- number(F) -> number_codes(F,Xs) ; atom_codes(F,Xs).
 
 
% tests
test(" 2♥ 2♦ 2♣ k♣ q♦").
test(" 2♥ 5♥ 7♦ 8♣ 9♠").
test(" a♥ 2♦ 3♣ 4♣ 5♦").
test(" 2♥ 3♥ 2♦ 3♣ 3♦").
test(" 2♥ 7♥ 2♦ 3♣ 3♦").
test(" 2♥ 7♥ 7♦ 7♣ 7♠").
test("10♥ j♥ q♥ k♥ a♥").
test(" 4♥ 4♠ k♠ 5♦ 10♠").
test(" q♣ 10♣ 7♣ 6♣ 4♣").
 
run_tests :-
test(Line), phrase(parse_line(Cards), Line), best_hand(Cards,H)
, write(Cards), write('\t'), write(H), nl
.
main :- findall(_, run_tests, _), halt.
Output:
[c(2,♥),c(2,♦),c(2,♣),c(k,♣),c(q,♦)]	three-of-a-kind(2)
[c(2,♥),c(5,♥),c(7,♦),c(8,♣),c(9,♠)]	high-card(9)
[c(a,♥),c(2,♦),c(3,♣),c(4,♣),c(5,♦)]	straight(5)
[c(2,♥),c(3,♥),c(2,♦),c(3,♣),c(3,♦)]	full-house(3,2)
[c(2,♥),c(7,♥),c(2,♦),c(3,♣),c(3,♦)]	two-pair(3,2)
[c(2,♥),c(7,♥),c(7,♦),c(7,♣),c(7,♠)]	four-of-a-kind(7)
[c(10,♥),c(j,♥),c(q,♥),c(k,♥),c(a,♥)]	straight-flush(c(a,♥))
[c(4,♥),c(4,♠),c(k,♠),c(5,♦),c(10,♠)]	one-pair(4)
[c(q,♣),c(10,♣),c(7,♣),c(6,♣),c(4,♣)]	flush(♣)

[edit] Python

Goes a little further in also giving the ordered tie-breaker information from the wikipedia page.

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]))
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']

[edit] Racket

#lang racket
(require (only-in srfi/1 car+cdr))
 
;;; --------------------------------------------------------------------------------------------------
;;; The analyser is first... the rest of it is prettiness surrounding strings and parsing!
;;; --------------------------------------------------------------------------------------------------
;; (cons f _) and (cons _ s) appear too frequently in patterns to not factor out
(define-match-expander F._ (λ (stx) (syntax-case stx () [(_ f) #'(cons f _)])))
(define-match-expander _.S (λ (stx) (syntax-case stx () [(_ s) #'(cons _ s)])))
 
;; Matches are easier when the cards are lined up by face: and I always put the cards in my hand with
;; the highest card on the left (should I be telling this?)... anyway face<? is written to leave high
;; cards on the left. There is no need to sort by suit, flushes are all-or-nothing
(define (face-sort hand)
(sort hand (match-lambda** [(_ 'joker) #f] [('joker _) #t] [((F._ f1) (F._ f2)) (> f1 f2)])))
 
;; even playing poker for money, I never managed to consistently determine what effect jokers were
;; having on my hand... so I'll do an exhaustive search of what's best!
;;
;; scoring hands allows us to choose a best value for joker(s)
;; hand-names provides an order (and therefore a score) for each of the available hands
(define hand-names (list 'five-of-a-kind 'straight-flush 'four-of-a-kind 'full-house 'flush 'straight
'three-of-a-kind 'two-pair 'one-pair 'high-card))
 
(define hand-order# (for/hash ((h hand-names) (i (in-range (add1 (length hand-names)) 0 -1)))
(values h i)))
;; The score of a hand is (its order*15^5)+(first tiebreaker*15^4)+(2nd tiebreaker*15^3)...
;; powers of 15 because we have a maxmium face value of 14 (ace) -- even though there are 13 cards
;; in a suit.
(define (calculate-score analysis)
(define-values (hand-name tiebreakers) (car+cdr analysis))
(for/sum ((n (in-naturals)) (tb (cons (hash-ref hand-order# hand-name -1) tiebreakers)))
(* tb (expt 15 (- 5 n)))))
 
;; score hand produces an analysis of a hand (which can then be returned to analyse-sorted-hand,
;; and a score that can be maximised by choosing the right jokers.
(define (score-hand hand . jokers) ; gives an orderable list of hands with tiebreakers
(define analysis (analyse-sorted-hand (face-sort (append jokers hand))))
(cons analysis (calculate-score analysis)))
 
;; if we have two (or more) jokers, they will be consumed by the recursive call to
;; analyse-sorted-hand score-hand
(define all-cards/promise (delay (for*/list ((f (in-range 2 15)) (s '(h d s c))) (cons f s))))
 
(define (best-jokered-hand cards) ; we've lost the first joker from cards
(define-values (best-hand _bhs)
(for*/fold ((best-hand #f) (best-score 0))
((joker (in-list (force all-cards/promise)))
(score (in-value (score-hand cards joker)))
#:when (> (cdr score) best-score))
(car+cdr score)))
 
best-hand)
 
;; we can abbreviate 2/3/4/5-of-a-kind 2-pair full-house with 2 and 3
(define-match-expander F*2 (λ (stx) (syntax-case stx () [(_ f) #'(list (F._ f) (F._ f))])))
(define-match-expander F*3 (λ (stx) (syntax-case stx () [(_ f) #'(list (F._ f) (F._ f) (F._ f))])))
 
;; note that flush? is cheaper to calculate than straight?, so do it first when we test for
;; straight-flush
(define flush?
(match-lambda [(and `(,(_.S s) ,(_.S s) ,(_.S s) ,(_.S s) ,(_.S s)) `(,(F._ fs) ...)) `(flush ,@fs)]
[_ #f]))
 
(define straight?
(match-lambda
 ;; '(straight 5) puts this at the bottom of the pile w.r.t the ordering of straights
[`(,(F._ 14) ,(F._ 5) ,(F._ 4) ,(F._ 3) ,(F._ 2)) '(straight 5)]
[`(,(F._ f5) ,(F._ f4) ,(F._ f3) ,(F._ f2) ,(F._ f1))
(and (= f1 (- f5 4)) (< f1 f2 f3 f4 f5) `(straight ,f5))]))
 
(define analyse-sorted-hand
(match-lambda
[(list 'joker cards ...) (best-jokered-hand cards)]
[`(,@(F*3 f) ,@(F*2 f)) `(five-of-a-kind ,f)]
 ;; get "top" from the straight. a the top card of the flush when there is a (straight 5) will
 ;; be the ace ... putting it in the wrong place for the ordering.
[(and (? flush?) (app straight? (list 'straight top _ ...))) `(straight-flush ,top)]
[(or `(,@(F*2 f) ,@(F*2 f) ,_) `(,_ ,@(F*2 f) ,@(F*2 f))) `(four-of-a-kind ,f)]
[(or `(,@(F*3 fh) ,@(F*2 fl)) `(,@(F*2 fh) ,@(F*3 fl))) `(full-house ,fh, fl)]
[(app flush? (and rv (list 'flush _ ...))) rv]
[(app straight? (and rv (list 'straight _ ...))) rv]
 ;; pairs and threes may be padded to the left, middle and right with tie-breakers; the lists of
 ;; which we will call l, m and r, respectively (four and 5-of-a-kind don't need tiebreaking,
 ;; they're well hard!)
[`(,(F._ l) ... ,@(F*3 f) ,(F._ r) ...) `(three-of-a-kind ,f ,@l ,@r)]
[`(,(F._ l) ... ,@(F*2 f1) ,(F._ m) ... ,@(F*2 f2) ,(F._ r) ...) `(two-pair ,f1 ,f2 ,@l ,@m ,@r)]
[`(,(F._ l) ... ,@(F*2 f) ,(F._ r) ...) `(one-pair ,f ,@l ,@r)]
[`(,(F._ f) ...) `(high-card ,@f)]
[hand (error 'invalid-hand hand)]))
 
(define (analyse-hand/string hand-string)
(analyse-sorted-hand (face-sort (string->hand hand-string))))
 
;;; --------------------------------------------------------------------------------------------------
;;; Strings to cards, cards to strings -- that kind of thing
;;; --------------------------------------------------------------------------------------------------
(define suit->unicode (match-lambda ('h "♥") ('d "♦") ('c "♣") ('s "♠") (x x)))
 
(define unicode->suit (match-lambda ("♥" 'h) ("♦" 'd) ("♣" 'c) ("♠" 's) (x x)))
 
(define (face->number f)
(match (string-upcase f)
["T" 10] ["J" 11] ["Q" 12] ["K" 13] ["A" 14] [(app string->number (? number? n)) n] [else 0]))
 
(define number->face (match-lambda (10 "T") (11 "J") (12 "Q") (13 "K") (14 "A") ((app ~s x) x)))
 
(define string->card
(match-lambda
("joker" 'joker)
((regexp #px"^(.*)(.)$" (list _ (app face->number num) (app unicode->suit suit)))
(cons num suit))))
 
(define (string->hand str)
(map string->card (regexp-split #rx" +" (string-trim str))))
 
(define card->string
(match-lambda ['joker "[]"]
[(cons (app number->face f) (app suit->unicode s)) (format "~a~a" f s)]))
 
(define (hand->string h)
(string-join (map card->string h) " "))
 
;; used for both testing and output
(define e.g.-hands
(list " 2♥ 2♦ 2♣ k♣ q♦" " 2♥ 5♥ 7♦ 8♣ 9♠" " a♥ 2♦ 3♣ 4♣ 5♦" "10♥ j♦ q♣ k♣ a♦"
" 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♣"
 
" 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 k♣ 7♣ 6♣ 4♣"
" joker 2♦ joker 4♠ 5♠" " joker Q♦ joker A♠ 10♠" " joker Q♦ joker A♦ 10♦"
" joker 2♦ 2♠ joker q♦"))
 
;;; --------------------------------------------------------------------------------------------------
;;; Main and test modules
;;; --------------------------------------------------------------------------------------------------
(module+ main
(define scored-hands
(for/list ((h (map string->hand e.g.-hands)))
(define-values (analysis score) (car+cdr (score-hand h)))
(list h analysis score)))
 
(for ((a.s (sort scored-hands > #:key third)))
(match-define (list (app hand->string h) a _) a.s)
(printf "~a: ~a ~a" h (~a (first a) #:min-width 15) (number->face (second a)))
(when (pair? (cddr a)) (printf " [tiebreak: ~a]" (string-join (map number->face (cddr a)) ", ")))
(newline)))
 
(module+ test
(require rackunit)
(let ((e.g.-strght-flsh '((14 . h) (13 . h) (12 . h) (11 . h) (10 . h))))
(check-match (straight? e.g.-strght-flsh) '(straight 14))
(check-match (flush? e.g.-strght-flsh) '(flush 14 13 12 11 10))
(check-match e.g.-strght-flsh (and (? flush?) (app straight? (list 'straight top _ ...)))))
 
(define expected-results
'((three-of-a-kind 2 13 12)
(high-card 9 8 7 5 2) (straight 5) (straight 14) (full-house 3 2) (two-pair 3 2 7)
(four-of-a-kind 7) (straight-flush 14) (one-pair 4 13 10 5) (flush 12 10 7 6 4)
(three-of-a-kind 2 13 12) (straight 9) (straight 6) (four-of-a-kind 3) (three-of-a-kind 3 7 2)
(five-of-a-kind 7) (straight-flush 14) (one-pair 13 10 5 4) (flush 14 13 7 6 4) (straight 6)
(straight 14) (straight-flush 14) (four-of-a-kind 2)))
(for ((h e.g.-hands) (r expected-results)) (check-equal? (analyse-hand/string h) r)))
Output:
[] 7♥ 7♦ 7♠ 7♣: five-of-a-kind  7
T♥ J♥ Q♥ K♥ A♥: straight-flush  A
[] J♥ Q♥ K♥ A♥: straight-flush  A
[] Q♦ [] A♦ T♦: straight-flush  A
2♥ 7♥ 7♦ 7♣ 7♠: four-of-a-kind  7
[] 3♥ 2♦ 3♠ 3♦: four-of-a-kind  3
[] 2♦ 2♠ [] Q♦: four-of-a-kind  2
2♥ 3♥ 2♦ 3♣ 3♦: full-house      3 [tiebreak: 2]
[] K♣ 7♣ 6♣ 4♣: flush           A [tiebreak: K, 7, 6, 4]
Q♣ T♣ 7♣ 6♣ 4♣: flush           Q [tiebreak: T, 7, 6, 4]
T♥ J♦ Q♣ K♣ A♦: straight        A
[] Q♦ [] A♠ T♠: straight        A
[] 5♥ 7♦ 8♠ 9♦: straight        9
[] 2♦ 3♠ 4♠ 5♠: straight        6
[] 2♦ [] 4♠ 5♠: straight        6
A♥ 2♦ 3♣ 4♣ 5♦: straight        5
[] 7♥ 2♦ 3♠ 3♦: three-of-a-kind 3 [tiebreak: 7, 2]
2♥ 2♦ 2♣ K♣ Q♦: three-of-a-kind 2 [tiebreak: K, Q]
[] 2♦ 2♠ K♠ Q♦: three-of-a-kind 2 [tiebreak: K, Q]
2♥ 7♥ 2♦ 3♣ 3♦: two-pair        3 [tiebreak: 2, 7]
[] 4♣ K♣ 5♦ T♠: one-pair        K [tiebreak: T, 5, 4]
4♥ 4♠ K♠ 5♦ T♠: one-pair        4 [tiebreak: K, T, 5]
2♥ 5♥ 7♦ 8♣ 9♠: high-card       9 [tiebreak: 8, 7, 5, 2]

[edit] REXX

[edit] version 1

/* 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
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

[edit] 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 (;)
/*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*/

Programming note: some older REXXes don't have the countstr BIF, so that REXX statement (above, line 21) can be replaced with:

pairs=13-length(space(translate(pips,,2),0)) /*count # of  2's  in PIPS.*/

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

[edit] 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)
/*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*/

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 

[edit] Ruby

Joker-less hands are sorted high to low.

class Card
include Comparable
attr_accessor :ordinal
attr_reader :suit, :face
 
SUITS = %i(♥ ♦ ♣ ♠)
FACES = %i(2 3 4 5 6 7 8 9 10 j q k a)
 
def initialize(str)
@face, @suit = parse(str)
@ordinal = FACES.index(@face)
end
 
def <=> (other) #used for sorting
self.ordinal <=> other.ordinal
end
 
def to_s
[@face, @suit].join
end
 
private
def parse(str)
face, suit = str.chop.to_sym, str[-1].to_sym
raise ArgumentError, "invalid card: #{str}" unless FACES.include?(face) && SUITS.include?(suit)
[face, suit]
end
 
end
 
class Hand
include Comparable
attr_reader :cards
 
RANKS = %i(high_card one_pair two_pair three_of_a_kind straight
flush full_house four_of_a_kind straight_flush five_of_a_kind)
WHEEL_FACES = %i(2 3 4 5 a)
 
def initialize(str_of_cards)
@cards = str_of_cards.downcase.split(/[\s+|,|, ]/).map{|str| Card.new(str)}
grouped = @cards.group_by(&:face).values
@tiebreaker = grouped.sort_by {|ar| [ar.size, ar.first]}.reverse
@face_pattern = grouped.map(&:size).sort
@rank = categorize
@rank_num = RANKS.index(@rank)
end
 
def category
@rank.to_s.tr("_", "-")
end
 
def <=> (other) # used for sorting and comparing
self.compare_value <=> other.compare_value
end
 
def to_s
@cards.map(&:to_s).join(" ")
end
 
protected # accessible for Hands
def compare_value
[@rank_num, @tiebreaker]
end
 
private
def one_suit?
@cards.map(&:suit).uniq.size == 1
end
 
def consecutive?
sort.each_cons(2).all? {|c1,c2| c2.ordinal - c1.ordinal == 1 }
end
 
def sort
if @cards.sort.map(&:face) == WHEEL_FACES then
@cards.detect {|c| c.face == :a}.ordinal = -1
end
@cards.sort
end
 
def categorize
rank = :flush if one_suit?
rank = :straight if consecutive?
rank = :straight_flush if rank == :straight and one_suit?
return rank if rank
return case @face_pattern
when [1,1,1,1,1] then :high_card
when [1,1,1,2] then :one_pair
when [1,2,2] then :two_pair
when [1,1,3] then :three_of_a_kind
when [2,3] then :full_house
when [1,4] then :four_of_a_kind
when [5] then :five_of_a_kind
end
end
 
end
 
# Demo
test_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♥ 6♥ 2♦ 3♣ 3♦
10♥ j♥ q♥ k♥ a♥
4♥ 4♠ k♠ 2♦ 10♠
4♥ 4♠ k♠ 3♦ 10♠
q♣ 10♣ 7♣ 6♣ 4♣
q♣ 10♣ 7♣ 6♣ 3♣
9♥ 10♥ q♥ k♥ j♣
2♥ 3♥ 4♥ 5♥ a♥
2♥ 2♥ 2♦ 3♣ 3♦"

 
hands = test_hands.each_line.map{|line| Hand.new(line) }
puts "High to low"
hands.sort.reverse.each{|hand| puts "#{hand}\t #{hand.category}" }
puts
 
str = "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 k♣ 7♣ 6♣ 4♣
joker 2♦ joker 4♠ 5♠
joker Q♦ joker A♠ 10♠
joker Q♦ joker A♦ 10♦
joker 2♦ 2♠ joker q♦"

 
# Neither the Card nor the Hand class supports jokers
# but since hands are comparable, they are also sortable.
# Try every card from a deck for a joker and pick the largest hand:
 
DECK = Card::FACES.product(Card::SUITS).map(&:join)
str.each_line do |line|
cards_in_arrays = line.split.map{|c| c == "joker" ? DECK.dup : [c]} #joker is array of all cards
all_tries = cards_in_arrays.shift.product(*cards_in_arrays).map{|ar| Hand.new(ar.join" ")} #calculate the Whatshisname product
best = all_tries.max
puts "#{line.strip}: #{best.category}"
end
 
Output:
High to low
10♥ j♥ q♥ k♥ a♥	 straight-flush
2♥ 3♥ 4♥ 5♥ a♥	 straight-flush
2♥ 3♥ 2♦ 3♣ 3♦	 full-house
2♥ 2♥ 2♦ 3♣ 3♦	 full-house
q♣ 10♣ 7♣ 6♣ 4♣	 flush
q♣ 10♣ 7♣ 6♣ 3♣	 flush
9♥ 10♥ q♥ k♥ j♣	 straight
a♥ 2♦ 3♣ 4♣ 5♦	 straight
2♥ 2♦ 2♣ k♣ q♦	 three-of-a-kind
2♥ 7♥ 2♦ 3♣ 3♦	 two-pair
2♥ 6♥ 2♦ 3♣ 3♦	 two-pair
4♥ 4♠ k♠ 3♦ 10♠	 one-pair
4♥ 4♠ k♠ 2♦ 10♠	 one-pair
2♥ 5♥ 7♦ 8♣ 9♠	 high-card

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

[edit] Tcl

Works with: Tcl version 8.6
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 21 d 10 c 03 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
}
}

Demonstrating:

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]"
}
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
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox