initial commit
This commit is contained in:
@@ -0,0 +1,200 @@
|
||||
module _54
|
||||
|
||||
type Suit =
|
||||
Diamonds | Clubs | Hearts | Spades
|
||||
|
||||
type Card =
|
||||
Jack of Suit | Queen of Suit | King of Suit | Ace of Suit | Value of int * Suit
|
||||
|
||||
type Rank =
|
||||
| HighCard of Card
|
||||
| OnePair of List<Card>
|
||||
| TwoPair of List<Card>
|
||||
| ThreeKind of List<Card>
|
||||
| Straight of List<Card>
|
||||
| Flush of List<Card>
|
||||
| FullHouse of List<Card>
|
||||
| StraightFlush of List<Card>
|
||||
| RoyalFlush of List<Card>
|
||||
|
||||
let pokerWinner =
|
||||
|
||||
let cardValue = function
|
||||
| Value(v,_) -> v
|
||||
| Jack(_) -> 11
|
||||
| Queen(_) -> 12
|
||||
| King(_) -> 13
|
||||
| Ace(_) -> 14
|
||||
|
||||
let cardSuit = function Value(_,s) | Jack(s) | Queen(s) | King(s) | Ace(s) -> s
|
||||
|
||||
let values cards =
|
||||
cards
|
||||
|> Seq.groupBy cardValue
|
||||
|
||||
let isFlush cards =
|
||||
cards |> Seq.groupBy cardSuit |> Seq.length = 1
|
||||
|
||||
let isStraight cards =
|
||||
cards |> Seq.map cardValue |> Seq.distinct |> Seq.toArray
|
||||
|> (fun vs -> Array.length vs = 5 && Array.max vs - Array.min vs = 4)
|
||||
|
||||
let isStraightFlush cards =
|
||||
isStraight cards && isFlush cards
|
||||
|
||||
let highCard cards =
|
||||
cards |> Seq.sortBy cardValue |> Seq.toList |> List.rev |> Seq.nth 0
|
||||
|
||||
let isRoyalFlush cards =
|
||||
let hasAce cards =
|
||||
cards |> Seq.exists (function | Ace(_) -> true | _ -> false)
|
||||
isStraightFlush cards && hasAce cards
|
||||
|
||||
let multiples cards =
|
||||
cards
|
||||
|> Seq.groupBy cardValue |> Seq.map snd
|
||||
|> Seq.sortBy Seq.length |> Seq.toList |> List.rev
|
||||
//|> Seq.filter (Seq.length >> ((<) 1))
|
||||
|
||||
let rankCards cards =
|
||||
let multiplesLength cards =
|
||||
multiples cards
|
||||
|> List.map Seq.length
|
||||
|> List.filter ((<) 1)
|
||||
let flattenMultiples =
|
||||
multiples cards
|
||||
|> Seq.collect (fun c -> c)
|
||||
|> Seq.toList
|
||||
match cards, multiplesLength cards with
|
||||
| c,_ when isRoyalFlush c -> RoyalFlush cards
|
||||
| c,_ when isStraightFlush c -> StraightFlush cards
|
||||
| _,[3;2] -> FullHouse cards
|
||||
| c,_ when isFlush c -> Flush cards
|
||||
| c,_ when isStraight c -> Straight cards
|
||||
| _,[3] -> ThreeKind flattenMultiples
|
||||
| _,[2;2] -> TwoPair flattenMultiples
|
||||
| _,[2] -> OnePair flattenMultiples
|
||||
| _,_ -> HighCard (highCard cards)
|
||||
|
||||
let rankTwoHands (c1,c2) =
|
||||
(rankCards c1, rankCards c2)
|
||||
|
||||
let compareRanks (r1, r2) =
|
||||
let highCardValue = highCard >> cardValue
|
||||
let compareHighCard (c1,c2) =
|
||||
compare (highCardValue c1) (highCardValue c2)
|
||||
let compareMultiples (c1,c2) =
|
||||
let rec cm (m1, m2) =
|
||||
match m1, m2 with
|
||||
| [],[] -> 0
|
||||
| h1::_, h2::_ when Seq.length h1 <> Seq.length h2 -> compare (Seq.length h1) (Seq.length h2)
|
||||
| h1::_, h2::_ when compareHighCard (h1, h2) <> 0 -> compareHighCard (h1, h2)
|
||||
| _::t1, _::t2 -> cm(t1,t2)
|
||||
| _,_ -> failwith "huh"
|
||||
cm (multiples c1, multiples c2)
|
||||
|
||||
let r1win, r2win = compare 1 0, compare 0 1
|
||||
match r1, r2 with
|
||||
| RoyalFlush(_), RoyalFlush(_) -> 0
|
||||
| StraightFlush(c1), StraightFlush(c2)
|
||||
| Flush(c1), Flush(c2)
|
||||
| Straight(c1), Straight(c2)
|
||||
-> compareHighCard (c1,c2)
|
||||
| FullHouse(c1), FullHouse(c2)
|
||||
| TwoPair(c1), TwoPair(c2)
|
||||
| OnePair(c1), OnePair(c2)
|
||||
| ThreeKind(c1), ThreeKind(c2)
|
||||
-> compareMultiples (c1,c2)
|
||||
| RoyalFlush(_), _ -> r1win
|
||||
| _, RoyalFlush(_) -> r2win
|
||||
| StraightFlush(_), _ -> r1win
|
||||
| _, StraightFlush(_) -> r2win
|
||||
| FullHouse(_), _ -> r1win
|
||||
| _, FullHouse(_) -> r2win
|
||||
| Flush(_), _ -> r1win
|
||||
| _, Flush(_) -> r2win
|
||||
| Straight(_), _ -> r1win
|
||||
| _, Straight(_) -> r2win
|
||||
| ThreeKind(_), _ -> r1win
|
||||
| _, ThreeKind(_) -> r2win
|
||||
| TwoPair(_), _ -> r1win
|
||||
| _, TwoPair(_) -> r2win
|
||||
| OnePair(_), _ -> r1win
|
||||
| _, OnePair(_) -> r2win
|
||||
| HighCard(c1), HighCard(c2) -> compare (cardValue c1) (cardValue c2)
|
||||
|
||||
let parseCard s =
|
||||
let parseSuit = function
|
||||
| 'H' -> Hearts
|
||||
| 'D' -> Diamonds
|
||||
| 'C' -> Clubs
|
||||
| 'S' -> Spades
|
||||
| _ -> failwith "unknown suit"
|
||||
|
||||
if String.length s <> 2 then failwith "wrong length"
|
||||
|
||||
let charVal (c:char) = int c - 48
|
||||
let validVal v = v >= 2 && v <= 9
|
||||
|
||||
let suit = parseSuit s.[1]
|
||||
|
||||
match s.[0] with
|
||||
| v when (charVal >> validVal) v -> Value(charVal v, suit)
|
||||
| 'T' -> Value(10, suit)
|
||||
| 'J' -> Jack(suit)
|
||||
| 'Q' -> Queen(suit)
|
||||
| 'K' -> King(suit)
|
||||
| 'A' -> Ace(suit)
|
||||
| _ -> failwith ("unknownCard " + s)
|
||||
|
||||
let parseCards (s:string) =
|
||||
s.Split(' ') |> Array.map parseCard
|
||||
|
||||
let parseTwoHands s =
|
||||
let c = parseCards s
|
||||
(c.[..4] |> List.ofArray, c.[5..] |> List.ofArray)
|
||||
|
||||
|
||||
// ["5H 5C 6S 7S KD 2C 3S 8S 8D TD";
|
||||
// "5D 8C 9S JS AC 2C 5C 7D 8S QH";
|
||||
// "2D 9C AS AH AC 3D 6D 7D TD QD";
|
||||
// "4D 6S 9H QH QC 3D 6D 7H QD QS";
|
||||
// "2H 2D 4C 4D 4S 3C 3D 3S 9S 9D"
|
||||
// ]
|
||||
System.IO.File.ReadAllLines(@"54_poker.txt")
|
||||
|> Seq.map (parseTwoHands >> rankTwoHands >> compareRanks) |> Array.ofSeq
|
||||
|> Seq.filter ((<) 0)
|
||||
|> Seq.length
|
||||
//
|
||||
// ["KD QD JD TD AD"; // royal flush
|
||||
// "2D 6D 3D 4D 5D"; // straight flush
|
||||
// "8D TD QD JD 7D"; // flush
|
||||
// "3D 3S 3H 5D 5H"; // full house
|
||||
// "KS QD JD TD AD"; // straight
|
||||
// "3D 3S 3H 5D 6H"; // 3 kind
|
||||
// "3D 3S 4H 5D 5H"; // 2 pair
|
||||
// "3D 3S 4H 5D 6H"; // 1 pair
|
||||
// "KD 3S 4H 5D 6H"; // 1 pair
|
||||
// ]
|
||||
// |> Seq.map (parseCards >> Array.toList >> rankCards)
|
||||
// |> common.crossSelfMapList
|
||||
// |> Seq.map (
|
||||
// fun (r1, r2) ->
|
||||
// let cr = compareRanks (r1, r2)
|
||||
// sprintf "%A %i %A" r1 cr r2
|
||||
// )
|
||||
// |> Array.ofSeq
|
||||
|
||||
// |> Seq.map (
|
||||
// fun c ->
|
||||
// let pc = parseCards c
|
||||
// let rf = isRoyalFlush pc
|
||||
// let s = isStraight pc
|
||||
// let f = isFlush pc
|
||||
// let sf = isStraightFlush pc
|
||||
// let hc = sprintf "%A" (highCard pc)
|
||||
// let rank = pc |> List.ofArray |> rankCards
|
||||
// //sprintf "%s RF:%b SF:%b F:%b S:%b HC:%s" c rf sf f s hc
|
||||
// rank
|
||||
// )
|
||||
// |> Seq.toArray
|
||||
Reference in New Issue
Block a user