Category Archives: Fun Friday

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!