Posts tagged ‘projecteuler’

Poker : Programming Problem

Although it has been a while since Brian posted the poker problem in his blog, I haven’t got the chance to look at it until I came across in ProjectEuler Problem 54. It is not the elegant or best solution at all, but just wanted to join the crew and can confirm it works with the problem’s 1000 games’ dataset.

Hope this helps.

#light
(* Problem 54 *)
type suit = |Spades |Hearts |Clubs |Diamonds 
type card=  |Ace = 14 |Two = 2  |Three =3  |Four = 4 |Five = 5 |Six = 6 
            |Seven =7  |Eight = 8 |Nine = 9 |Ten = 10 |Jack = 11 |Queen =12 |King  =13
type acard = (card * suit)  
 
let carder x:card= enum x
 
let card_value = function
    | 'A' -> card.Ace
    | 'K' -> card.King
    | 'Q' -> card.Queen
    | 'J' -> card.Jack  
    | 'T' -> card.Ten
    | c ->  carder(System.Int32.Parse(c.ToString()))
 
let suit_value = function
    | 'S' -> Spades
    | 'H' -> Hearts    
    | 'C' -> Clubs
    | 'D' -> Diamonds    
    | a -> invalid_arg (a.ToString())
 
let Create (str: string) :acard = (card_value str.[0],suit_value str.[1])
 
let isstraigh (mycards:acard list)  = 
    let mycards = List.sort_by (fun (a,b) -> a,b) mycards
    let rec isstr previouscard mycards   (straightlist : acard list) =
        if straightlist.Length >= 5 then straightlist
        else match mycards with  
                | cur :: rest -> if int (fst cur) = int ((fst previouscard)) + 1 then isstr cur rest  (cur::straightlist)
                                 else isstr cur rest  []                           
                | _ -> []
    let head = List.hd mycards
    isstr head (List.tl mycards) [head]
 
let pairl (mycards : acard list) groupfunction minelementCount =
                 mycards |> Seq.group_by groupfunction
                         |> Seq.filter (fun a -> Seq.length (snd a) >= minelementCount)
                         |> Seq.to_list
                         |> List.unzip
 
 
type Ranks =
    | Highest of card
    | Pair of  card
    | TwoPair of card*card
    | Three of card
    | Straight of card
    | Flush of card 
    | FullHouse of  card*card
    | Four of  card
    | StraightFlush of card
 
type Player = |One |Two  |Noone
 
let rank (mycards :  acard list) =     
    let traverseL  (l :'a list)  = if not l.IsEmpty then l  |> List.hd |> Seq.to_list
                                   else []                            
    let isflush mycards = snd (pairl mycards snd 5)  |> traverseL
 
    let FofF l = traverseL l |> List.hd |> fst
 
    let flush = isflush mycards
    let straight = isstraigh mycards
 
    let ispair count= pairl mycards fst count                                                             
 
    let four,fours = let f,s = ispair 4 
                     f,s|> traverseL
    let three,threes = ispair 3 
    let two,twos = ispair 2
 
    let maxcard c = fst (List.max c)
 
    if not flush.IsEmpty && not straight.IsEmpty then StraightFlush(maxcard flush),flush
    elif  not fours.IsEmpty then Four(four.Head),fours
    elif not threes.IsEmpty && not twos.IsEmpty && FofF twos <> FofF threes then FullHouse(two.Head, three.Head), List.append (threes |> traverseL) (traverseL twos)
    elif not flush.IsEmpty then Flush(maxcard flush),flush
    elif not straight.IsEmpty then Straight(maxcard straight),straight
    elif not three.IsEmpty then Three( three.Head), threes |> traverseL
    elif List.length two = 2 then TwoPair(two.Head,two.Tail.Head),Seq.append (twos.Head) (twos.Tail.Head) |> Seq.to_list
    elif not (twos |> traverseL).IsEmpty then Pair(two.Head), twos |> traverseL
    else Highest(maxcard mycards), [List.max mycards]
 
let play input =
    let convert (line: string) = let l = line.Split([|' '|])                                  
                                 [|[for j in 0 .. 4 do yield Create( l.[j])]; [for j in 5 .. 9 do yield Create( l.[j])]|]                                                                  
    let playercrds = convert input              
    let rec iswinner pcards=               
                let ranks,rankcards = pcards |> Array.map (rank)  |> Array.unzip
 
                let removecards (mainlist) (toberemoved)  =                         
                        mainlist |> Array.map2 (fun rem main-> main |> List.filter (fun c->
                                List.fold_left(fun ac x-> if x = c then ac && false else ac && true) true rem)) toberemoved
 
                if ranks.[0]>ranks.[1] then One
                elif ranks.[0]<ranks.[1] then Two
                else iswinner  (removecards  pcards rankcards) 
 
    iswinner playercrds
 
 
play  "5H 5C 6S 7S KD 2C 3S 8S 8D TD" 
play  "5D 8C 9S JS AC 2C 5C 7D 8S QH"
play  "2D 9C AS AH AC 3D 6D 7D TD QD"
play  "4D 6S 9H QH QC 3D 6D 7H QD QS"  // prob pair queens look at the highes
play  "2H 2D 4C 4D 4S 3C 3D 3S 9S 9D" 
 
play  "2H 2D 4C 4D 4S 2H 2D 4C 4D 4S" 
 
play  "TH 8D 6C 4D 3S TH 8D 6C 4D 4S" 
 
 
 
let rdinput =   use file = System.IO.File.OpenText("poker.txt")
                let p1count = ref 0  
 
                while not file.EndOfStream do
                 if play (file.ReadLine()) = One then p1count := !p1count+1
 
                file.Close()
                !p1count