1 -- Writeup at https://work.njae.me.uk/2021/12/13/advent-of-code-2021-day-13/
4 import qualified Data.Text.IO as TIO
6 import Data.Attoparsec.Text
7 import Control.Applicative
10 import qualified Data.Map as M
12 import qualified Data.MultiSet as MS
13 import qualified Data.Set as S
15 type RuleSet = M.Map String String
16 type PolyPairs = MS.MultiSet String
21 do text <- TIO.readFile "data/advent14.txt"
22 let (template, rules) = successfulParse text
23 print $ part1 rules template
24 print $ part2 rules template
26 part1 :: RuleSet -> String -> Int
27 part1 rules template = (last counts) - (head counts)
28 where result = (simulateNaive rules template) !! 10
29 counts = sort $ map snd $ MS.toOccurList $ MS.fromList result
31 simulateNaive :: RuleSet -> String -> [String]
32 simulateNaive rules polymer = iterate (stepNaive rules) polymer
34 stepNaive :: RuleSet -> String -> String
35 stepNaive rules polymer = merge polymer $ concatMap (rules !) $ mkPairs polymer
37 part2 :: RuleSet -> String -> Int
38 part2 rules template = (last counts) - (head counts)
39 where pairs = MS.fromList $ mkPairs template
40 result = (simulate rules pairs) !! 40
41 elementCounts = countElements result
42 -- counts = sort $ map snd $ MS.toOccurList elementCounts
43 counts = sort $ M.elems elementCounts
45 simulate :: RuleSet -> PolyPairs -> [PolyPairs]
46 simulate rules polymer = iterate (step rules) polymer
48 step :: RuleSet -> PolyPairs -> PolyPairs
49 step rules polymer = MS.union firsts seconds
50 where firsts = MS.map (addFirst rules) polymer
51 seconds = MS.map (addSecond rules) polymer
53 addFirst :: RuleSet -> String -> String
54 addFirst rules pair = a : c
58 addSecond :: RuleSet -> String -> String
59 addSecond rules pair = c ++ [a]
63 -- countElements :: PolyPairs -> MS.MultiSet Char
64 countElements :: PolyPairs -> M.Map Char Int
65 countElements pairs = counts
66 where firsts = MS.map (!!0) pairs
67 seconds = MS.map (!!1) pairs
68 elems = S.union (MS.toSet firsts) (MS.toSet seconds)
69 -- counts = MS.fromMap $ M.map ((`div` 2) . (+ 1)) $ MS.toMap $ MS.union firsts seconds
70 counts = M.map ((`div` 2) . (+ 1)) $ MS.toMap $ MS.union firsts seconds
73 mkPairs :: String -> [String]
74 mkPairs polymer = map stringify $ zip polymer $ tail polymer
75 stringify (a, b) = [a, b]
77 merge :: [a] -> [a] -> [a]
79 merge (x:xs) ys = x : (merge ys xs)
81 -- Parse the input file
83 inputP = (,) <$> (many1 letter) <* many1 endOfLine <*> rulesP
85 rulesP = M.fromList <$> ruleP `sepBy` endOfLine
86 ruleP = (,) <$> many1 letter <* " -> " <*> many1 letter
88 -- successfulParse :: Text -> (Integer, [Maybe Integer])
89 successfulParse input =
90 case parseOnly inputP input of
91 Left _err -> ("", M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err
92 Right indata -> indata