1 -- Writeup at https://work.njae.me.uk/2023/12/07/advent-of-code-2023-day-07/
4 import Data.Text (Text)
5 import qualified Data.Text.IO as TIO
6 import Data.Attoparsec.Text -- hiding (take)
7 import Control.Applicative
10 data Card = Joker | Two | Three | Four | Five | Six | Seven | Eight | Nine |
11 Ten | Jack | Queen | King | Ace deriving (Eq, Ord, Show)
13 data HandClass = HighCard | OnePair | TwoPair | ThreeOfAKind | FullHouse |
14 FourOfAKind | FiveOfAKind deriving (Eq, Ord, Show)
16 data Hand = Hand [Card] Int deriving (Eq, Ord, Show)
17 data ClassifiedHand = CHand HandClass [Card] Int deriving (Eq, Ord, Show)
19 type SignatureElement = (Int, [Card])
20 type Signature = [SignatureElement]
24 do dataFileName <- getDataFileName
25 text <- TIO.readFile dataFileName
26 let hands = successfulParse text
30 part1, part2 :: [Hand] -> Int
31 part1 hands = sum $ fmap score rankedHands
32 where sortedHands = sort $ fmap classify hands
33 rankedHands = zip [1..] sortedHands
34 score (r, CHand _ _ bid) = r * bid
36 part2 = part1 . fmap enJoker
38 enJoker :: Hand -> Hand
39 enJoker (Hand cards bid) = Hand jCards bid
40 where jCards = replace Jack Joker cards
42 replace :: Eq a => a -> a -> [a] -> [a]
45 | x == f = t : replace f t xs
46 | otherwise = x : replace f t xs
48 classify :: Hand -> ClassifiedHand
49 classify (Hand cards bid) =
51 ((5, _):_) -> CHand FiveOfAKind cards bid
52 ((4, _):_) -> CHand FourOfAKind cards bid
53 ((3, _):(2, _):_) -> CHand FullHouse cards bid
54 ((3, _):_) -> CHand ThreeOfAKind cards bid
55 ((2, _):(2, _):_) -> CHand TwoPair cards bid
56 ((2, _):_) -> CHand OnePair cards bid
57 _ -> CHand HighCard cards bid
59 sign :: [Card] -> Signature
60 -- sign = reverse . sort . fmap (\g -> (length g, g)) . group . sort
61 sign cards = addJokers nonJokerSigned (length jokers, jokers)
62 where (jokers, nonJokers) = partition (== Joker) cards
63 nonJokerSigned = reverse $ sort $ fmap (\g -> (length g, g)) $
64 group $ sort nonJokers
66 addJokers :: Signature -> SignatureElement -> Signature
67 addJokers [] js = [js]
68 addJokers ((n, cs):xs) (jn, js) = (n + jn, cs ++ js):xs
70 -- Parse the input file
72 handsP :: Parser [Hand]
76 handsP = handP `sepBy` endOfLine
77 handP = Hand <$> ((many1 cardP) <* space) <*> decimal
79 cardP = (Two <$ "2") <|> (Three <$ "3") <|> (Four <$ "4") <|>
80 (Five <$ "5") <|> (Six <$ "6") <|> (Seven <$ "7") <|>
81 (Eight <$ "8") <|> (Nine <$ "9") <|> (Ten <$ "T") <|>
82 (Jack <$ "J") <|> (Queen <$ "Q") <|> (King <$ "K") <|>
85 successfulParse :: Text -> [Hand]
86 successfulParse input =
87 case parseOnly handsP input of
88 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
89 Right matches -> matches