project-euler/54.fs

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