Classifying poker hands by pattern matching

Question

I am working on this question posed in a Mathematica course revised in 1998. Here are the instructions:

Poker Hands

You are to define and show working examples of a function "poker[]". The function "poker[]" should take five integers, each between 1 and 13, and output the best poker hand. (True poker experts should note that we are ignoring suits for simplicity.)

The possibilities from best to worst are: "Five of a kind", "Four of a kind", "Full house" (three cards of one kind and two of another), "Straight" (five consecutive, distinct cards), "Three of a kind", "Two pair", "Pair", and "High card" (the case in which none of the above apply).

Examples: poker[1, 2, 1, 2, 1] should return "full house"; poker[1, 1, 3, 4, 4] should return "two pair".

Hint #1: There are many combinations of two of a kind: the pair might be in the first two cards, the second two cards, the first and third, and so on. To deal with this, consider sorting the five arguments before sending them to a second function with particular pattern definitions.

Hint #2: Use multiple definitions for this second function, along with pattern matching. Here are sample definitions for two hands.

poker[a_,a_,a_,a_,a_]:="Five of a kind" 

poker[a_,a_,a_,b__]:="Three of a kind"
(* the name b is unnessary, although the BlankSequence is not *)

Clear[poker]
poker[0,0,0,0,0];
poker[a_?NumberQ,b_?NumberQ,c_?NumberQ,d_?NumberQ,e_?NumberQ]:=Sort[poker[a,b,c,d,e]]
poker[a_,a_,a_,a_,a_]:="Five of a kind"
poker[b_,a_,a_,a_,a_]:="Four of a kind"
poker[a_,a_,a_,a_,b_]:="Four of a kind"
poker[b_,b_,a_,a_,a_]:="Full House"
poker[a_,a_,a_,b_,b_]:="Full House"  
poker[a_,a_,a_,b_,c_]:="Three of a kind"
poker[b_,c_,a_,a_,a_]:="Three of a kind"
poker[b_,a_,a_,a_,c_]:="Three of a kind" 

As is evident from the from the error messages and incorrect answers below, I have made a/some mistake(s), even the outputs that correctly identified the "hand" added Sort[] to the output. I had at first thought that "hands" were only identified when the four or three similar cards (in the case of Full House) were at the beginning of the sort, however that theory was disproved once the Three of a kind hands were inspected. I have not defined the rest of the "hands" because it became evident that I had made a mistake in the definitions I had already written.

poker[3, 3, 3, 3, 3]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> Sort["Five of a kind"] -- correct *)

poker[3, 2, 2, 2, 2]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> Sort["Four of a kind"] -- correct *)

poker[3, 3, 3, 2, 3]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> Sort["Three of a kind"] -- should be "Four of a kind" *)

poker[1, 2, 1, 2, 1]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> Sort["Full House"] -- correct *)

poker[1, 2, 2, 2, 1]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> Sort["Three of a kind"] -- should be "Full House" *)

poker[1, 2, 1, 3, 1]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> Sort["Three of a kind"] -- correct *)

poker[2, 1, 2, 3, 2]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> Sort["Three of a kind"] -- correct *)

poker[3, 3, 1, 3, 2]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> Sort["Three of a kind"] -- correct *)

poker[4, 1, 5, 3, 2]
(* (prints) $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>
 -> poker[1, 2, 3, 4, 5] -- correctly not identified *)

Answer 1

Jonathan Shock's comment is very pertinent. The specific issue you have is that you are defining a recursive function with no absorbing state. So even if the arguments to the poker function are already in sorted order, calling poker[args] sends the input to the poker function itself and then sorts the output. There's no end to this, and the Sort is in the wrong place, as you can see by the output that does come out, with Sort still wrapped around it.

Here is an alternative approach that still teaches you about patterns, but avoids the unnecessary and problematic recursion. I only put in a few of the replacement rules, but you get the idea.

Clear[poker]
poker[args__?NumberQ] /; Length[{args}] == 5 := 
 With[{hand = Sort[{args}]},
  hand /. {{a_, a_, a_, a_, a_} -> "Five of a kind", 
     {a_, a_, a_, a_, b_} -> "Four of a kind", 
     {b_, a_, a_, a_, a_} -> "Four of a kind", 
     {a_, a_, a_, b_, b_} -> "Full house", 
     {b_, b_, a_, a_, a_} -> "Full house"}]

poker[wrongnumberofargs__] /; 
  Length[{wrongnumberofargs}] != 
   5 := "Are we playing poker or canasta?"

A couple of things to note about this:

• I used Condition (/;) to ensure that only five-card hands are valid.
• I used With to define a local constant (see this Q&A for some excellent information about the different scoping constructs in Mathematica.
• When applying a list of replacement rules using ReplaceAll (/.) , earlier rules are applied before later ones, so put the most specific rules first in the list.

---

Playing with the patterns a bit, they can be condensed down to one rule per hand type, as follows:

ClearAll[poker]
SetAttributes[poker, Orderless];
poker[hand__?NumberQ] /; Length[{hand}] == 5 :=
 {hand}/.{
  {a_, a_, a_, a_, a_} -> "Five of a kind",
  {___, a_, a_, a_, a_, ___} -> "Four of a kind",
  {a_ .., b_ ..} -> "Full House",
  {___, a_, a_, a_, ___} -> "Three of a kind",
  {___, a_, a_, ___, b_, b_, ___} -> "Two Pair",
  {___,a_, a_,___} -> "Single Pair",
  a_ /; Max@Differences[a]==1 -> "Straight", 
  _ -> "High"
}

poker[wrongnumberofargs__] /; 
   Length[{wrongnumberofargs}] != 5 := "Are we playing poker or canasta?"

Note: this makes use of the Attribute Orderless which eliminated the need for the explicit Sort. Also, it makes liberal use of the fact there are only five cards in the hand and that the rules are applied in order, as mentioned above.

---

Orderless appears to have interesting consequences. If you convert the patterns above to functions, e.g.

{a_ .., b_ ..} -> "Full House"

becomes

poker[a_ .., b_ ..] := "Full House"

and run DownValues[poker] you notice some interesting things. All the instances of BlankNullSequence (___) appear first in the pattern. This implies that further simplifications can be made:

ClearAll[poker]
poker[wrongnumberofargs__] /; 
  Length[{wrongnumberofargs}] != 5 := "Are we playing poker or canasta?"

SetAttributes[poker, Orderless];
poker[a_, a_, a_, a_, a_] := "Five of a kind"
poker[_, a_, a_, a_, a_] := "Four of a kind"
poker[a_ .., b_ ..] := "Full House"
poker[__, a_, a_, a_] := "Three of a kind"
poker[__, a_, a_, b_, b_] := "Two Pair"
poker[__, a_, a_] := "Single Pair"
poker[hand__] /; Max@Differences[{hand}]==1 := "Straight" 
poker[__] := "High"

First, only one definition has a Condition. Second, all instances of BlankNullSequence within a pattern have been merged into one at the beginning of the pattern, and converted to BlankSequence (__). Third, the BlankNullSequence in "Four of a kind" has been changed to Blank (_). Lastly, the same conversions cannot be made to the above code using ReplaceAll and have it still work. There the order of the patterns matter because only the patterns that make up poker are Orderless.

Answer 2

Perhaps not the intended approach, but you could use Tally to count the matching cards and make the pattern matching very simple:

poker[x__] := Sort[Tally[{x}][[All, 2]]] /. {
   {1, 1, 1, 1, 1} -> If[Sort[{x}] - Min[x] == {0, 1, 2, 3, 4}, "straight", "high"],
   {1, 1, 1, 2} -> "pair",
   {1, 2, 2} -> "two pair",
   {1, 1, 3} -> "three",
   {1, 4} -> "four",
   {5} -> "five",
   {2, 3} -> "full house",
   _ -> "cheating!"}