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 hands = part1 $ fmap enJoker hands
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)
50 | isFiveOfAKind signature = CHand FiveOfAKind cards bid
51 | isFourOfAKind signature = CHand FourOfAKind cards bid
52 | isFullHouse signature = CHand FullHouse cards bid
53 | isThreeOfAKind signature = CHand ThreeOfAKind cards bid
54 | isTwoPair signature = CHand TwoPair cards bid
55 | isOnePair signature = CHand OnePair cards bid
56 | otherwise = CHand HighCard cards bid
57 where signature = sign cards
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 -- numJokers = length jokers
64 nonJokerSigned = reverse $ sort $ fmap (\g -> (length g, g)) $
65 group $ sort nonJokers
67 addJokers :: Signature -> SignatureElement -> Signature
68 addJokers [] js = [js]
69 addJokers ((n, cs):xs) (jn, js) = (n + jn, cs ++ js):xs
71 isFiveOfAKind, isFourOfAKind, isFullHouse, isThreeOfAKind, isTwoPair,
72 isOnePair :: Signature -> Bool
73 isFiveOfAKind ((5, _):_) = True
74 isFiveOfAKind _ = False
76 isFourOfAKind ((4, _):_) = True
77 isFourOfAKind _ = False
79 isFullHouse ((3, _):(2, _):_) = True
82 isThreeOfAKind ((3, _):_) = True
83 isThreeOfAKind _ = False
85 isTwoPair ((2, _):(2, _):_) = True
88 isOnePair ((2, _):_) = True
91 -- isHighCard :: Signature -> Bool
92 -- isHighCard _ = True
94 -- Parse the input file
96 handsP :: Parser [Hand]
100 handsP = handP `sepBy` endOfLine
101 handP = Hand <$> ((many1 cardP) <* space) <*> decimal
103 cardP = (Two <$ "2") <|> (Three <$ "3") <|> (Four <$ "4") <|>
104 (Five <$ "5") <|> (Six <$ "6") <|> (Seven <$ "7") <|>
105 (Eight <$ "8") <|> (Nine <$ "9") <|> (Ten <$ "T") <|>
106 (Jack <$ "J") <|> (Queen <$ "Q") <|> (King <$ "K") <|>
109 successfulParse :: Text -> [Hand]
110 successfulParse input =
111 case parseOnly handsP input of
112 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
113 Right matches -> matches