text: 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 . K.group 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: bonsai, code, Haskell, hold, kata, poker, praxis, programming, texas
  March 23, 2010 at 12:40 pm |
  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.
  Phil
  March 23, 2010 at 2:58 pm |
  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 :)