Poker.fs

open System
open Microsoft.FSharp.Reflection
type Suit = | Clubs | Spades | Hearts | Diamonds
type Rank =
    | Two | Three | Four | Five
    | Six | Seven | Eight | Nine | Ten
    | Jack | Queen | King | Ace
type Card = { rank: Rank  // Rank field must come before suit so that card comparison is correct
              suit: Suit }

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Rank =
    let toAbbrMapping =
        Map.ofList [Two, '2'; Three, '3'; Four, '4'; Five, '5'; Six, '6'; Seven, '7'; Eight, '8';
                    Nine, '9'; Ten, 'T'; Jack, 'J'; Queen, 'Q'; King, 'K'; Ace, 'A']
    let fromAbbrMapping = toAbbrMapping |> Map.toList |> List.map (fun (k, v) -> v, k) |> Map.ofList
    let toAbbr rank = toAbbrMapping.[rank]
    let fromAbbr abbr = fromAbbrMapping.[abbr]

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Suit =
    let toAbbrMapping = Map.ofList [Clubs, 'C'; Spades, 'S'; Hearts, 'H'; Diamonds, 'D']
    let fromAbbrMapping = toAbbrMapping |> Map.toList |> List.map (fun (k, v) -> v, k) |> Map.ofList
    let toAbbr suit = toAbbrMapping.[suit]
    let fromAbbr abbr = fromAbbrMapping.[abbr]

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Card =
    let rank card = card.rank
    let suit card = card.suit
    let standardDeck =
        [for suit in FSharpType.GetUnionCases typeof<Suit> do
            for rank in FSharpType.GetUnionCases typeof<Rank> do
                yield { suit = downcast FSharpValue.MakeUnion (suit, [||])
                        rank = downcast FSharpValue.MakeUnion (rank, [||]) } ]

/// Attempts to find the next higher rank above the input, unless it is an Ace, in which case the function returns None
let tryIncRank = function
    | Two -> Some Three | Three -> Some Four | Four -> Some Five | Five -> Some Six
    | Six -> Some Seven | Seven -> Some Eight | Eight -> Some Nine | Nine -> Some Ten | Ten -> Some Jack
    | Jack -> Some Queen | Queen -> Some King | King -> Some Ace | Ace -> None

/// Attempts to find the next lower rank below the input, unless it is a Two, in which case the function returns None
let tryDecRank = function
    | Two -> None | Three -> Some Two | Four -> Some Three | Five -> Some Four
    | Six -> Some Five | Seven -> Some Six | Eight -> Some Seven | Nine -> Some Eight | Ten -> Some Nine
    | Jack -> Some Ten | Queen -> Some Jack | King -> Some Queen | Ace -> Some King

let rec compareRankedLists ranks1 ranks2 =
    match ranks1, ranks2 with
    | [], [] -> 0
    | x::xs, y::ys ->
        if x > y then 1
        elif x < y then -1
        else compareRankedLists xs ys
    | _ -> raise (new ArgumentException("The lists had different lengths."))

type HandKind =
    | HighCard of Rank list
    | OnePair of pairRank: Rank * remainder: Rank list
    | TwoPair of pair1Rank: Rank * pair2Rank: Rank * remainder: Rank list
    | ThreeOfAKind of Rank
    | Straight of highest: Rank      // 5 consecutive cards of any suit
    | Flush of Rank list             // 5 cards of the same suit
    | FullHouse of tripleRank: Rank  // The rank of the pair in the full house is never relevant
    | FourOfAKind of foursRank: Rank * remainder: Rank
    | StraightFlush of Rank

/// Groups cards by rank.
let groupRanks cards = cards |> List.groupBy (fun { rank = rank } -> rank) |> List.map snd
/// Identifies a straight by its highest card, returining None if there was no straight. Assumes the input hand is 5 cards.
let tryFindStraight cards =
    let cards = List.sortDescending cards
    List.fold (fun lastRank card ->
        lastRank |> Option.bind (fun lastRank -> tryDecRank lastRank |> Option.bind (fun expectedRank ->
            if card.rank = expectedRank then Some(card.rank) else None)))
        (Some((List.head cards).rank)) (List.tail cards)
/// Identifies a flush by all of its cards, returning None if there is no flush present. Assumes the input hand is 5 cards.
let tryFindFlush cards =
    // In other words, count up the different suits and see if this list only contains one suit
    if ((List.countBy (fun card -> card.suit) cards).Length = 1)
    then Some (List.map (fun card -> card.rank) cards |> List.sort)
    else None

/// Returns the strongest poker hand ranking present in the given set of cards.
let determineStrongestHand cards =
    if List.length cards <> 5 then invalidArg "Number of cards was not 5." "cards"
    else
        match tryFindFlush cards with
        | Some(flushRanks) ->
            match tryFindStraight cards with
            | Some(highestRank) -> StraightFlush highestRank
            | None -> Flush (List.sortDescending flushRanks)
        | None ->
            match tryFindStraight cards with
            | Some(highestRank) -> Straight highestRank
            | None ->
                // Sort the cards into two groups: one group of cards that have others of the same rank, and the rest (the singular, "lonely" cards)
                let lonelyRanks, pairsOrHigherRanks = groupRanks cards |> List.map (List.map Card.rank) |> List.partition (fun rs -> rs.Length = 1)
                let lonelyRanks = lonelyRanks |> List.concat |> List.sortDescending

                if pairsOrHigherRanks.Length = 0 then
                    HighCard (cards |> List.map Card.rank |> List.sortDescending)
                else
                    let maxGroup = List.maxBy List.length pairsOrHigherRanks
                    // We can put four-of-a-kinds down here because you can't have a straight at the same time anyway
                    match pairsOrHigherRanks.Length, maxGroup.Length with
                    | _, 4 -> FourOfAKind(maxGroup.[0], lonelyRanks.[0])
                    | 2, 3 -> FullHouse maxGroup.[0]
                    | _, 3 -> ThreeOfAKind maxGroup.[0]
                    | 2, _ -> TwoPair(pairsOrHigherRanks.[0].[0], pairsOrHigherRanks.[1].[0], lonelyRanks)
                    | 1, _ -> OnePair (pairsOrHigherRanks.[0].[0], lonelyRanks)
                    | _, _ -> HighCard (cards |> List.map Card.rank |> List.sortDescending)

let cards = List.map (fun (rank, suit) -> { rank = rank; suit = suit })

#nowarn "25"
let parseCards (str: string) =
    str.Split [|' '|] |> List.ofArray |> List.map (Seq.toList >> (fun (rank::suit::[]) ->
        let rank =
            match rank with
            | '2' -> Two | '3' -> Three | '4' -> Four | '5' -> Five
            | '6' -> Six | '7' -> Seven | '8' -> Eight | '9' -> Nine | 'T' -> Ten
            | 'J' -> Jack | 'K' -> King | 'Q' -> Queen | 'A' -> Ace
        let suit = match suit with | 'C' -> Clubs | 'S' -> Spades | 'H' -> Hearts | 'D' -> Diamonds
        rank, suit ))
        |> cards