Discriminated union types are pretty damned powerful, especially when modeling business domains. A business domain I enjoy immensely is Poker. The below Fun Friday post examples modeling poker hands.
First thing, I started with the below enums to start modeling out the cards themselves.
type Suit = | Clubs = 0 | Diamonds = 1 | Hearts = 2 | Spades = 3
type Rank = | Two = 2 | Three = 3 | Four = 4 | Five = 5
| Six = 6 | Seven = 7 | Eight = 8 | Nine = 9 | Ten = 10
| Jack = 11 | Queen = 12 | King = 13 | Ace = 14
type Card = { Rank : Rank; Suit: Suit }
This makes the problem space fairly easy to put together, but preferred to have a ‘deck’ of cards to deal with. Note, because I used standard enumerations for the Suit and Ranks, I was able to write a quick ‘toList’ function to grab enumeration values and stick them in a standard F# list.
let toList = [for i in System.Enum.GetValues(typedefof)
do yield i] |>
List.map (fun n -> downcast n : 'a )
let deck = List.allPairs toList toList |>
List.map (fun (s,r) -> { Suit = s; Rank = r; })
OK. So we have a deck to deal with. Now, to deal with Poker Hands.
I chose to model the Poker Hand with a discriminated union type mainly to example a bounded set scenario. The fact is, for my game here (or my ‘business scenario’), I need to treat ‘poker hands’ as singular types, but the individual types differ quite a lot. In practice, they became distinctly organized sets of ‘Rank’ objects.
type PokerHand =
| StraightFlush of HighestCard : Rank
| Quads of QuadsRank : Rank * Kicker : Rank
| FullHouse of TripsRank : Rank * PairRank : Rank
| Flush of Card1 : Rank * Card2 : Rank * Card3 : Rank * Card4 : Rank * Card5 : Rank
| Straight of HighestCard : Rank
| Trips of TripsRank : Rank * Kickers : (Rank * Rank)
| TwoPair of HighPairRank : Rank * SecondPairRank : Rank * Kicker: Rank
| Pair of PairRank : Rank * Kickers : (Rank * Rank * Rank)
| HighCard of Kickers : (Rank * Rank * Rank * Rank * Rank)
A lot of the reasons I chose to model out the Poker Hands individually like this was to make comparing poker hands relatively easy to reason about. I’ll assume you know how poker hands compare, but if not, click here.
Comparing two poker hands is a fairly simple operation. First, you start with the ranks of the hand types themselves, and if one hand is ‘bigger’ than the other, that’s your winner. A function-style expression works with that nicely, as we can bind directly to the value. This style expression takes an implied parameter of type PokerHand (you’ll see usage below.)
let handRank = function
| StraightFlush _ -> 8 | Quads _ -> 7 | FullHouse _ -> 6
| Flush _ -> 5 | Straight _ -> 4 | Trips _ -> 3
| TwoPair _ -> 2 | Pair _ -> 1 | HighCard _ -> 0
Second, if the hands are the same, you need to be able to compare the ranks of the cards, in order of relevance to the hand. It is this relevance that I decided to model in the PokerHand union type above. Still, comparing ranks was easy.
let compareRanks x y =
if x > y then 1
else if y > x then -1
else 0
So we have the baseline functions all set here. Putting it all together, we end up with the following:
let compare hand1 hand2 =
let handRank = function
| StraightFlush _ -> 8 | Quads _ -> 7 | FullHouse _ -> 6 | Flush _ -> 5 | Straight _ -> 4
| Trips _ -> 3 | TwoPair _ -> 2 | Pair _ -> 1 | HighCard _ -> 0
let compareRanks x y =
if x > y then 1
else if y > x then -1
else 0
match hand1, hand2 with
| (x, y)
when (handRank x) - (handRank y) 0 -> Some (sign ((handRank x) - (handRank y)))
| (Quads (c, _), Quads (c2, _))
| (FullHouse (c, _), FullHouse (c2, _))
| (Flush (c,_, _ ,_ ,_), Flush (c2,_, _ ,_ ,_)) | (Flush (_,c, _ ,_ ,_), Flush (_,c2, _ ,_ ,_))
| (Flush (_,_,c,_,_), Flush (_,_,c2,_,_)) | (Flush (_,_, _ ,c ,_), Flush (_,_, _ ,c2,_))
| (Trips (c,_), Trips (c2, _)) | (Trips (_,(c,_)), Trips(_,(c2,_)))
| (TwoPair (c, _, _), TwoPair (c2, _ , _)) | (TwoPair (_, c, _), TwoPair (_, c2 , _))
| (Pair (c, _), Pair (c2, _)) | (Pair (_, (c, _, _)), Pair (_, (c2, _, _)))
| (Pair (_, (_, c, _)), Pair (_, (_, c2, _)))
| (HighCard (c, _, _, _, _), HighCard (c2, _, _, _, _)) | (HighCard (_, c, _, _, _), HighCard (_, c2, _, _, _))
| (HighCard (_, _, c, _, _), HighCard (_, _, c2, _, _)) | (HighCard (_, _, _, c, _), HighCard (_, _, _, c2, _))
when compareRanks c c2 0
-> Some (compareRanks c c2)
| (StraightFlush c, StraightFlush c2)
| (Straight c, Straight c2)
| (Quads (_, c), Quads (_, c2))
| (FullHouse (_, c), FullHouse (_, c2))
| (Flush (_,_, _ ,_ ,c), Flush (_,_, _ ,_ ,c2))
| (Trips (_,(_,c)), Trips(_,(_,c2)))
| (TwoPair (_, _, c), TwoPair (_, _, c2))
| (Pair (_, (_, _, c)), Pair (_, (_, _, c2)))
| (HighCard (_, _, _, _, c), HighCard (_, _, _, _, c2))
-> Some (compareRanks c c2)
| _ -> None
I will admit, it’s got a weighty match expression, but match expressions can be broken down by their guard clauses, so altogether, it can be reasoned about as:
match hand1, hand2 with
| when the handRanks are different, return the bigger one.
| when the card ranks are different in the relevant order for the hand type in question, return the bigger one.
| when one relevant card rank remains, return the comparison between that last card rank.
| when passed anything else, return None.
Take comparing two Two Pair hands.
TwoPair (Rank.King, Rank.Four, Rank.Eight) TwoPair (Rank.King, Rank.Six, Rank.Seven)
The first relevant rank here compares as 0 (King vs King), but the second relevant rank is non-zero (4 vs 6) so the second hand wins.
Finally, creating PokerHand instances requires 5 distinct cards.
let getHand card1 card2 card3 card4 card5 =
let ranks = [card1.Rank
card2.Rank
card3.Rank
card4.Rank
card5.Rank] |>
List.groupBy id |>
List.sortByDescending (fun (m,n) -> (List.length n) * 100 + (int) m);
match List.length ranks with
| 4 -> // pair
let card = Pair (fst ranks.Head, (fst ranks.[1], fst ranks.[2], fst ranks.[3]))
Some card
| 2 -> // quads or fullhouse
if(List.length (snd ranks.Head) = 4) then
let card = Quads (fst ranks.Head, fst ranks.[1])
Some card
else
let card = FullHouse (fst ranks.Head, fst ranks.[1])
Some card
| 3 -> // trips or twopair
if(List.length (snd ranks.Head) = 3) then
let card = Trips (fst ranks.Head, (fst ranks.[1], fst ranks.[2]))
Some card
else
let card = TwoPair (fst ranks.Head, fst ranks.[1], fst ranks.[2])
Some card
| 5 -> // a flush or straight flush
let r = [card1.Rank; card2.Rank; card3.Rank; card4.Rank; card5.Rank]
|> List.sortByDescending id
let suits = [card1.Suit
card2.Suit
card3.Suit
card4.Suit
card5.Suit] |>
List.distinct
match (List.length suits, r) with
| (1, Rank.Ace::Rank.Five::_) -> Some (StraightFlush Rank.Five)
| (1, x::xs) when x - (List.last xs) = Rank.Four -> Some (StraightFlush x)
| (1, _) -> Some (Flush (r.[0], r.[1], r.[2], r.[3], r.[4]))
| (_, Rank.Ace::Rank.Five::_) -> Some (Straight Rank.Five)
| (_, x::xs) when x - (List.last xs) = Rank.Four -> Some (Straight x)
| _ -> Some (HighCard (r.[0], r.[1], r.[2], r.[3], r.[4]))
| _ ->
None
This method works fairly simply. We take the ranks of the incoming cards, group the like ranks together, then sorting by the rank count (times 100) plus the rank value. (Hence, 2 Kings, and 2 sixes and a 4 will end up as 213, 206, and 4, respectively.)
Then, by matching against the number of a distinct ranks, we can create simple logic to determine the hand type. When 5 cards have 4 distinct ranks, the hand must be a pair, so we simply set the values for the PokerHand instance accordingly. When there are 2 distinct ranks, the hand must be either a FullHouse (3 of one rank, 2 of the other), or Quads (4 of one rank, 1 of the other.) Trips and TwoPair will both have 3 distinct ranks. If there are 5 distinct ranks, we need to check for a bit more. In the case of 5 distinct ranks, we need to sort them in order, and get a count of distinct suits. If there is 1 suit, then we’re dealing with a Flush or a StraightFlush. Straights are 5 cards in a row (rank order), OR Ace, Two, Three, Four, Five. If we have more than one suit, we are dealing with a HighCard hand (the most common hand), or a Straight. If we get any other number of distinct ranks, we have an invalid set of arguments, so we return the option value None.
The last function will give us a random hand to play with.
let getRandomHand() =
let r = System.Random();
let rec makeHand length list =
let m = r.Next(0, 52)
if (List.contains m list) then
makeHand length list
else
let newList = m::list
if (List.length newList = length) then
newList
else
makeHand length newList
let idx = makeHand 5 []
getHand deck.[idx.[0]] deck.[idx.[1]] deck.[idx.[2]] deck.[idx.[3]] deck.[idx.[4]]
It’s getting late. Time to head to the card room, but I encourage you to try this out in FSI, and think about how discriminated unions could make your OWN business modeling a little easier. See ya!
Christopher Brown's - Blog 