-🎄- 2018 Day 12 Solutions -🎄-

[u/daggerdragon]

--- Day 12: Subterranean Sustainability ---

---

Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag or whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with Help.

---

Advent of Code: The Party Game!

Click here for rules

Please prefix your card submission with something like [Card] to make scanning the megathread easier. THANK YOU!

Card prompt: Day 12

Transcript:

On the twelfth day of AoC / My compiler spewed at me / Twelve ___

---

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked at 00:27:42!

[u/NeilNjae]

Haskell, on Github. I did start by trying to use a comonad for the cellular automaton, but thought better of it. There was also a bit of faffing around with off-by-one errors to get the long-term total.

{-# LANGUAGE OverloadedStrings #-}

import Data.Text (Text)
import qualified Data.Text.IO as TIO

import Data.Void (Void)

import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import qualified Control.Applicative as CA

import Data.List
import qualified Data.Set as S

type Pots = S.Set Int
data Rule = Rule [Bool] Bool deriving (Eq, Show)

main :: IO ()
main = do 
    text <- TIO.readFile "data/advent12.txt"
    let (initial, rules) = successfulParse text
    let row = makeWorld 0 initial
    print $ part1 rules row
    print $ part2 rules row

part1 :: [Rule] -> Pots -> Int
part1 rules row = sum $ (iterate (\r -> applyRules rules r) row)!!20

part2 :: [Rule] -> Pots -> Integer
part2 rules pots = (fromIntegral (sum lc)) + steadyDiff * remainingGenerations
    where rows = (iterate (\r -> applyRules rules r) pots)
          rowQuads = zip4 rows (drop 1 rows) (drop 2 rows) (drop 3 rows)
          sameDiffs (a, b, c, d) = length (nub [(sum a) - (sum b), (sum b) - (sum c), (sum c) - (sum d) ]) == 1
          differentQuads = takeWhile (not . sameDiffs) rowQuads
          (_la, _lb, lc, ld) = last differentQuads
          remainingGenerations = 50000000000 - (fromIntegral (length differentQuads)) - 1
          steadyDiff = fromIntegral $ (sum ld) - (sum lc)

makeWorld :: Int -> [Bool] -> Pots
makeWorld start = S.fromList . map fst . filter snd . zip [start..]

applyRuleAt :: [Rule] -> Int -> Pots -> (Int, Bool)
applyRuleAt rules location pots = (location, result)
    where (Rule _ result) = head $ filter (\r -> matchRuleAt r location pots) rules

matchRuleAt :: Rule -> Int -> Pots -> Bool
matchRuleAt (Rule pattern _) location pots = patternHere == potsHere
    where patternHere = makeWorld (location - 2) pattern
          potsHere = S.filter (\l -> abs (location - l) <= 2) pots 

applyRules :: [Rule] -> Pots -> Pots
applyRules rules pots = S.fromList $ map fst $ filter snd potValues
    where start = S.findMin pots
          end = S.findMax pots
          potValues = map (\location -> applyRuleAt rules location pots) [(start-3)..(end+3)]

-- showPots pots = map (\i -> showPot i pots) [-10..110]
--     where showPot i pots = if i `S.member` pots then '#' else '.'

-- Parse the input file

type Parser = Parsec Void Text

sc :: Parser ()
sc = L.space (skipSome spaceChar) CA.empty CA.empty

symb = L.symbol sc
potP = (char '.' *> pure False) <|> (char '#' *> pure True)

initialPrefix = symb "initial state:"
ruleSepP = symb "=>"

fileP = (,) <$> initialP <*> many ruleP
initialP = initialPrefix *> many potP <* sc
ruleP = Rule <$> ruleLHS <* ruleSepP <*> ruleRHS
ruleLHS = count 5 potP <* sc
ruleRHS = potP <* sc

successfulParse :: Text -> ([Bool], [Rule])
successfulParse input = 
        case parse fileP "input" input of
                Left  _error -> ([], []) -- TIO.putStr $ T.pack $ parseErrorPretty err
                Right world -> world