I wrote an implementation in Haskell for Project Euler Problem 54:
The file, poker.txt, contains one-thousand random hands dealt to two players. Each line of the file contains ten cards (separated by a single space): the first five are Player 1's cards and the last five are Player 2's cards. You can assume that all hands are valid (no invalid characters or repeated cards), each player's hand is in no specific order, and in each hand there is a clear winner.
How many hands does Player 1 win?
import Data.Monoid(mappend)
import Data.List(sortBy, sort, group, nub, elemIndex)
import Control.Arrow((&&&), (***))
import Data.Maybe(fromJust)
import Control.Monad(join)
type Hand = String
type Values = [Int]
data Ranking = HighCard | Pair | TwoPair | ThreeOfAKind | Straight | Flush | FullHouse | FourOfAKind | StraightFlush deriving (Eq, Ord)
data HandValue = HandValue Ranking Values
instance Eq HandValue where
HandValue r1 v1 == HandValue r2 v2 = r1 == r2 && v1 == v2
instance Ord HandValue where
HandValue r1 v1 `compare` HandValue r2 v2 = (r1 `compare` r2) `mappend` (v1 `compare` v2)
rateHand :: Hand -> HandValue
rateHand hand
| straight && flush = HandValue StraightFlush ranks
| flush = HandValue Flush ranks
| straight = HandValue Straight ranks
| otherwise = case map fst groups of
[4, 1] -> HandValue FourOfAKind values
[3, 2] -> HandValue FullHouse values
[3, 1, 1] -> HandValue ThreeOfAKind values
[2, 2, 1] -> HandValue TwoPair values
[2, 1, 1, 1] -> HandValue Pair values
otherwise -> HandValue HighCard values
where
sf = (`elem` "SCDH")
ranks = sortBy (flip compare) $ map (fromJust . (`elemIndex` "23456789TJQKA")) $ filter (not . sf) hand
suits = filter sf hand
flush = length (nub suits) == 1
straight = ranks == reverse [last ranks..head ranks] || ranks == [12,3,2,1,0]
groups = sortBy descSort . map (length &&& id) $ group ranks
values = concatMap snd groups
descSort (l1,v1) (l2,v2) = (l2 `compare` l1) `mappend` (v2 `compare` v1)
parseLine :: String -> Bool
parseLine line = uncurry (>) $ join (***) rateHand $ splitAt 10 $ filter (/= ' ') line
main :: IO ()
main = do
pots <- lines <$> readFile "p054_poker.txt"
print $ length $ filter parseLine pots
I defined a data type for the ranking, which is something like high card or flush. A HandValue is the combination of the ranking and the values of the cards related to the ranking + the kickers from high to low. For instance: HandValue TwoPair [10, 10, 3, 3, 12]
. Note that even though I have an ace, the values that are relevant (i.e. the two pairs) come first. This allows to compare two HandValues with the same ranking (i.e. HandValue TwoPair [10, 10, 3, 3, 12] < HandValue TwoPair [11, 11, 9, 9, 2]
). The Ord
instance for HandValue looks at the ranking first, and looks only at the values if the rankings are the same.
To actually rate a hand, the suits and the ranks are separated, then:
- flush: all the same suits -> removing all the duplicates gives a list of one element
- straight: the ranks are equal to an enumeration from the head to the last item. Extra check for the ace used as a low value.
These two checks give us the option to filter out StraightFlush, Flush and Straight. If it's neither a straight nor a flush, we need to look at grouping the ranks. Then we match the length of the list of similar ranks to find everything from FourOfAKind
to HighCard
. The values are in this case the concatenation of the list of similar cards (e.g. [[10, 10], [9,9], [12]] -> [10, 10, 9, 9, 12]
rather than the ranks from high to low (e.g. [12, 10, 10, 9, 9]
), to make sure the relevant values for the ranking (e.g. TwoPair
) are compared first.
A line is parsed by removing the spaces, then splitting (resulting in a tuple (hand player 1, hand player 2)
, which then mapped over by join (***) rateHand
, and then the first value is compared to the second value, resulting in a boolean that is True
if player 1 wins the hand. This is then used as a filter to count the length of the list of hands in which player 1 wins.
My implementation works perfectly and is very fast (100,000 lines in 10 sec in ghci, actual problem is instant), so I'm not necessarily looking for performance improvements; any kind of feedback is more than welcome.