# Poker Hand Evaluator in Haskell

The idea is to represent a hand as a list of cards and create a frequency mapping, which can then be used to identify what rank of hand you have and arrange your hand in a way that allows the Ord type class to compare hands of the same rank.

My solution feels a little cumbersome, however this is a lot nicer than anything I could have written imperatively, as poker hand evaluation is a little awkward in general.

card.hs

module Card
(Card(..), Suit(..), Rank(..), rankVal) where

data Card = Card Suit Rank

data Suit =
Spades
| Hearts
| Clubs
| Diamonds
deriving (Show, Eq, Enum, Bounded)

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

instance Eq Card where
Card _ rank1 == Card _ rank2 = rank1 == rank2

instance Ord Card where
Card _ rank1 compare Card _ rank2 = rank1 compare rank2

instance Show Card where
show (Card suit rank) = "(" ++ (show suit) ++ ", " ++ (show rank) ++ ")"

rankVal :: Rank -> Int
rankVal Two = 2
rankVal Three = 3
rankVal Four = 4
rankVal Five = 5
rankVal Six = 6
rankVal Seven = 7
rankVal Eight = 8
rankVal Nine = 9
rankVal Ten = 10
rankVal Jack = 10
rankVal Queen = 10
rankVal King = 10
rankVal Ace = 11


solver.hs

module Hand
(Card(..), Suit(..), Rank(..), compareHands) where

import Card
import Data.List

--TODO Add tests for every function

type Hand = [Card]

-- Cards arranged such that compare will return which hand is better
type RelativeRank = [Card]

-- A mapping between an element in a list and it's frequency
-- For example, [1, 2, 2, 2, 2] is [(1,1),(2,4),(2,4),(2,4),(2,4)]
type FreqMapping a = [(a, Int)]

data HandRank =
HighCard
| Pair
| TwoPairs
| ThreeOfKind
| Straight
| Flush
| FullHouse
| FourOfKind
| StraightFlush
| RoyalFlush

deriving (Show, Eq, Ord, Enum, Bounded)

compareHands :: Hand -> Hand -> Ordering
compareHands hand1 hand2 = (handRank1, relativeRank1) compare (handRank2, relativeRank2)

where relativeRank1 = computeRelativeRank hand1 handRank1
relativeRank2 = computeRelativeRank hand2 handRank2
handRank1 = computeHandRank hand1
handRank2 = computeHandRank hand2

maxVal :: Hand -> Int
maxVal = foldr (\(Card _ rank) acc -> max acc $rankVal rank) 0 isStraight :: Hand -> Bool isStraight = isStraightHelper . sort isStraightHelper :: Hand -> Bool isStraightHelper [] = True isStraightHelper [x] = True isStraightHelper (card1:card2:xs) = isValidStep && isStraightHelper (card2:xs) where isValidStep = 1 + rankVal rank1 == rankVal rank2 (Card _ rank1) = card1 (Card _ rank2) = card2 isFlush :: Hand -> Bool isFlush (x:xs) = (replicate len$ suit x) == (map suit (x:xs))
where suit = (\(Card suit _) -> suit)
len = length (x:xs)

computeHandRank :: Hand -> HandRank
computeHandRank xs
| flush && straight && maxVal xs == 12 = RoyalFlush
| flush && straight                    = StraightFlush
| freqList == [1, 4, 4, 4, 4]          = FourOfKind
| freqList == [2, 2, 3, 3, 3]          = FullHouse
| flush                                = Flush
| straight                             = Straight
| freqList == [1, 1, 3, 3, 3]          = ThreeOfKind
| freqList == [1, 2, 2, 2, 2]          = TwoPairs
| freqList == [1, 1, 1, 2, 2]          = Pair
| otherwise                            = HighCard

where straight = isStraight xs
flush = isFlush xs
freqList = sort $map snd$ computeFreqMapping xs

-- Used to compare hands of the same rank
computeRelativeRank :: Hand -> HandRank -> RelativeRank
computeRelativeRank xs handRank
| handRank == RoyalFlush    = []
| handRank == StraightFlush = revSort xs
| handRank == FourOfKind    = valsAtFreq 4 freqs ++ valsAtFreq 1 freqs
| handRank == FullHouse     = valsAtFreq 3 freqs ++ valsAtFreq 2 freqs
| handRank == Flush         = revSort xs
| handRank == Straight      = revSort xs
| handRank == ThreeOfKind   = valsAtFreq 3 freqs ++ (revSort $valsAtFreq 1 freqs) | handRank == TwoPairs = (maximum$ valsAtFreq 2 freqs) : (minimum $valsAtFreq 2 freqs) : (valsAtFreq 1 freqs) | handRank == Pair = valsAtFreq 2 freqs ++ (revSort$ valsAtFreq 1 freqs)
| handRank == HighCard      = revSort xs

where freqs = computeFreqMapping xs

computeFreqMapping :: (Eq a) => [a] -> FreqMapping a
computeFreqMapping xs = map (\elem -> (elem, elemCount elem xs)) xs

-- Return number of times an element appears in a list
elemCount :: (Eq a) => a -> [a] -> Int
elemCount elem = length . filter (elem==)

--Return set of all values that appear at a given frequency in the freqency mapping
valsAtFreq :: (Ord a) => Int -> FreqMapping a -> [a]
valsAtFreq freq xs = [fst x | x <- xs, snd x == freq]

revSort :: (Ord a) => [a] -> [a]
revSort = reverse . sort
$$$$


## 1 Answer

Just a few ideas - successfully compiled, not tested further.

Using record syntax yields the functions suit, rank for "free", i.e.

data Card = Card { suit :: Suit
, rank :: Rank }


allows for shorter definitions:

instance Eq Card where
c1 == c2 = rank c1 == rank c2

instance Ord Card where
c1 compare c2 = rank c1 compare rank c2


Similarly the following three functions become clearer.

maxVal :: Hand -> Int
maxVal = maximum . map (rankVal . rank)

isStraight :: Hand -> Bool
isStraight hand = [head sortedRanks .. last sortedRanks] == sortedRanks
where sortedRanks = sort . map rank $hand isFlush :: Hand -> Bool isFlush = (1==) . length . nub . map suit  To me computeRelativeRank calls for a case expression. computeRelativeRank :: Hand -> HandRank -> RelativeRank computeRelativeRank xs handRank = case handRank of RoyalFlush -> [] StraightFlush -> revSort xs FourOfKind -> valsAtFreq 4 freqs ++ valsAtFreq 1 freqs FullHouse -> valsAtFreq 3 freqs ++ valsAtFreq 2 freqs Flush -> revSort xs Straight -> revSort xs ThreeOfKind -> valsAtFreq 3 freqs ++ (revSort$ valsAtFreq 1 freqs)
TwoPairs      -> (maximum $valsAtFreq 2 freqs) : (minimum$ valsAtFreq 2 freqs) : (valsAtFreq 1 freqs)
Pair          -> valsAtFreq 2 freqs ++ (revSort \$ valsAtFreq 1 freqs)
HighCard      -> revSort xs
where freqs = computeFreqMapping xs


I'd count the number of elements using a Map.

import qualified Data.Map.Strict as M

computeFreqMapping :: (Ord a) => [a] -> FreqMapping a
computeFreqMapping = M.toList . foldl incrementCounter M.empty
where incrementCounter m k = M.insertWith (+) k 1 m


In fact, the whole frequency mapping could be handled using such maps - sorting is automatic that way. If you are so inclined, take a look at the documentation - particularly the functions keys, elems`.