Task

Create a program to parse a single five card poker hand and rank it according to this list of poker hands.



A poker hand is specified as a space separated list of five playing cards.

Each input card has two characters indicating face and suit.



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 analyze 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♣ q♣:  invalid

The programs output for the above examples should be displayed here on this page.



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


More 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



Related tasks

 Playing cards
 Card shuffles
 Deal cards_for_FreeCell
 War Card_Game
 Go Fish


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
    }
}