# F# Active Pattern with Poker and Playing Cards

From this question and John Palmers answer about active pattern I discovered a gap in my knowledge about F# and took the challenge to code me into some level of understanding this technique.

The result is as follows:

module PokerCards
open System

type Suites =
| Clubs
| Diamonds
| Hearts

type Valeurs = // Is this a valid english word for this?
| Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten
| Jack
| Queen
| King
| Ace // Ace is at last because it is always the highest value in poker?

type Card =
{
Suite : Suites;
Valeur : Valeurs
}
with
override this.ToString() = sprintf "%A of %A" (this.Valeur) (this.Suite)

let isSuccesive c1 c2 =
match c1, c2 with // Is there a smarter way to do this?
| Ace, Two
| Two, Three
| Three, Four
| Four, Five
| Five, Six
| Six, Seven
| Seven, Eight
| Eight, Nine
| Nine, Ten
| Ten, Jack
| Jack, Queen
| Queen, King
| King, Ace -> true
| _, _ -> false

type HandTypes =
| HighestCard of Card
| Pair of Card list
| TwoPairs of Card list
| ThreeOfAKind of Card list
| Straight of Card list
| Flush of Card list
| FullHouse of Card list
| FourOfAKind of Card list
| StraightFlush of Card list
| RoyalFlush of Card list
with
override this.ToString() = this.GetType().Name.Trim('"', ' ')

let getHandTypeContent handType =  // Is there a better way to do this?
match handType with
| HighestCard(x) -> [x]
| Pair(x) | TwoPairs(x)
| ThreeOfAKind(x) | Straight(x)
| Flush(x) | FullHouse(x)
| FourOfAKind(x) | StraightFlush(x)
| RoyalFlush(x) -> x

// Helper: return cards grouped by valeur and only groups with length greater than or equal to count
let groupsOfValeur cards count =
cards
|> List.groupBy (fun c -> c.Valeur)
|> List.where (fun (valeur, cds) -> cds.Length >= count)
|> List.sortBy (fun (valeur, cds) -> valeur)

// Returns the count highest Suites from a list of cards (with equal valeur)
// ex.: cards Club|Ten, Spades|Ten, Hearts|Ten and count = 2 => Hearts|Ten Spades|Ten
let getHighestSuitesOfValeur cards count =
cards |> List.sortByDescending (fun c -> c.Suite) |> List.take(count)

let getHighestValeurGroup valeurGroups =
valeurGroups |> List.last

let getHighestValeurGroupCards valeurGroups =
getHighestValeurGroup valeurGroups |> snd

// *** Active Pattern Functions START ***
let (| MatchPair | _ |) cards = // Two cards with same valeur
let valeurGroups = groupsOfValeur cards 2

if valeurGroups.Length > 0 then
let pairCards = getHighestSuitesOfValeur (getHighestValeurGroupCards valeurGroups) 2
Some(Pair(pairCards))
else
None

let (| MatchTwoPairs | _ |) cards = // Two pairs of two different valeurs
let valeurGroups = groupsOfValeur cards 2

if valeurGroups.Length >= 2 then
let firstPairGroup = getHighestValeurGroup valeurGroups
let secondPairGroup = getHighestValeurGroup (valeurGroups |> List.except [firstPairGroup])
Some(TwoPairs(getHighestSuitesOfValeur (firstPairGroup |> snd) 2 @ getHighestSuitesOfValeur (secondPairGroup |> snd) 2))
else
None

let (| MatchThreeOfAKind | _ |) cards = // Three of a kind by valuer
let valeurGroups = groupsOfValeur cards 3

if valeurGroups.Length > 0 then
Some(ThreeOfAKind(getHighestSuitesOfValeur (getHighestValeurGroupCards valeurGroups) 3))
else
None

let (| MatchStraight | _ |) cards =  // five in an row
// A list of cards distinct and ordered by valeur (this may not give the highedst ranked straight sequence (in respect to suite ranking)
let cds = cards |> List.distinctBy (fun card -> card.Valeur) |> List.sortBy (fun card -> card.Valeur)
let straightRow =
cds
|> List.tail
|> List.fold (fun row card -> // Folds to a list of consequtive cards
if isSuccesive (row |> List.head).Valeur card.Valeur then
card :: row
else

if straightRow.Length >= 5 then
Some(Straight(straightRow))
else
None

let (| MatchFlush | _ |) cards = // Five cards in same suite
let result = cards
|> List.groupBy (fun card -> card.Suite)
|> List.tryFind (fun (suite, cds) -> cds.Length >= 5)
if result.IsSome then
Some(Flush(snd result.Value))
else
None

let (| MatchFullHouse | _ |) cards = // Combination of three of a kind and a pair
match cards with
| MatchThreeOfAKind res -> // Checks for three of a kind
let toakCards = getHandTypeContent res
let pairCards = cards |> List.where (fun card -> card.Valeur <> toakCards.[0].Valeur) // with the cards of dirrefent valeur than the toakCards have...
match pairCards with // test for a pair
| MatchPair res -> Some(FullHouse(toakCards @ getHandTypeContent res))
| _ -> None
| _ -> None

let (| MatchFourOfAKind | _ |) cards =
let valeurGroups = groupsOfValeur cards 4

if valeurGroups.Length > 0 then
Some(FourOfAKind(getHighestSuitesOfValeur (getHighestValeurGroupCards valeurGroups) 4))
else
None

let (| MatchStraightFlush | _ |) cards = // As straight (see above) in same Suite
let result =
cards
|> List.groupBy (fun card -> card.Suite)
|> List.map (fun (suite, cds) -> cds)
|> List.where (fun cds -> cds.Length >= 5)
|> List.map (fun cds ->  // There will only be one here?
match cds with
| MatchStraight res -> // Here we know the cards have same suite and tests i those cards is a straight hand
let straightCards = getHandTypeContent res
Some(StraightFlush(straightCards))
| _ -> None)
|> List.where (fun handType -> handType.IsSome)
if result.Length > 0 then
result.[0]
else
None

let (| MatchRoyalFlush | _ |) cards = // Ten, jack, queen, king, ace in same suite
let test = cards |> List.where (fun c -> c.Valeur >= Ten)
let rfGroup = test |> List.groupBy (fun c -> c.Suite) |> List.tryFind (fun grp -> (snd grp) |> List.length >= 5)
if rfGroup.IsSome then
Some(RoyalFlush(snd rfGroup.Value))
else
None
// *** Active Pattern Functions END ***

// Given a list of cards it determines the optimal hand type
let getHandType cards : HandTypes =
match cards with
| MatchRoyalFlush res
| MatchStraightFlush res
| MatchFourOfAKind res
| MatchFullHouse res
| MatchFlush res
| MatchStraight res
| MatchThreeOfAKind res
| MatchTwoPairs res
| MatchPair res -> res
| _ -> HighestCard(cards |> List.sortBy (fun card -> card.Valeur) |> List.last)

// returns some kind of rank which should be much more elaborated IRL
let getRank (handType : HandTypes) =
match handType with
| RoyalFlush(cds) -> 1
| StraightFlush(cds) -> 2
| FourOfAKind(cds) -> 3
| FullHouse(cds) -> 4
| Flush(cds) -> 5
| Straight(cds) -> 6
| ThreeOfAKind(cds) -> 7
| TwoPairs(cds) -> 8
| Pair(cds) -> 9
| HighestCard(cds) -> 10

// A poker hand
type Hand(cards : Card list) =
member this.Cards = cards
member this.HandType = getHandType cards
member this.Rank = getRank(this.HandType)
member this.Print() =
printfn "Type: %A: %s\nRank: %d\nCards: %s" (this.HandType.ToString()) ((String.Join(", ", getHandTypeContent this.HandType))) (this.Rank)  (String.Join(", ", this.Cards))

// Creates a deck of cards ordered by suite and valeur
let createDeck _ =
let suites = [ Clubs; Diamonds; Hearts; Spades ]
let valeurs = [ Two; Three; Four; Five; Six; Seven; Eight; Nine; Ten; Jack; Queen; King; Ace ]
seq {for suite in suites do
for valeur as Valeurs in valeurs do
yield { Suite = suite; Valeur = valeur }} |> Seq.toList

// Creates a number of poker hands return as a list of hands in the first element of a tuple with a list of the remaining cards as its second element
let handFactory numHands =
if numHands > 7 then
raise (System.Exception("handFactory: too many hands (max = 7)"))
let deck = createDeck()
let rand = Random()
// Creates a hand of seven cards and return these as the first element of a tuple containing the remaining cards as the second element
let createHandCards cards =
[for i in 1..7 do yield i]
|> List.mapFold (fun cds n ->
let index = rand.Next(0, cds |> List.length)
let card = cds.[index]
(card, cds |> List.except [card])) cards

// See the comment for the entire function above
[for i in 1..numHands do yield i] |> List.mapFold (fun cds n ->
let handCards, remainingCard = createHandCards cds
let hand = Hand(handCards)
(hand, remainingCard)) deck

[<EntryPoint>]
let main argv =
//  // Random Hands Test
//  let hands, remainingCards = handFactory 7
//  hands
//  |> List.sortBy (fun h -> h.Rank)
//  |> List.iter (fun hand ->
//                  hand.Print()
//                  printfn "")
//
//  printfn ""
//  printfn "Remaining Cards:"
//  remainingCards |> List.iter (printfn "%A")

// Fixed Hands Test
let royalFlushCards = [
{ Suite = Spades; Valeur = Ace };
{ Suite = Spades; Valeur = King };
{ Suite = Clubs; Valeur = Eight };
{ Suite = Diamonds; Valeur = Five}
{ Suite = Spades; Valeur = Queen };
{ Suite = Spades; Valeur = Jack };
{ Suite = Spades; Valeur = Ten };]

let straightFlushCards = [
{ Suite = Clubs; Valeur = Nine };
{ Suite = Clubs; Valeur = King };
{ Suite = Spades; Valeur = Ace };
{ Suite = Clubs; Valeur = Queen };
{ Suite = Clubs; Valeur = Jack };
{ Suite = Clubs; Valeur = Ten };
{ Suite = Diamonds; Valeur = Ten}]

let fourOfAKindCards = [
{ Suite = Spades; Valeur = King };
{ Suite = Hearts; Valeur = King };
{ Suite = Clubs; Valeur = King };
{ Suite = Spades; Valeur = Ace };
{ Suite = Spades; Valeur = Two };
{ Suite = Spades; Valeur = Ten };
{ Suite = Diamonds; Valeur = King }]

let fullHouseCards = [
{ Suite = Spades; Valeur = King };
{ Suite = Hearts; Valeur = King };
{ Suite = Clubs; Valeur = King };
{ Suite = Spades; Valeur = Queen };
{ Suite = Spades; Valeur = Nine };
{ Suite = Spades; Valeur = Ten };
{ Suite = Diamonds; Valeur = Ten}]

let straightCards = [
{ Suite = Hearts; Valeur = Seven };
{ Suite = Clubs; Valeur = Eight };
{ Suite = Spades; Valeur = Ace };
{ Suite = Clubs; Valeur = Nine };
{ Suite = Spades; Valeur = Jack };
{ Suite = Spades; Valeur = Ten };
{ Suite = Diamonds; Valeur = Ten}]

let threeOfAKindCards = [
{ Suite = Hearts; Valeur = Seven };
{ Suite = Clubs; Valeur = Eight };
{ Suite = Spades; Valeur = Ace };
{ Suite = Hearts; Valeur = Eight };
{ Suite = Spades; Valeur = Jack };
{ Suite = Spades; Valeur = Eight };
{ Suite = Diamonds; Valeur = Ten}]

let twoPairsCards = [
{ Suite = Spades; Valeur = King };
{ Suite = Hearts; Valeur = King };
{ Suite = Clubs; Valeur = Six };
{ Suite = Hearts; Valeur = Eight };
{ Suite = Spades; Valeur = Jack };
{ Suite = Spades; Valeur = Eight };
{ Suite = Diamonds; Valeur = Ten}]

let onePairCards = [
{ Suite = Hearts; Valeur = Three };
{ Suite = Clubs; Valeur = Six };
{ Suite = Spades; Valeur = Ace };
{ Suite = Hearts; Valeur = Eight };
{ Suite = Spades; Valeur = Jack };
{ Suite = Spades; Valeur = Eight };
{ Suite = Diamonds; Valeur = Ten}]

let higestCardCards = [
{ Suite = Spades; Valeur = King };
{ Suite = Hearts; Valeur = Three };
{ Suite = Clubs; Valeur = Six };
{ Suite = Spades; Valeur = Ace };
{ Suite = Hearts; Valeur = Five };
{ Suite = Spades; Valeur = Eight };
{ Suite = Diamonds; Valeur = Ten}]

let hands = [ Hand(royalFlushCards); Hand(straightFlushCards); Hand(fourOfAKindCards); Hand(fullHouseCards); Hand(straightCards); Hand(threeOfAKindCards); Hand(twoPairsCards); Hand(onePairCards); Hand(higestCardCards) ]

hands
|> List.iter (fun hand ->
hand.Print()
printfn "")

0


I'll be glad for any feedback on functional programming, active pattern and F#. I'm only slightly interested in the poker game it self, so don't bother unless it can add something to the understanding of the code.

I'm not going to look through all of the code, since there's a lot of it.

Normally, the symbols on cards are called suits (they aren't hotel rooms):

type Suit = Diamonds | Hearts | Clubs | Spades


Likewise, the values are called faces:

type Face =
|  Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten
| Jack | Queen | King | Ace


Clearly, then, a card is a combination (a product type, in fact):

type Card = { Face: Face; Suit : Suit }


What I often do then is to define a list of all suits, and all faces, because that also enables me to define a full deck of cards:

let allSuits = [Diamonds; Hearts; Clubs; Spades]

let allFaces = [
Two; Three; Four; Five; Six; Seven; Eight; Nine; Ten;
Jack; Queen; King; Ace]

let fullDeck = [
for suit in allSuits do
for face in allFaces do
yield { Face = face; Suit = suit } ]


This makes it fairly easy to define isSuccesive:

let isSuccesive x y = allFaces |> List.pairwise |> List.contains (x, y)


I'll be happy to look at other questions as well, but may I suggest trimming the code down and ask them as new, individual posts?

• Thanks for your response. One can stare blindly at a misspelling and not seeing it, thanks. your isSuccesive is very nice. I'll keep in mind to narrow down my questions, but the rules of CR states that it should be working code. – Henrik Hansen Oct 10 '16 at 15:36