Rummy.fs

namespace Game

open System
open System.Diagnostics

module Cards =
    type Suit = Clubs | Diamonds | Hearts | Spades
        with
            override x.ToString() =
                match x with
                | Clubs -> "♣"
                | Diamonds -> "♦"
                | Hearts -> "♥"
                | Spades -> "♠"

    type Rank = Ace | King | Queen | Jack | Number of int
        with 
            override x.ToString() = 
                match x with
                | Ace -> "A"
                | King -> "K"
                | Queen -> "Q"
                | Jack -> "J"
                | Number i -> string i

    [<DebuggerDisplay("{AsString}")>]
    [<StructuredFormatDisplay("{AsString}")>]
    type Card = { Suit : Suit; Rank : Rank }
        with
            member x.AsString = sprintf "%s%s" (x.Suit.ToString()) (x.Rank.ToString())

    let private rnd = 
        let r = new Random()
        (fun max -> r.Next(max))

    let private swap (arr : 'a array) x y =
        let v = arr.[x]
        arr.[x] <- arr.[y]
        arr.[y] <- v     

    let private shuffle deck =
        let arr = List.toArray deck
        for i = arr.Length downto 2 do
            swap arr (rnd i) (i - 1)

        Array.toList arr

    let deck = 
        [ for s in [Clubs; Diamonds; Hearts; Spades] do
              yield { Suit = s; Rank = Ace}
              for i in 2..10 do
                  yield { Suit = s; Rank = Number i }
              for r in [King; Queen; Jack] do
                  yield { Suit = s; Rank = r }  ]

    let shuffledDeck () = shuffle deck

module Rummy =
    open Cards

    type Status = NotStarted | Playing | Victory | Defeat 

    type RummyGame = 
        { Deck : Card list; 
          PlayerHand : Card list;
          DiscardedCards : Card list;
          Status : Status }

    let private handSize = 7
    
    let private start game =

        let deck = game.Deck |> Seq.skip handSize |> Seq.toList

        let playerHand = game.Deck |> Seq.take handSize |> Seq.toList

        { Deck = deck; PlayerHand = playerHand; DiscardedCards = []; Status = Playing }

    let private deal (cards : 'a list) =
        match cards with
        | h :: t -> (h, t)
        | [] -> failwith "cannot deal an empty deck"

    let private toSets x = 
        x
        |> Seq.groupBy (fun x -> x.Rank) 
        |> Seq.map (fun (rank, cards) -> (rank, Seq.toList cards))
        |> Seq.toList

    let private score setCards discardedCards deckSize  =
        let deckCards = 4 - setCards - discardedCards
        match setCards, deckCards with
        | 4, _ -> 1.0 // Got a full set, highest score.
        | _, 0 -> 0.0 // No cards on the deck, can't get a 4 card set.
        | _ ->
            // Calculates the probability of dealing in sequence,
            // all the necessary cards for a full 4 card set.
            let f p x =
                let c = float (deckCards - x)
                let d = float (deckSize - x)
                p * (c / d)

            [0 .. 3 - setCards]
            |> List.fold f 1.0

    let private countCards key (m : Map<_, 'a list>) =
        match Map.tryFind key m with
        | Some x -> List.length x
        | None -> 0

    let private wins (set : (Rank * Card list) list) =
        match set.Length with
        | 2 -> 
            // If we have only two sets and the number of cards
            // amounts to handSize, it means we won.
            let cards = set |> Seq.sumBy (fun (_, c) -> c.Length) 
            cards = handSize
        | _ -> false

    let private playRound game =
        let card, deck = deal game.Deck
        let playerHand = card :: game.PlayerHand        
        let deckSize = deck |> List.length

        let discardCardsSet = Map (game.DiscardedCards |> toSets)

        // Gets a list of sets ordered by score ascending.
        // The smaller the score, the worst is the set.
        let playerHandSets = 
            playerHand 
            |> toSets
            |> Seq.sortBy (fun (r,c) -> 
                let setCards = c.Length
                let discardedCards = countCards r discardCardsSet
                score setCards discardedCards deckSize)
            |> Seq.toList

        // Picks the first card of the worst set to be discarded.
        let discardCard = 
            playerHandSets |> List.head |> snd |> List.head

        let newPlayerHand = 
            playerHand 
            |> List.choose (fun x -> if x <> discardCard then Some x else None)

        let goodSets = List.tail playerHandSets

        { Deck = deck; 
          PlayerHand = newPlayerHand;
          DiscardedCards = discardCard :: game.DiscardedCards;
          Status = match goodSets |> wins, deck with
                   | true, _ -> Victory
                   | false, [] -> Defeat
                   | _ -> Playing }

    let play game =
        match game.Status with
        | NotStarted -> start game
        | Playing -> playRound game
        | _ -> game

    let rec playToEnd game =
        seq { match game.Status with
              | Victory | Defeat -> ()
              | _ -> 
                  let g = play game 
                  yield g
                  yield! playToEnd g }
    
    let create () =
        { Deck = shuffledDeck(); PlayerHand = []; DiscardedCards = []; Status = NotStarted }

module Program = 
    open System
    
    [<EntryPoint>]
    let main argv = 
        let game = Rummy.create()
        seq { yield game 
              yield! Rummy.playToEnd game }
        |> Seq.iteri (fun i g ->
            printfn "ROUND %i:" i
            printfn "%A\n" g
            Console.ReadLine() |> ignore)

        0