101 lines
2.5 KiB
Haskell
101 lines
2.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main where
|
|
|
|
import Data.Attoparsec.Text
|
|
import Data.List (group, sort, sortOn)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as TIO
|
|
|
|
type Input = [(Hand, [Int], Int)]
|
|
|
|
data Hand
|
|
= HighCard
|
|
| OnePair
|
|
| TwoPairs
|
|
| ThreeOfAKind
|
|
| FullHouse
|
|
| FourOfAKind
|
|
| FiveOfAKind
|
|
deriving (Show, Eq, Ord)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
input <- TIO.getContents >>= parseInput
|
|
putStrLn ("Part 1: " <> show (part1 input))
|
|
putStrLn ("Part 2: " <> show (part2 input))
|
|
|
|
parseInput :: T.Text -> IO Input
|
|
parseInput s = case parseOnly inputParser s of
|
|
Right i -> pure i
|
|
Left e -> error e
|
|
|
|
inputParser :: Parser Input
|
|
inputParser = sepBy1 lineParser endOfLine <* skipSpace <* endOfInput
|
|
|
|
lineParser :: Parser (Hand, [Int], Int)
|
|
lineParser = do
|
|
cards <- (map cardValue . T.unpack <$> takeWhile1 (inClass "2-9TJQKA")) <* skipSpace
|
|
bid <- decimal
|
|
return (classifyHand cards, cards, bid)
|
|
|
|
part1 :: Input -> Int
|
|
part1 i = sum $ [rank * bid | ((_, _, bid), rank) <- rankHands i]
|
|
|
|
values :: [(Int, Char)]
|
|
values = zip [2 ..] $ ['2' .. '9'] ++ ['T', 'J', 'Q', 'K', 'A']
|
|
|
|
part2 :: Input -> Int
|
|
part2 i = part1 $ map part2Revalue i
|
|
|
|
part2Revalue :: (Hand, [Int], Int) -> (Hand, [Int], Int)
|
|
part2Revalue (_, cards, bid) = (pickBestJokers revaluedCards, revaluedCards, bid)
|
|
where
|
|
revaluedCards = map revalueCard cards
|
|
|
|
revalueCard :: Int -> Int
|
|
revalueCard x
|
|
| x == 11 = 1
|
|
| x > 11 = x - 1
|
|
| otherwise = x
|
|
|
|
cardValue :: Char -> Int
|
|
cardValue c = fst $ head $ filter (\v -> snd v == c) values
|
|
|
|
classifyHand :: [Int] -> Hand
|
|
classifyHand h = case groups of
|
|
[5] -> FiveOfAKind
|
|
[1, 4] -> FourOfAKind
|
|
[2, 3] -> FullHouse
|
|
[1, 1, 3] -> ThreeOfAKind
|
|
[1, 2, 2] -> TwoPairs
|
|
[1, 1, 1, 2] -> OnePair
|
|
[1, 1, 1, 1, 1] -> HighCard
|
|
_ -> error "There should be 5 cards in a hand"
|
|
where
|
|
groups = counts h
|
|
|
|
rankHands :: [(Hand, [Int], Int)] -> [((Hand, [Int], Int), Int)]
|
|
rankHands h = zip (sortOn (\(a, b, _) -> (a, b)) h) [1 ..]
|
|
|
|
counts :: [Int] -> [Int]
|
|
counts = sort . map length . group . sort
|
|
|
|
pickBestJokers :: [Int] -> Hand
|
|
pickBestJokers = maximum . map classifyHand . expandJokers
|
|
|
|
expandJoker :: Int -> [Int]
|
|
expandJoker 1 = [2 .. 13]
|
|
expandJoker x = [x]
|
|
|
|
expandJokers :: [Int] -> [[Int]]
|
|
expandJokers [a, b, c, d, e] =
|
|
[ [a1, b1, c1, d1, e1]
|
|
| a1 <- expandJoker a,
|
|
b1 <- expandJoker b,
|
|
c1 <- expandJoker c,
|
|
d1 <- expandJoker d,
|
|
e1 <- expandJoker e
|
|
]
|
|
expandJokers _ = error "Expected a list with five elements"
|