Programming Praxis – Texas Hold ‘Em

In today’s Programming Praxis exercise we have to write a program to rank poker hands. The provided Scheme solution clocks in at 62 lines. Let’s see if we can’t bring that number down a little.

As usual, some imports:

import Data.Char
import Data.List
import qualified Data.List.Key as K

We’ll need to convert the two-character strings that are used to define the card to something that’s easier to work with.

toCard :: String -> (Int, Char)
toCard ~[v,s] = maybe undefined (flip (,) $ toUpper s) .
                lookup v $ zip "23456789TJQKA" [2..]

If a hand is a flush, grouping on the suit should produce a list with only one element.

flush :: [(Int, Char)] -> Bool
flush = (== 1) . length . snd

If a hand is a straight, it should consist of ascending values or be ace through five.

straight :: [Int] -> Bool
straight xs = (l:r) == [2,3,4,5,14] || isPrefixOf r [l + 1..]
              where (l:r) = reverse $ map fromEnum xs

As with flushes, we use grouping to find how many cards we have with the same value. This function assumes that the list of values is already sorted.

same :: [Int] -> [Int]
same = map length . group

Calculating the rank of a hand then becomes a fairly simple matter of using the functions above to find the highest possible rank. We also add the sorted card values to the result so that multiple hands with the same rank will be compared on highest card value.

UPDATE: The original version had a bug where n-of-a-kinds were compared on the highest value of the other cards. I altered the definition of s to remedy this.

rank :: [String] -> (Int, [Int])
rank xs | straight s && flush cs     = (9, s)
        | elem 4 $ same s            = (8, s)
        | same s == [3,2]            = (7, s)
        | flush cs                   = (6, s)
        | straight s                 = (5, s)
        | elem 3 $ same s            = (4, s)
        | elem 2 . delete 2 $ same s = (3, s)
        | elem 2 $ same s            = (2, s)
        | otherwise                  = (1, s)
        where s = concat . reverse . K.sort (\x -> (length x, head x)) .
                  group . sort $ map fst cs
              cs = map toCard xs

To determine the best hand, we need a way to look at every possible hand that can be chosen from the 7 available cards.

choose :: Int -> [a] -> [[a]]
choose 0 _      = [[]]
choose _ []     = []
choose n (x:xs) = map (x: ) (choose (n-1) xs) ++ choose n xs

The best hand is simply the one with the highest rank.

bestHand :: [String] -> [String]
bestHand = K.maximum rank . choose 5

Nothing left but to test if everything works correctly:

main :: IO ()
main = do
    mapM_ print [fst (rank ["AH", "KH", "QH", "JH", "TH"]) == 9
                ,fst (rank ["7H", "7C", "3H", "7S", "7D"]) == 8
                ,fst (rank ["TH", "JC", "TS", "JD", "TC"]) == 7
                ,fst (rank ["4H", "7H", "AH", "KH", "9H"]) == 6
                ,fst (rank ["AH", "2C", "3S", "4D", "5H"]) == 5
                ,fst (rank ["9C", "4S", "KD", "9D", "9H"]) == 4
                ,fst (rank ["6D", "6C", "8H", "TD", "8D"]) == 3
                ,fst (rank ["9C", "3S", "4D", "7C", "3D"]) == 2
                ,fst (rank ["4C", "KD", "8S", "6D", "2D"]) == 1]
    print $ bestHand ["AC", "JD", "8S", "8C", "AS", "3D", "4D"]
    --Added after Phil's bug report
    print $ rank ["AC", "7D", "7S", "7H", "7C"] <
            rank ["4C", "8D", "8S", "8H", "8C"]

Yup. And at around a third of the line count of the Scheme version, that will do just fine.

Tags: , , , , , , , ,

2 Responses to “Programming Praxis – Texas Hold ‘Em”

  1. programmingpraxis Says:

    I’m not sure if this is entirely correct. If you have a hand containing one ace and four sevens, your tie-breaker will list the ace first, then the sevens, which is backwards.


  2. Remco Niemeijer Says:

    Whoops, I missed that one. Thanks for the bug report. Fortunately, it’s an easy fix. It even makes the definition of same even easier 🙂

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: