Day 23 part 2
[advent-of-code-23.git] / advent07 / Main.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 | isFiveOfAKind signature = CHand FiveOfAKind cards bid
48 | isFourOfAKind signature = CHand FourOfAKind cards bid
49 | isFullHouse signature = CHand FullHouse cards bid
50 | isThreeOfAKind signature = CHand ThreeOfAKind cards bid
51 | isTwoPair signature = CHand TwoPair cards bid
52 | isOnePair signature = CHand OnePair cards bid
53 | otherwise = CHand HighCard cards bid
54 where signature = sign cards
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 -- numJokers = length jokers
61 nonJokerSigned = reverse $ sort $ fmap (\g -> (length g, g)) $
62 group $ sort nonJokers
63
64 addJokers :: Signature -> SignatureElement -> Signature
65 addJokers [] js = [js]
66 addJokers ((n, cs):xs) (jn, js) = (n + jn, cs ++ js):xs
67
68 isFiveOfAKind, isFourOfAKind, isFullHouse, isThreeOfAKind, isTwoPair,
69 isOnePair :: Signature -> Bool
70 isFiveOfAKind ((5, _):_) = True
71 isFiveOfAKind _ = False
72
73 isFourOfAKind ((4, _):_) = True
74 isFourOfAKind _ = False
75
76 isFullHouse ((3, _):(2, _):_) = True
77 isFullHouse _ = False
78
79 isThreeOfAKind ((3, _):_) = True
80 isThreeOfAKind _ = False
81
82 isTwoPair ((2, _):(2, _):_) = True
83 isTwoPair _ = False
84
85 isOnePair ((2, _):_) = True
86 isOnePair _ = False
87
88 -- isHighCard :: Signature -> Bool
89 -- isHighCard _ = True
90
91 -- Parse the input file
92
93 handsP :: Parser [Hand]
94 handP :: Parser Hand
95 cardP :: Parser Card
96
97 handsP = handP `sepBy` endOfLine
98 handP = Hand <$> ((many1 cardP) <* space) <*> decimal
99
100 cardP = (Two <$ "2") <|> (Three <$ "3") <|> (Four <$ "4") <|>
101 (Five <$ "5") <|> (Six <$ "6") <|> (Seven <$ "7") <|>
102 (Eight <$ "8") <|> (Nine <$ "9") <|> (Ten <$ "T") <|>
103 (Jack <$ "J") <|> (Queen <$ "Q") <|> (King <$ "K") <|>
104 (Ace <$ "A")
105
106 successfulParse :: Text -> [Hand]
107 successfulParse input =
108 case parseOnly handsP input of
109 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
110 Right matches -> matches