1 {-# LANGUAGE OverloadedStrings #-}
3 import Data.Text (Text)
4 import qualified Data.Text.IO as TIO
6 import Data.Void (Void)
9 import Text.Megaparsec.Char
10 import qualified Text.Megaparsec.Char.Lexer as L
11 import qualified Control.Applicative as CA
14 import qualified Data.Set as S
17 data Rule = Rule [Bool] Bool deriving (Eq, Show)
21 text <- TIO.readFile "data/advent12.txt"
22 let (initial, rules) = successfulParse text
23 let row = makeWorld 0 initial
24 print $ part1 rules row
25 print $ part2 rules row
27 part1 :: [Rule] -> Pots -> Int
28 part1 rules row = sum $ (iterate (\r -> applyRules rules r) row)!!20
31 part2 :: [Rule] -> Pots -> Integer
32 -- part2 rules pots = (length differentQuads, steadyDiff, sum la, sum lb, sum lc, sum ld)-- (fromIntegral (sum la)) + steadyDiff * remainingGenerations
33 part2 rules pots = (fromIntegral (sum lc)) + steadyDiff * remainingGenerations
34 where rows = (iterate (\r -> applyRules rules r) pots)
35 rowQuads = zip4 rows (drop 1 rows) (drop 2 rows) (drop 3 rows)
36 sameDiffs (a, b, c, d) = length (nub [(sum a) - (sum b), (sum b) - (sum c), (sum c) - (sum d) ]) == 1
37 differentQuads = takeWhile (not . sameDiffs) rowQuads
38 (_la, _lb, lc, ld) = last differentQuads
39 remainingGenerations = 50000000000 - (fromIntegral (length differentQuads)) - 1
40 steadyDiff = fromIntegral $ (sum ld) - (sum lc)
43 makeWorld :: Int -> [Bool] -> Pots
44 makeWorld start = S.fromList . map fst . filter snd . zip [start..]
46 applyRuleAt :: [Rule] -> Int -> Pots -> (Int, Bool)
47 applyRuleAt rules location pots = (location, result)
48 where (Rule _ result) = head $ filter (\r -> matchRuleAt r location pots) rules
50 matchRuleAt :: Rule -> Int -> Pots -> Bool
51 matchRuleAt (Rule pattern _) location pots = patternHere == potsHere
52 where patternHere = makeWorld (location - 2) pattern
53 potsHere = S.filter (\l -> abs (location - l) <= 2) pots
56 applyRules :: [Rule] -> Pots -> Pots
57 applyRules rules pots = S.fromList $ map fst $ filter snd potValues
58 where start = S.findMin pots
60 potValues = map (\location -> applyRuleAt rules location pots) [(start-3)..(end+3)]
62 -- showPots pots = map (\i -> showPot i pots) [-10..110]
63 -- where showPot i pots = if i `S.member` pots then '#' else '.'
66 -- Parse the input file
68 type Parser = Parsec Void Text
71 sc = L.space (skipSome spaceChar) CA.empty CA.empty
74 potP = (char '.' *> pure False) <|> (char '#' *> pure True)
76 initialPrefix = symb "initial state:"
79 fileP = (,) <$> initialP <*> many ruleP
80 initialP = initialPrefix *> many potP <* sc
81 ruleP = Rule <$> ruleLHS <* ruleSepP <*> ruleRHS
82 ruleLHS = count 5 potP <* sc
85 successfulParse :: Text -> ([Bool], [Rule])
86 successfulParse input =
87 case parse fileP "input" input of
88 Left _error -> ([], []) -- TIO.putStr $ T.pack $ parseErrorPretty err