Skip to content

Instantly share code, notes, and snippets.

@rickythefox

rickythefox/poker.fs

Last active August 6, 2024 10:34
Show Gist options
  • Save rickythefox/887e3265657205bf8f5ea3bd21c5330c to your computer and use it in GitHub Desktop.
Save rickythefox/887e3265657205bf8f5ea3bd21c5330c to your computer and use it in GitHub Desktop.
Download ZIP
F# poker hands ranker exercise
Raw
poker.fs
open System
type Suit =
| Spades
| Clubs
| Diamonds
| Hearts
type Rank = int
type Card =
| Card of Rank * Suit
type Result =
| Win = 0
| Loss = 1
| Tie = 2
type Combination =
| HighCard
| Pair of Rank
| TwoPairs of Rank * Rank
| ThreeOfAKind of Rank
| Straight of Rank
| Flush of Rank
| FullHouse of Rank * Rank
| FourOfAKind of Rank
| StraightFlush of Rank
type Hand = Hand of Card list * Combination
type Game = Game of Card list * Card list * Result
let initGame cards1 cards2 = Game(cards1 |> List.sort, cards2 |> List.sort, Result.Tie)
let declareWinner game =
let (>=>) f1 f2 arg =
let res = f1 arg
match res with
| Game (_, _, Result.Tie) -> f2 res
| _ -> res
let getSuit (Card(_,suit)) = suit
let getRank (Card(rank,_)) = rank
let allOfOtherRank r = List.filter (fun c -> c |> getRank <> r)
let compareTwoCards card1 card2 =
match card1, card2 with
| c1, c2 when c1 > c2 -> Result.Win
| c1, c2 when c1 < c2 -> Result.Loss
| _ -> Result.Tie
let rec compareCardLists list1 list2 =
match list1, list2 with
| h1::t1, h2::t2 ->
match compareTwoCards (getRank h1) (getRank h2) with
| Result.Tie -> compareCardLists t1 t2
| x -> x
| [], [] -> Result.Tie
| _, _ -> failwith "Wrong lengths"
let revAndCompareCardLists list1 list2 = compareCardLists (list1 |> List.rev) (list2 |> List.rev)
let findMultiCards cards =
//let chooser = function
let chooser x =
match x with
| c, _::_::_::_::_ -> FourOfAKind c |> Some
| c, _::_::_::_ -> ThreeOfAKind c |> Some
| c, _::_::_ -> Pair c |> Some
| _ -> None
cards
|> List.groupBy getRank
|> List.choose chooser
let findStraight cards =
let folder (last,res) cur =
let curVal = getRank cur
let lastVal = getRank last
match curVal - lastVal, res with
| 1, true -> (cur, true)
| _ -> (cur, false)
let checkHandForStraight cards = List.tail cards |> List.fold folder (List.head cards, true) |> snd
if checkHandForStraight cards then Straight (cards |> List.last |> getRank) |> Some else None
let findFlush cards =
let highCard = List.last cards
let suit = getSuit highCard
let allSameSuit = List.forall (fun el -> suit = getSuit el) cards
if allSameSuit then Flush(highCard |> getRank) |> Some else None
let findFullHouse cards =
cards |> findMultiCards |> function
| ThreeOfAKind x::Pair y::_ -> Hand ([], FullHouse (x, y))
| Pair y::ThreeOfAKind x::_ -> Hand ([], FullHouse (x, y))
| _ -> Hand(cards, HighCard)
let findNumberCombos cards =
cards |> findMultiCards |> function
| FourOfAKind x::_ -> Hand (cards |> allOfOtherRank x, FourOfAKind x)
| ThreeOfAKind x::_ -> Hand (cards |> allOfOtherRank x, ThreeOfAKind x)
| Pair x::Pair y::_ -> Hand (cards |> allOfOtherRank x |> allOfOtherRank y, TwoPairs (x, y))
| Pair x::_ -> Hand (cards |> allOfOtherRank x, Pair x)
| _ -> Hand(cards, HighCard)
let checkStraightFlush (Game(c1, c2, _)) =
let findStraightFlush cards =
match (findFlush cards, findStraight cards) with
| (Some _, Some (Straight x)) -> StraightFlush x |> Some
| _ -> None
match findStraightFlush c1, findStraightFlush c2 with
| Some (StraightFlush x), Some (StraightFlush y) -> Game(c1, c2, compareTwoCards x y)
| Some _, _ -> Game(c1, c2, Result.Win)
| _, Some _ -> Game(c1, c2, Result.Loss)
| _ -> Game(c1, c2, Result.Tie)
let checkFourOfAKind (Game(c1, c2, _)) =
match findNumberCombos c1, findNumberCombos c2 with
| Hand(r1, (FourOfAKind x)), Hand(r2, (FourOfAKind y)) ->
match compareTwoCards x y with
| Result.Tie -> Game(c1, c2, revAndCompareCardLists r1 r2)
| x -> Game(c1, c2, x)
| Hand(_, FourOfAKind _), _ -> Game(c1, c2, Result.Win)
| _, Hand(_, (FourOfAKind _)) -> Game(c1, c2, Result.Loss)
| _ -> Game(c1, c2, Result.Tie)
let checkFullHouse (Game(c1, c2, _)) =
match findFullHouse c1, findFullHouse c2 with
| Hand(_, (FullHouse (t1, p1))), Hand(_, (FullHouse (t2, p2))) ->
match compareTwoCards t1 t2 with
| Result.Tie -> Game(c1, c2, compareTwoCards p1 p2)
| x -> Game(c1, c2, x)
| Hand(_,(FullHouse _)), _ -> Game(c1, c2, Result.Win)
| _, Hand(_,(FullHouse _)) -> Game(c1, c2, Result.Loss)
| _ -> Game(c1, c2, Result.Tie)
let checkFlush (Game(c1, c2, _)) =
match findFlush c1, findFlush c2 with
| Some (Flush x), Some (Flush y) -> Game(c1, c2, compareTwoCards x y)
| Some _, _ -> Game(c1, c2, Result.Win)
| _, Some _ -> Game(c1, c2, Result.Loss)
| _ -> Game(c1, c2, Result.Tie)
let checkStraight (Game(c1, c2, _)) =
match findStraight c1, findStraight c2 with
| Some (Straight x), Some (Straight y) -> Game(c1, c2, compareTwoCards x y)
| Some _, _ -> Game(c1, c2, Result.Win)
| _, Some _ -> Game(c1, c2, Result.Loss)
| _ -> Game(c1, c2, Result.Tie)
let checkThreeOfAKind (Game(c1, c2, _)) =
match findNumberCombos c1, findNumberCombos c2 with
| Hand(r1, (ThreeOfAKind x)), Hand(r2, (ThreeOfAKind y)) ->
match compareTwoCards x y with
| Result.Tie -> Game(c1, c2, revAndCompareCardLists r1 r2)
| x -> Game(c1, c2, x)
| Hand(_, ThreeOfAKind _), _ -> Game(c1, c2, Result.Win)
| _, Hand(_, (ThreeOfAKind _)) -> Game(c1, c2, Result.Loss)
| _ -> Game(c1, c2, Result.Tie)
let checkTwoPairs (Game(c1, c2, _)) =
match findNumberCombos c1, findNumberCombos c2 with
| Hand(r1, (TwoPairs(x1, x2))), Hand(r2, (TwoPairs(y1, y2))) ->
match compareTwoCards x1 y1 with
| Result.Tie ->
match compareTwoCards x2 y2 with
| Result.Tie -> Game(c1, c2, revAndCompareCardLists r1 r2)
| x -> Game(c1, c2, x)
| x -> Game(c1, c2, x)
| Hand(_, TwoPairs(_)), _ -> Game(c1, c2, Result.Win)
| _, Hand(_, (TwoPairs(_))) -> Game(c1, c2, Result.Loss)
| _ -> Game(c1, c2, Result.Tie)
let checkPair (Game(c1, c2, _)) =
match findNumberCombos c1, findNumberCombos c2 with
| Hand(r1, (Pair x)), Hand(r2, (Pair y)) ->
match compareTwoCards x y with
| Result.Tie -> Game(c1, c2, revAndCompareCardLists r1 r2)
| x -> Game(c1, c2, x)
| Hand(_, Pair _), _ -> Game(c1, c2, Result.Win)
| _, Hand(_, (Pair _)) -> Game(c1, c2, Result.Loss)
| _ -> Game(c1, c2, Result.Tie)
let checkOtherCards (Game(c1, c2, _)) =
match compareCardLists (List.rev c1) (List.rev c2) with
| Result.Tie -> Game(c1, c2, Result.Tie)
| r -> Game(c1, c2, r)
let checkGame =
checkStraightFlush
>=> checkFourOfAKind
>=> checkFullHouse
>=> checkFlush
>=> checkStraight
>=> checkThreeOfAKind
>=> checkTwoPairs
>=> checkPair
>=> checkOtherCards
checkGame game
type Pokerhand (s:String) =
member this.Hand =
let toCard arr =
let suit = function
| 'S' -> Spades
| 'C' -> Clubs
| 'D' -> Diamonds
| 'H' -> Hearts
| _ -> failwith "Bad suit"
let rank = function
| 'A' -> 14
| 'K' -> 13
| 'Q' -> 12
| 'J' -> 11
| 'T' -> 10
| x -> string x |> Int32.Parse
Card( arr |> Array.head |> rank , arr |> Array.last |> suit)
s.Split [|' '|] |> Array.map (fun s -> s.ToCharArray() |> toCard) |> Array.toList
member this.compareWith (other:Pokerhand) =
let game = initGame this.Hand other.Hand
let (Game (_, _, result)) = game |> declareWinner
result
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment