2
\$\begingroup\$

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

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 
                        row) [cds |> List.head]

  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 "")

  Console.ReadLine() |> ignore
  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.

\$\endgroup\$
4
\$\begingroup\$

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?

\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – Henrik Hansen Oct 10 '16 at 15:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.