# Poker Hand Kata

Similar to, but distinct from Poker hand identifier. I'm working towards solving this kata. The below code doesn't print the result yet, and it reads hand strings rather than game strings.

Take 4:

import Data.String
import Data.List
import Data.Ord

data Rank = Two | Three | Four | Five | Six | Seven | Eight | Nine
| Ten | Jack | Queen | King | Ace
deriving (Eq, Ord, Show, Bounded, Enum)

let tbl = zip "23456789TJQKA" [Two .. Ace]
in case lookup (head value) tbl of
Just r -> [(r, tail value)]
Nothing -> error $"Invalid rank: " ++ value data Suit = H | C | D | S deriving (Eq, Ord, Show, Read) data Card = Card { rank :: Rank, suit :: Suit } deriving (Eq, Ord, Show) instance Read Card where readsPrec _ [r, s] = [(Card (read [r]) (read [s]), "")] readsPrec _ value = error$ "Invalid card: " ++ value

data Hand = Hand { handRank :: HandRank, cards :: [Card] }
deriving (Eq, Show, Ord)

[(Hand (getHandRank res) res, "")]
where res = reverse . sort . map read $words value data HandRank = HighCard [Rank] | Pair [Rank] | TwoPair [Rank] | ThreeOfAKind [Rank] | Straight [Rank] | Flush [Rank] | FullHouse [Rank] | FourOfAKind [Rank] | StraightFlush [Rank] deriving (Eq, Ord, Show) data GameOutcome = Winner String Hand | Tie deriving (Eq, Ord) instance Show GameOutcome where show o = case o of Winner player hand -> player ++ " wins with " ++ show (handRank hand) Tie -> "Tie" isFlush :: [Card] -> Bool isFlush = (1==) . length . group . map suit isStraight :: [Card] -> Bool isStraight cards = let rs = sort$ map rank cards
run = [(head rs) .. (last rs)]
in rs == run

getHandRank :: [Card] -> HandRank
getHandRank cards =
let ranks = map rank cards
rankGroups = sortByLen $group ranks relevantRanks = map (!!0) rankGroups handRank = case cards of _ | isFlush cards && isStraight cards -> StraightFlush | has4 rankGroups -> FourOfAKind | has3 rankGroups && has2 rankGroups -> FullHouse | isFlush cards -> Flush | isStraight cards -> Straight | has3 rankGroups -> ThreeOfAKind | countGroupsOf 2 rankGroups == 2 -> TwoPair | has2 rankGroups -> Pair | otherwise -> HighCard in handRank relevantRanks winner :: Hand -> Hand -> GameOutcome winner h1 h2 = case compare h1 h2 of GT -> Winner "Player 1" h1 LT -> Winner "Player 2" h2 EQ -> Tie ------------------------------- -- General Utility Functions -- ------------------------------- hasGroupOf :: Int -> [[a]] -> Bool hasGroupOf n groups = n elem map length groups has4 = hasGroupOf 4 has3 = hasGroupOf 3 has2 = hasGroupOf 2 countGroupsOf :: Int -> [[a]] -> Int countGroupsOf n groups = length$ filter (\g -> length g == n) groups

sortByLen :: [[a]] -> [[a]]
sortByLen = sortBy (flip $comparing length)  • Added comparison function • Fixed a bug relating to improper sorting in some situations (replaced nub with relevantRanks in getHandRank • Ran it through hlint My only experience with Haskell so far is some playing around with Parsec and a few half-read-throughs of WYAS48, so please be obnoxious about style issues. All feedback welcome, but I would particularly like to ask 1. Are there built-ins/better implementations of the "General Utility" functions defined at the bottom? 2. Is there a clearer or more succinct way of writing Read Rank? 3. Is there a clearer or more flexible way of writing getHandRank, with particular emphasis on closely connecting those predicates with the data entry? ## 3 Answers It's generally a good idea to give explicit type signatures for your top level definitions. It helps your code's readers (e.g. us) understand your code. hasGroupOf looks perfectly clear (save for the missing type signature), but I'd write the other two like this: import Data.Ord (comparing) countGroupsOf :: Int -> [a] -> Int countGroupsOf n groups = length$ filter (\g -> length g == n) groups

sortByLen :: [[a]] -> [[a]]
sortByLen = sortBy (flip $comparing length)  Actually, for that last one, I'd probably want lists of equal length to sort in a predictable order: import Data.Monoid sortByLen :: [[a]] -> [[a]] sortByLen = sortBy (mconcat [flip$ comparing length, compare])


(You are expected to know that Ordering is a monoid, and that a -> b is a monoid when b is a monoid. The monoid I'm using is [a] -> [a] -> Ordering.)

• I took your advice on the type signatures and simplified functions (note that countGroupsOf actually has a type signature of Int -> [[a]] -> Int; I assume this only matters because we're mapping length over the contents of that argument). The monadic sortByLen threw me a type error, and I'm not entirely sure what it's doing, so I stuck with your first version. – Inaimathi Aug 27 '12 at 4:00

I think your instance Read Card can be improved. There's no reason to use length if you just want to know whether the length is 2 or not 2. If the length is 2 then value is [r,s] (String is just [Char]), so you can write

readsPrec _ [r,s] = ...


Then you can just do read [r] and read [s]. I don't think you have to specify (read r :: Rank) either. The compiler should be able to figure it out from the way you're using it. And of course if you know that value is of length 2, you know what drop 2 value is.

I'm kind of sleepy so I apologize for any horrible mistakes I've made in this answer.

• Right on all counts – Inaimathi Aug 30 '12 at 14:02

YourrankGroups list is sorted by the size of the group. If you reverse sort it you can use:

case rankGroups of
(4:_)      -> -- four of a kind
(3:2:_)    -> -- full house
(3:_)      -> -- trips but not a full house
(2:2:_)    -> -- two pair
(2:_)      -> -- a pair but not two pair
(1:_)      -> -- check for straights and flushes