Poker(http://nenono.hatenablog.com/entry/2014/12/08/000000 を勝手に添削)

01.List.fs

module Poker.List

let trySplitAt count list =
  let rec loop i acc tail =
    if i = count then Some ((List.rev acc), tail)
    else match tail with
         | [] -> None
         | h::t -> loop (i + 1) (h::acc) t
  loop 0 [] list

let difference xs ys =
  let ys = Set.ofList ys
  xs |> List.filter (ys.Contains >> not)

let permutation xs =
  let rec loop xs current acc =
    match xs with
    | [] -> current::acc
    | xs -> List.foldBack (fun x state -> loop (difference xs [x]) (x::current) state) xs acc
  loop xs [] []
  |> List.map List.rev

let tryMax = function
| [] -> None
| xs -> List.max xs |> Some

02.Card.fs

module Poker.Card

type Suit = Spade | Heart | Diamond | Club

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Suit =
  let values = [Spade; Heart; Diamond; Club]

type Number = private {
  Value: int
}
with
  static member Min = 1
  static member Max = 13
  override this.ToString() = string this.Value
  static member (++) (l: Number, r: int) =
    let rec loop value =
      if value > Number.Max then loop (value - Number.Max + Number.Min - 1)
      else value
    let l = l.Value
    let value = l + r
    { Value = loop value }

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Number =
  let min = Number.Min
  let max = Number.Max

  let value x = x.Value
  let create x =
    if not (min <= x && x <= max) then
      failwith "The Number is required 1 to 13."
    { Value = x }

type NormalCard = {
  Number: Number
  Suit: Suit
}
with
  override this.ToString() = sprintf "%A%d" this.Suit (this.Number |> Number.value)

03.Deck.fs

module Poker.Deck

let deckWithoutJoker =
  List.ofSeq (seq {
    for num in Card.Number.min .. Card.Number.max do
    for suit in Card.Suit.values ->
      { Card.Number = Card.Number.create num; Card.Suit = suit }
  })

let shuffle deck =
  deck |> Seq.sortBy (fun _ -> System.Guid.NewGuid())

type PickResult = { Picked: Card.NormalCard list; Deck: Card.NormalCard list }

let tryPick count deck =
  List.trySplitAt count deck
  |> Option.map (fun (head, tail) -> { Picked = head; Deck = tail })

04.Hand.fs

namespace Poker

type Hand = Hand of Card.NormalCard list
with
  member private this.String =
    match this with
    | Hand xs ->
        xs
        |> List.map string
        |> String.concat " / "
  override this.ToString () = this.String
  member this.ToString indexes =
    match this with
    | Hand xs ->
        (xs, indexes)
        ||> List.map2 (fun x y -> sprintf "[%s]:%s" y (string x))
        |> String.concat "/"

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Hand =
  let count = 5

  let tryCreateBy deck =
    Deck.tryPick count deck
    |> Option.map (fun { Deck.Picked = picked; Deck.Deck = d } -> ((Hand picked), d))

  let change (Hand xs) deck changeCards =
    Deck.tryPick (Set.count changeCards) deck
    |> Option.map (fun { Deck.Picked = picked; Deck.Deck = d } ->
        let hand = xs |> List.filter (changeCards.Contains >> not)
        Hand (List.append picked hand), d
    )

05.Rank.fs

namespace Poker

type Rank =
  | OnePair | TwoPair | ThreeCards | Straight
  | Flush | FullHouse | FourCards | StraightFlush | RoyalStraightFlush

06.Evaluation.fs

module Poker.Evaluation

type private Cards = Card.NormalCard list

let onePair (cards: Cards) =
  cards.[0].Number = cards.[1].Number

let threeCards (cards: Cards) =
  (onePair cards)
    && cards.[1].Number = cards.[2].Number

let fourCards (cards: Cards) =
  (threeCards cards)
    && cards.[2].Number = cards.[3].Number

let twoPair (cards: Cards) =
  (onePair cards)
    && cards.[1].Number <> cards.[2].Number
    && cards.[2].Number = cards.[3].Number

let fullHouse (cards: Cards) =
  (threeCards cards)
    && cards.[2].Number <> cards.[3].Number
    && cards.[3].Number = cards.[4].Number

let straight (cards: Cards) =
  cards
  |> Seq.pairwise
  |> Seq.forall (fun (x, y) -> x.Number ++ 1 = y.Number)

let flush (cards: Cards) =
  cards
  |> Seq.pairwise
  |> Seq.forall (fun (x, y) -> x.Suit = y.Suit)

let straightFlush (cards: Cards) =
  (straight cards) && (flush cards)

let royalStraightFlush (cards: Cards) =
  (straightFlush cards) && (
    let royal = [10..13]@[1]
    (cards |> List.map (fun x -> x.Number |> Card.Number.value)) = royal
  )

let map =
  Map.ofList [
    (OnePair, onePair); (ThreeCards, threeCards); (FourCards, fourCards)
    (TwoPair, twoPair); (FullHouse, fullHouse); (Straight, straight)
    (Flush, flush); (StraightFlush, straightFlush); (RoyalStraightFlush, royalStraightFlush)
  ]

let evaluations =
  map
  |> Map.toList
  |> List.map (fun (key, f) xs -> if f xs then Some key else None)

07.Evaluator.fs

module Poker.Evaluator

let perms = List.permutation [0..(Hand.count - 1)]

let evaluate' evals (Hand cards) =
  let handPerms =
    perms
    |> List.map (List.map (fun i -> cards.[i]))

  handPerms
  |> List.map (fun x ->
      evals
      |> List.map (fun f -> f x)
      |> List.choose id
  )

let evaluate hand =
  evaluate' Evaluation.evaluations hand
  |> List.map List.tryMax
  |> List.choose id
  |> List.tryMax

08.Program.fs

open Poker

let inputChoices = ['a'..'e'] |> List.map string
let inputExit = Set.ofList ["exit"; "quit"]
let inputChoicesSet = Set.ofList inputChoices

let rec loop (hand: Hand) deck =
  printfn "-----------------"
  printfn "your hand: %s" (hand.ToString inputChoices)
  printfn "input change cards"

  let input = System.Console.ReadLine ()
  if inputExit.Contains input then
    printfn "exit game"
  else
    let input =
      Set.ofSeq (
        input
        |> Seq.map string
        |> Seq.distinct)
    if input |> Set.forall inputChoicesSet.Contains |> not then
      printfn "invalid input"
      loop hand deck
    let changes =
      Set.ofList (
        inputChoices
        |> List.mapi (fun i x -> (i, x))
        |> List.filter (fun (_, x) -> input.Contains x)
        |> List.map fst
        |> List.map (fun i ->
            let (Hand hand) = hand
            hand.[i]
        )
      )
    match Hand.change hand deck changes with
    | None -> printfn "deck is empty. game end."
    | Some (hand, deck) ->
        printfn "your hand: %s" (string hand)
        let rank = Evaluator.evaluate hand
        printfn "rank: %A" rank
        loop hand deck

[<EntryPoint>]
let main argv = 
  let deck = Deck.deckWithoutJoker |> Deck.shuffle |> Seq.toList
  let hand, deck = Hand.tryCreateBy deck |> Option.get
  loop hand deck
  0

Number.create 関数内、 value ではなく x が正しいように見えます(そうしないと value 関数が使用されてコンパイルできない)

ほんとうだw
直します。