Day 23 part 2
[advent-of-code-23.git] / advent07 / MainWithCase.hs
1 -- Writeup at https://work.njae.me.uk/2023/12/07/advent-of-code-2023-day-07/
2
3 import AoC
4 import Data.Text (Text)
5 import qualified Data.Text.IO as TIO
6 import Data.Attoparsec.Text -- hiding (take)
7 import Control.Applicative
8 import Data.List
9
10 data Card = Joker | Two | Three | Four | Five | Six | Seven | Eight | Nine |
11 Ten | Jack | Queen | King | Ace deriving (Eq, Ord, Show)
12
13 data HandClass = HighCard | OnePair | TwoPair | ThreeOfAKind | FullHouse |
14 FourOfAKind | FiveOfAKind deriving (Eq, Ord, Show)
15
16 data Hand = Hand [Card] Int deriving (Eq, Ord, Show)
17 data ClassifiedHand = CHand HandClass [Card] Int deriving (Eq, Ord, Show)
18
19 type SignatureElement = (Int, [Card])
20 type Signature = [SignatureElement]
21
22 main :: IO ()
23 main =
24 do dataFileName <- getDataFileName
25 text <- TIO.readFile dataFileName
26 let hands = successfulParse text
27 print $ part1 hands
28 print $ part2 hands
29
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
35
36 part2 = part1 . fmap enJoker
37
38 enJoker :: Hand -> Hand
39 enJoker (Hand cards bid) = Hand jCards bid
40 where jCards = replace Jack Joker cards
41
42 replace :: Eq a => a -> a -> [a] -> [a]
43 replace f t = fmap (\x -> if x == f then t else x)
44
45 classify :: Hand -> ClassifiedHand
46 classify (Hand cards bid) =
47 case (sign cards) of
48 ((5, _):_) -> CHand FiveOfAKind cards bid
49 ((4, _):_) -> CHand FourOfAKind cards bid
50 ((3, _):(2, _):_) -> CHand FullHouse cards bid
51 ((3, _):_) -> CHand ThreeOfAKind cards bid
52 ((2, _):(2, _):_) -> CHand TwoPair cards bid
53 ((2, _):_) -> CHand OnePair cards bid
54 _ -> CHand HighCard cards bid
55
56 sign :: [Card] -> Signature
57 -- sign = reverse . sort . fmap (\g -> (length g, g)) . group . sort
58 sign cards = addJokers nonJokerSigned (length jokers, jokers)
59 where (jokers, nonJokers) = partition (== Joker) cards
60 nonJokerSigned = reverse $ sort $ fmap (\g -> (length g, g)) $
61 group $ sort nonJokers
62
63 addJokers :: Signature -> SignatureElement -> Signature
64 addJokers [] js = [js]
65 addJokers ((n, cs):xs) (jn, js) = (n + jn, cs ++ js):xs
66
67 -- Parse the input file
68
69 handsP :: Parser [Hand]
70 handP :: Parser Hand
71 cardP :: Parser Card
72
73 handsP = handP `sepBy` endOfLine
74 handP = Hand <$> ((many1 cardP) <* space) <*> decimal
75
76 cardP = (Two <$ "2") <|> (Three <$ "3") <|> (Four <$ "4") <|>
77 (Five <$ "5") <|> (Six <$ "6") <|> (Seven <$ "7") <|>
78 (Eight <$ "8") <|> (Nine <$ "9") <|> (Ten <$ "T") <|>
79 (Jack <$ "J") <|> (Queen <$ "Q") <|> (King <$ "K") <|>
80 (Ace <$ "A")
81
82 successfulParse :: Text -> [Hand]
83 successfulParse input =
84 case parseOnly handsP input of
85 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
86 Right matches -> matches