74 lines
2.8 KiB
Haskell
74 lines
2.8 KiB
Haskell
{-# LANGUAGE ViewPatterns, LambdaCase #-}
|
|
|
|
-- 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 Euler
|
|
import Data.Attoparsec.Text
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as T
|
|
|
|
type Rank = Int
|
|
type Suit = Char
|
|
data Card = Card { cardRank :: Rank, cardSuit :: Suit } deriving (Eq,Show)
|
|
|
|
data HandRank = HighCard | Pair | TwoPair | Triple | Straight | Flush
|
|
| FullHouse | Quad | StraightFlush | RoyalFlush
|
|
deriving (Eq,Ord,Enum,Bounded,Show)
|
|
|
|
handRank (sortBy (compare `on` cardRank) -> cards)
|
|
| same suits, ranks == [10 .. 14] = (RoyalFlush, 14)
|
|
| same suits, consecutive ranks = (StraightFlush, maximum ranks)
|
|
| Just a <- nSame 4 ranks = (Quad, a)
|
|
| Just a <- nSame 3 ranks,
|
|
Just b <- nSame 2 (filter (/= a) ranks) = (FullHouse, a)
|
|
| same suits = (Flush, maximum ranks)
|
|
| consecutive ranks = (Straight, maximum ranks)
|
|
| Just a <- nSame 3 ranks = (Triple, a)
|
|
| Just a <- nSame 2 ranks,
|
|
Just b <- nSame 2 (filter (/= a) ranks) = (TwoPair, max a b)
|
|
| Just a <- nSame 2 ranks = (Pair, a)
|
|
| otherwise = (HighCard, maximum ranks)
|
|
where
|
|
ranks = map cardRank cards
|
|
suits = map cardSuit cards
|
|
|
|
same :: Eq a => [a] -> Bool
|
|
same xs = and $ zipWith (==) xs (tail xs)
|
|
|
|
nSame :: Eq a => Int -> [a] -> Maybe a
|
|
nSame n cs = listToMaybe $ do
|
|
c <- nub cs
|
|
guard $ length (filter (== c) cs) >= n
|
|
return c
|
|
|
|
consecutive :: (Eq a, Enum a) => [a] -> Bool
|
|
consecutive xs = and $ zipWith (\a b -> succ a == b) xs (tail xs)
|
|
|
|
rankP = flip fmap (satisfy (`elem` "23456789TJQKA")) $ \case
|
|
'T' -> 10; 'J' -> 11; 'Q' -> 12; 'K' -> 13; 'A' -> 14; c -> read [c]
|
|
suitP = satisfy (`elem` "CDHS")
|
|
|
|
cardP = Card <$ skipSpace <*> rankP <*> suitP
|
|
handP = sequenceA $ replicate 5 cardP
|
|
lineP = (,) <$> handP <*> handP
|
|
fileP = (lineP `sepBy` endOfLine) <* optional endOfLine <* endOfInput
|
|
|
|
compareHands :: [Card] -> [Card] -> Ordering
|
|
compareHands xs ys = (handRank xs `compare` handRank ys)
|
|
<> (descRanks xs `compare` descRanks ys)
|
|
where descRanks = sortBy (flip compare) . map cardRank
|
|
|
|
main = do
|
|
hands <- either error id . parseOnly fileP <$> T.readFile "p054_poker.txt"
|
|
print $ length $ filter (== GT) $ map (uncurry compareHands) hands
|