From 8f8a643512f241b116b6da3cc43d2a9cd7360a42 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Tue, 19 Apr 2022 10:40:34 +0100 Subject: [PATCH] Done day 24 --- advent-of-code21.cabal | 16 ++- advent24/Main.hs | 232 +++++++++++++++++++++++++++++++++++++ advent24/MainDelay.hs | 214 ++++++++++++++++++++++++++++++++++ advent24/MainLax.hs | 212 ++++++++++++++++++++++++++++++++++ data/advent24.txt | 252 +++++++++++++++++++++++++++++++++++++++++ data/advent24a.txt | 5 + data/advent24b.txt | 5 + problems/day24.html | 167 +++++++++++++++++++++++++++ 8 files changed, 1102 insertions(+), 1 deletion(-) create mode 100644 advent24/Main.hs create mode 100644 advent24/MainDelay.hs create mode 100644 advent24/MainLax.hs create mode 100644 data/advent24.txt create mode 100644 data/advent24a.txt create mode 100644 data/advent24b.txt create mode 100644 problems/day24.html diff --git a/advent-of-code21.cabal b/advent-of-code21.cabal index 351c77a..5727015 100644 --- a/advent-of-code21.cabal +++ b/advent-of-code21.cabal @@ -230,4 +230,18 @@ executable advent23prof -Wall -threaded -rtsopts "-with-rtsopts=-N -p -s -hT" - \ No newline at end of file + +executable advent24 + import: common-extensions, build-directives + main-is: advent24/Main.hs + build-depends: text, attoparsec, containers + +executable advent24l + import: common-extensions, build-directives + main-is: advent24/MainLax.hs + build-depends: text, attoparsec, containers + +executable advent24d + import: common-extensions, build-directives + main-is: advent24/MainDelay.hs + build-depends: text, attoparsec, containers diff --git a/advent24/Main.hs b/advent24/Main.hs new file mode 100644 index 0000000..2b85e46 --- /dev/null +++ b/advent24/Main.hs @@ -0,0 +1,232 @@ +-- Writeup at https://work.njae.me.uk/2021/12/29/advent-of-code-2021-day-24/ +-- Based on ideas by Daniel Lin, +-- taken from https://github.com/ephemient/aoc2021/blob/main/hs/src/Day24.hs + +import Debug.Trace + +import Data.Text (Text) +import qualified Data.Text.IO as TIO +import Data.Attoparsec.Text -- hiding (take, takeWhile) +import Control.Applicative +import qualified Data.Map as M +import Data.Map ((!)) +import Data.List +import Control.Monad +import Data.Maybe + +data Register = W | X | Y | Z deriving (Eq, Ord, Show, Enum) + +data Interval = Interval Integer Integer + deriving (Eq, Ord, Show) + +data Argument = Reg Register | Lit Integer + deriving (Eq, Ord, Show) + +data Instruction + = Inp Register + | Add Register Argument + | Mul Register Argument + | Div Register Argument + | Mod Register Argument + | Eql Register Argument + deriving (Eq, Ord, Show) + +type LitMachine = M.Map Register Integer +type IntMachine = M.Map Register (Maybe Interval) + +data ModelMachine = ModelMachine + { mCode :: [Integer] + , mMachine :: LitMachine + } deriving (Show) + +-- Main + +main :: IO () +main = + do text <- TIO.readFile "data/advent24.txt" + let instrs = successfulParse text + let m0 = ModelMachine {mCode = [], mMachine = emptyMachine} + putStrLn $ part1 m0 instrs + putStrLn $ part2 m0 instrs + +part1 :: ModelMachine -> [Instruction] -> String +part1 = findCode [9, 8..1] + +part2 :: ModelMachine -> [Instruction] -> String +part2 = findCode [1..9] + +findCode :: [Integer] -> ModelMachine -> [Instruction] -> String +findCode digits machine instrs = concatMap show $ mCode $ head $ runLit instrs digits machine + +plausible :: [Instruction] -> LitMachine -> Bool +plausible instrs litMachine = feasible ranMachine + where intMachine = intervalify litMachine + ranMachine = runInt instrs intMachine + +feasible :: Maybe IntMachine -> Bool +feasible Nothing = False +feasible (Just machine) = isJust z && a <= 0 && b >= 0 + where z = machine ! Z + Just (Interval a b) = z + + + +-- feasible :: IntMachine -> Bool +-- -- feasible machine | trace ("Feasible " ++ (show machine)) False = undefined +-- feasible machine +-- | (w && x && y && isJust z) = a <= 0 && b >= 0 +-- | otherwise = False +-- where w = isJust $ machine ! W +-- x = isJust $ machine ! X +-- y = isJust $ machine ! Y +-- z = machine ! Z +-- Just (Interval a b) = z + +valid :: ModelMachine -> Bool +valid (ModelMachine{..}) = (mMachine ! Z) == 0 + + +emptyMachine :: LitMachine +emptyMachine = M.fromList [(r, 0) | r <- [W .. Z]] + +intervalify :: LitMachine -> IntMachine +intervalify = M.map (\i -> Just (Interval i i)) + + +runLit :: [Instruction] -> [Integer] -> ModelMachine -> [ModelMachine] +-- runLit instrs _digits m0 | trace ((show $ length instrs) ++ " " ++ (show m0)) False = undefined +-- runLit [] _digits machine | trace (show machine) True = [machine] +runLit [] _ machine = [machine] +runLit (Inp reg : instrs) digits (ModelMachine {..}) = + do guard (plausible (Inp reg : instrs) mMachine) + i <- digits + let m1 = M.insert reg i mMachine + mm2 <- runLit instrs digits (ModelMachine { mCode = mCode ++ [i], mMachine = m1}) + guard (valid mm2) + return mm2 +runLit (Add reg arg : instrs) digits (ModelMachine {..}) = + runLit instrs digits (ModelMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a + b +runLit (Mul reg arg : instrs) digits (ModelMachine {..}) = + runLit instrs digits (ModelMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a * b +runLit (Div reg arg : instrs) digits (ModelMachine {..}) = + runLit instrs digits (ModelMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a `quot` b +runLit (Mod reg arg : instrs) digits (ModelMachine {..}) = + runLit instrs digits (ModelMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a `rem` b +runLit (Eql reg arg : instrs) digits (ModelMachine {..}) = + runLit instrs digits (ModelMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = if a == b then 1 else 0 + + +runInt :: [Instruction] -> IntMachine -> Maybe IntMachine +runInt instrs machine = foldl' interpretInt (Just machine) instrs + +interpretInt :: Maybe IntMachine -> Instruction -> Maybe IntMachine +-- interpretInt machine instr | trace ("iInt " ++ (show instr) ++ " " ++ (show machine)) False = undefined +interpretInt Nothing _ = Nothing +interpretInt (Just machine) (Inp reg) = Just $ M.insert reg (Just (Interval 1 9)) machine +interpretInt (Just machine) (Add reg arg) + | isJust a && isJust b = Just $ M.insert reg c machine + | otherwise = Nothing + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (+:) <$> a <*> b +interpretInt (Just machine) (Mul reg arg) + | isJust a && isJust b = Just $ M.insert reg c machine + | otherwise = Nothing + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (*:) <$> a <*> b +interpretInt (Just machine) (Div reg arg) + | isJust a && isJust b = Just $ M.insert reg c machine + | otherwise = Nothing + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (/:) <$> a <*> b +interpretInt (Just machine) (Mod reg arg) + | isJust a && isJust b = Just $ M.insert reg c machine + | otherwise = Nothing + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (%:) <$> a <*> b +interpretInt (Just machine) (Eql reg arg) + | isJust a && isJust b = Just $ M.insert reg c machine + | otherwise = Nothing + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (=:) <$> a <*> b + +(+:), (*:), (/:), (%:), (=:) :: Interval -> Interval -> Maybe Interval +(Interval a b) +: (Interval c d) = Just (Interval (a + c) (b + d)) +(Interval a b) *: (Interval c d) + | a >= 0 && c >= 0 = Just ( Interval (a * c) (b * d) ) + | b <= 0 && d <= 0 = Just ( Interval (b * d) (a * c) ) + | a >= 0 && d <= 0 = Just ( Interval (a * d) (b * c) ) + | b <= 0 && c >= 0 = Just ( Interval (b * c) (a * d) ) +(Interval a b) /: (Interval c d) + | c > 0 = Just ( Interval (a `quot` d) (b `quot` c) ) + | d < 0 = Just ( Interval (a `quot` c) (b `quot` d) ) + | otherwise = Nothing +(Interval _a _b) %: (Interval c d) + | c > 0 = Just ( Interval 0 (d - 1)) + | otherwise = Nothing +(Interval a b) =: (Interval c d) + | b < c = Just (Interval 0 0) + | a > d = Just (Interval 0 0) + | a == b && a == c && a == d = Just (Interval 1 1) + | otherwise = Just (Interval 0 1) + + +evaluateLit :: Argument -> LitMachine -> Integer +evaluateLit (Reg reg) machine = machine ! reg +evaluateLit (Lit n) _ = n + +evaluateInt :: Argument -> IntMachine -> Maybe Interval +evaluateInt (Reg reg) machine = machine ! reg +evaluateInt (Lit n) _ = Just (Interval n n) + + +-- Parse the input file + +instructionsP:: Parser [Instruction] +instructionsP = instructionP `sepBy` endOfLine + +instructionP:: Parser Instruction +instructionP = choice [inpP, addP, mulP, divP, modP, eqlP] + +inpP, addP, mulP, divP, modP, eqlP :: Parser Instruction +inpP = Inp <$> ("inp " *> registerP) +addP = Add <$> ("add " *> registerP) <*> (" " *> argumentP) +mulP = Mul <$> ("mul " *> registerP) <*> (" " *> argumentP) +divP = Div <$> ("div " *> registerP) <*> (" " *> argumentP) +modP = Mod <$> ("mod " *> registerP) <*> (" " *> argumentP) +eqlP = Eql <$> ("eql " *> registerP) <*> (" " *> argumentP) + +registerP, wP, xP, yP, zP :: Parser Register +registerP = choice [wP, xP, yP, zP] +wP = "w" *> pure W +xP = "x" *> pure X +yP = "y" *> pure Y +zP = "z" *> pure Z + +argumentP :: Parser Argument +argumentP = (Reg <$> registerP) <|> (Lit <$> signed decimal) + +successfulParse :: Text -> [Instruction] +successfulParse input = + case parseOnly instructionsP input of + Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right instrs -> instrs diff --git a/advent24/MainDelay.hs b/advent24/MainDelay.hs new file mode 100644 index 0000000..fc65f3c --- /dev/null +++ b/advent24/MainDelay.hs @@ -0,0 +1,214 @@ +-- Writeup at https://work.njae.me.uk/2021/12/29/advent-of-code-2021-day-24/ +-- Based on ideas by Daniel Lin, +-- taken from https://github.com/ephemient/aoc2021/blob/main/hs/src/Day24.hs + +import Debug.Trace + +import Data.Text (Text) +import qualified Data.Text.IO as TIO +import Data.Attoparsec.Text -- hiding (take, takeWhile) +import Control.Applicative +import qualified Data.Map as M +import Data.Map ((!)) +import Data.List +import Control.Monad +import Data.Maybe + +data Register = W | X | Y | Z deriving (Eq, Ord, Show, Enum) + +data Interval = Interval Integer Integer + deriving (Eq, Ord, Show) + +data Argument = Reg Register | Lit Integer + deriving (Eq, Ord, Show) + +data Instruction + = Inp Register + | Add Register Argument + | Mul Register Argument + | Div Register Argument + | Mod Register Argument + | Eql Register Argument + deriving (Eq, Ord, Show) + +type LiteralMachine = M.Map Register Integer +type IntervalMachine = M.Map Register (Maybe Interval) + +data CodeMachine = CodeMachine + { mCode :: [Integer] + , mMachine :: LiteralMachine + } deriving (Show) + +-- Main + +main :: IO () +main = + do text <- TIO.readFile "data/advent24.txt" + let instrs = successfulParse text + let m0 = CodeMachine {mCode = [], mMachine = emptyMachine} + putStrLn $ part1 m0 instrs + putStrLn $ part2 m0 instrs + +part1 :: CodeMachine -> [Instruction] -> String +part1 = findCode [9, 8..1] + +part2 :: CodeMachine -> [Instruction] -> String +part2 = findCode [1..9] + +findCode :: [Integer] -> CodeMachine -> [Instruction] -> String +findCode digits machine instrs = concatMap show $ mCode $ head $ runLit instrs digits machine + +plausible :: [Instruction] -> LiteralMachine -> Bool +plausible instrs litMachine = feasible ranMachine + where intMachine = intervalify litMachine + ranMachine = runInt instrs intMachine + +feasible :: IntervalMachine -> Bool +-- feasible machine | trace ("Feasible " ++ (show machine)) False = undefined +feasible machine + | (w && x && y && isJust z) = a <= 0 && b >= 0 + | otherwise = False + where w = isJust $ machine ! W + x = isJust $ machine ! X + y = isJust $ machine ! Y + z = machine ! Z + Just (Interval a b) = z + +valid :: CodeMachine -> Bool +valid (CodeMachine{..}) = (mMachine ! Z) == 0 + + +emptyMachine :: LiteralMachine +emptyMachine = M.fromList [(r, 0) | r <- [W .. Z]] + +intervalify :: LiteralMachine -> IntervalMachine +intervalify = M.map (\i -> Just (Interval i i)) + + +runLit :: [Instruction] -> [Integer] -> CodeMachine -> [CodeMachine] +-- runLit instrs _digits m0 | trace ((show $ length instrs) ++ " " ++ (show m0)) False = undefined +runLit [] _ machine = [machine] +runLit (Inp reg : instrs) digits (CodeMachine {..}) = + do -- guard (plausible (Inp reg : instrs) mMachine) + i <- digits + let m1 = M.insert reg i mMachine + guard (plausible instrs m1) + mm2 <- runLit instrs digits (CodeMachine { mCode = mCode ++ [i], mMachine = m1}) + guard (valid mm2) + return mm2 +runLit (Add reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a + b +runLit (Mul reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a * b +runLit (Div reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a `quot` b +runLit (Mod reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a `rem` b +runLit (Eql reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = if a == b then 1 else 0 + + +runInt :: [Instruction] -> IntervalMachine -> IntervalMachine +runInt instrs machine = foldl' interpretInt machine instrs + +interpretInt :: IntervalMachine -> Instruction -> IntervalMachine +-- interpretInt machine instr | trace ("iInt " ++ (show instr) ++ " " ++ (show machine)) False = undefined +interpretInt machine (Inp reg) = M.insert reg (Just (Interval 1 9)) machine +interpretInt machine (Add reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (+:) <$> a <*> b + -- c = join $ (liftM2 (+:)) a b +interpretInt machine (Mul reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (*:) <$> a <*> b +interpretInt machine (Div reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (/:) <$> a <*> b +interpretInt machine (Mod reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (%:) <$> a <*> b +interpretInt machine (Eql reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (=:) <$> a <*> b + +(+:), (*:), (/:), (%:), (=:) :: Interval -> Interval -> Maybe Interval +(Interval a b) +: (Interval c d) = Just (Interval (a + c) (b + d)) +(Interval a b) *: (Interval c d) + | a >= 0 && c >= 0 = Just ( Interval (a * c) (b * d) ) + | b <= 0 && d <= 0 = Just ( Interval (b * d) (a * c) ) + | a >= 0 && d <= 0 = Just ( Interval (a * d) (b * c) ) + | b <= 0 && c >= 0 = Just ( Interval (b * c) (a * d) ) +(Interval a b) /: (Interval c d) + | c > 0 = Just ( Interval (a `quot` d) (b `quot` c) ) + | d < 0 = Just ( Interval (a `quot` c) (b `quot` d) ) + | otherwise = Nothing +(Interval _a _b) %: (Interval c d) + | c > 0 && c == d = Just ( Interval 0 (c - 1)) + | c > 0 && c /= d = Just ( Interval 0 (max (c - 1) (d - 1))) + | otherwise = Nothing +(Interval a b) =: (Interval c d) + | b < c = Just (Interval 0 0) + | a > d = Just (Interval 0 0) + | a == b && a == c && a == d = Just (Interval 1 1) + | otherwise = Just (Interval 0 1) + +evaluateLit :: Argument -> LiteralMachine -> Integer +evaluateLit (Reg reg) machine = machine ! reg +evaluateLit (Lit n) _ = n + +evaluateInt :: Argument -> IntervalMachine -> Maybe Interval +evaluateInt (Reg reg) machine = machine ! reg +evaluateInt (Lit n) _ = Just (Interval n n) + + +-- Parse the input file + +instructionsP:: Parser [Instruction] +instructionsP = instructionP `sepBy` endOfLine + +instructionP:: Parser Instruction +instructionP = choice [inpP, addP, mulP, divP, modP, eqlP] + +inpP, addP, mulP, divP, modP, eqlP :: Parser Instruction +inpP = Inp <$> ("inp " *> registerP) +addP = Add <$> ("add " *> registerP) <*> (" " *> argumentP) +mulP = Mul <$> ("mul " *> registerP) <*> (" " *> argumentP) +divP = Div <$> ("div " *> registerP) <*> (" " *> argumentP) +modP = Mod <$> ("mod " *> registerP) <*> (" " *> argumentP) +eqlP = Eql <$> ("eql " *> registerP) <*> (" " *> argumentP) + +registerP, wP, xP, yP, zP :: Parser Register +registerP = choice [wP, xP, yP, zP] +wP = "w" *> pure W +xP = "x" *> pure X +yP = "y" *> pure Y +zP = "z" *> pure Z + +argumentP :: Parser Argument +argumentP = (Reg <$> registerP) <|> (Lit <$> signed decimal) + +successfulParse :: Text -> [Instruction] +successfulParse input = + case parseOnly instructionsP input of + Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right instrs -> instrs diff --git a/advent24/MainLax.hs b/advent24/MainLax.hs new file mode 100644 index 0000000..2dc91cd --- /dev/null +++ b/advent24/MainLax.hs @@ -0,0 +1,212 @@ +-- Writeup at https://work.njae.me.uk/2021/12/29/advent-of-code-2021-day-24/ +-- Based on ideas by Daniel Lin, +-- taken from https://github.com/ephemient/aoc2021/blob/main/hs/src/Day24.hs + +import Debug.Trace + +import Data.Text (Text) +import qualified Data.Text.IO as TIO +import Data.Attoparsec.Text -- hiding (take, takeWhile) +import Control.Applicative +import qualified Data.Map as M +import Data.Map ((!)) +import Data.List +import Control.Monad +import Data.Maybe + +data Register = W | X | Y | Z deriving (Eq, Ord, Show, Enum) + +data Interval = Interval Integer Integer + deriving (Eq, Ord, Show) + +data Argument = Reg Register | Lit Integer + deriving (Eq, Ord, Show) + +data Instruction + = Inp Register + | Add Register Argument + | Mul Register Argument + | Div Register Argument + | Mod Register Argument + | Eql Register Argument + deriving (Eq, Ord, Show) + +type LiteralMachine = M.Map Register Integer +type IntervalMachine = M.Map Register (Maybe Interval) + +data CodeMachine = CodeMachine + { mCode :: [Integer] + , mMachine :: LiteralMachine + } deriving (Show) + +-- Main + +main :: IO () +main = + do text <- TIO.readFile "data/advent24.txt" + let instrs = successfulParse text + let m0 = CodeMachine {mCode = [], mMachine = emptyMachine} + putStrLn $ part1 m0 instrs + putStrLn $ part2 m0 instrs + +part1 :: CodeMachine -> [Instruction] -> String +part1 = findCode [9, 8..1] + +part2 :: CodeMachine -> [Instruction] -> String +part2 = findCode [1..9] + +findCode :: [Integer] -> CodeMachine -> [Instruction] -> String +findCode digits machine instrs = concatMap show $ mCode $ head $ runLit instrs digits machine + +plausible :: [Instruction] -> LiteralMachine -> Bool +plausible instrs litMachine = feasible ranMachine + where intMachine = intervalify litMachine + ranMachine = runInt instrs intMachine + +feasible :: IntervalMachine -> Bool +-- feasible machine | trace ("Feasible " ++ (show machine)) False = undefined +feasible machine + | (w && x && y && isJust z) = a <= 0 && b >= 0 + | otherwise = False + where w = isJust $ machine ! W + x = isJust $ machine ! X + y = isJust $ machine ! Y + z = machine ! Z + Just (Interval a b) = z + +valid :: CodeMachine -> Bool +valid (CodeMachine{..}) = (mMachine ! Z) == 0 + + +emptyMachine :: LiteralMachine +emptyMachine = M.fromList [(r, 0) | r <- [W .. Z]] + +intervalify :: LiteralMachine -> IntervalMachine +intervalify = M.map (\i -> Just (Interval i i)) + + +runLit :: [Instruction] -> [Integer] -> CodeMachine -> [CodeMachine] +-- runLit instrs _digits m0 | trace ((show $ length instrs) ++ " " ++ (show m0)) False = undefined +runLit [] _ machine = [machine] +runLit (Inp reg : instrs) digits (CodeMachine {..}) = + do guard (plausible (Inp reg : instrs) mMachine) + i <- digits + let m1 = M.insert reg i mMachine + mm2 <- runLit instrs digits (CodeMachine { mCode = mCode ++ [i], mMachine = m1}) + guard (valid mm2) + return mm2 +runLit (Add reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a + b +runLit (Mul reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a * b +runLit (Div reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a `quot` b +runLit (Mod reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = a `rem` b +runLit (Eql reg arg : instrs) digits (CodeMachine {..}) = + runLit instrs digits (CodeMachine{mMachine = M.insert reg c mMachine, ..}) + where a = mMachine ! reg + b = evaluateLit arg mMachine + c = if a == b then 1 else 0 + + +runInt :: [Instruction] -> IntervalMachine -> IntervalMachine +runInt instrs machine = foldl' interpretInt machine instrs + +interpretInt :: IntervalMachine -> Instruction -> IntervalMachine +-- interpretInt machine instr | trace ("iInt " ++ (show instr) ++ " " ++ (show machine)) False = undefined +interpretInt machine (Inp reg) = M.insert reg (Just (Interval 1 9)) machine +interpretInt machine (Add reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (+:) <$> a <*> b + -- c = join $ (liftM2 (+:)) a b +interpretInt machine (Mul reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (*:) <$> a <*> b +interpretInt machine (Div reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (/:) <$> a <*> b +interpretInt machine (Mod reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (%:) <$> a <*> b +interpretInt machine (Eql reg arg) = M.insert reg c machine + where a = machine ! reg + b = evaluateInt arg machine + c = join $ (=:) <$> a <*> b + +(+:), (*:), (/:), (%:), (=:) :: Interval -> Interval -> Maybe Interval +(Interval a b) +: (Interval c d) = Just (Interval (a + c) (b + d)) +(Interval a b) *: (Interval c d) + | a >= 0 && c >= 0 = Just ( Interval (a * c) (b * d) ) + | b <= 0 && d <= 0 = Just ( Interval (b * d) (a * c) ) + | a >= 0 && d <= 0 = Just ( Interval (a * d) (b * c) ) + | b <= 0 && c >= 0 = Just ( Interval (b * c) (a * d) ) +(Interval a b) /: (Interval c d) + | c > 0 = Just ( Interval (a `quot` d) (b `quot` c) ) + | d < 0 = Just ( Interval (a `quot` c) (b `quot` d) ) + | otherwise = Nothing +(Interval _a _b) %: (Interval c d) + | c > 0 = Just ( Interval 0 (d - 1)) + | otherwise = Nothing +(Interval a b) =: (Interval c d) + | b < c = Just (Interval 0 0) + | a > d = Just (Interval 0 0) + | a == b && a == c && a == d = Just (Interval 1 1) + | otherwise = Just (Interval 0 1) + +evaluateLit :: Argument -> LiteralMachine -> Integer +evaluateLit (Reg reg) machine = machine ! reg +evaluateLit (Lit n) _ = n + +evaluateInt :: Argument -> IntervalMachine -> Maybe Interval +evaluateInt (Reg reg) machine = machine ! reg +evaluateInt (Lit n) _ = Just (Interval n n) + + +-- Parse the input file + +instructionsP:: Parser [Instruction] +instructionsP = instructionP `sepBy` endOfLine + +instructionP:: Parser Instruction +instructionP = choice [inpP, addP, mulP, divP, modP, eqlP] + +inpP, addP, mulP, divP, modP, eqlP :: Parser Instruction +inpP = Inp <$> ("inp " *> registerP) +addP = Add <$> ("add " *> registerP) <*> (" " *> argumentP) +mulP = Mul <$> ("mul " *> registerP) <*> (" " *> argumentP) +divP = Div <$> ("div " *> registerP) <*> (" " *> argumentP) +modP = Mod <$> ("mod " *> registerP) <*> (" " *> argumentP) +eqlP = Eql <$> ("eql " *> registerP) <*> (" " *> argumentP) + +registerP, wP, xP, yP, zP :: Parser Register +registerP = choice [wP, xP, yP, zP] +wP = "w" *> pure W +xP = "x" *> pure X +yP = "y" *> pure Y +zP = "z" *> pure Z + +argumentP :: Parser Argument +argumentP = (Reg <$> registerP) <|> (Lit <$> signed decimal) + +successfulParse :: Text -> [Instruction] +successfulParse input = + case parseOnly instructionsP input of + Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right instrs -> instrs diff --git a/data/advent24.txt b/data/advent24.txt new file mode 100644 index 0000000..baaee40 --- /dev/null +++ b/data/advent24.txt @@ -0,0 +1,252 @@ +inp w +mul x 0 +add x z +mod x 26 +div z 1 +add x 12 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 4 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 1 +add x 11 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 10 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 1 +add x 14 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 12 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 26 +add x -6 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 14 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 1 +add x 15 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 6 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 1 +add x 12 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 16 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 26 +add x -9 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 1 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 1 +add x 14 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 7 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 1 +add x 14 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 8 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 26 +add x -5 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 11 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 26 +add x -9 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 8 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 26 +add x -5 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 3 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 26 +add x -2 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 1 +mul y x +add z y +inp w +mul x 0 +add x z +mod x 26 +div z 26 +add x -7 +eql x w +eql x 0 +mul y 0 +add y 25 +mul y x +add y 1 +mul z y +mul y 0 +add y w +add y 8 +mul y x +add z y \ No newline at end of file diff --git a/data/advent24a.txt b/data/advent24a.txt new file mode 100644 index 0000000..844ab0d --- /dev/null +++ b/data/advent24a.txt @@ -0,0 +1,5 @@ +inp w +add z w +add z 2 +mod z 3 +add z -1 diff --git a/data/advent24b.txt b/data/advent24b.txt new file mode 100644 index 0000000..b60d5e0 --- /dev/null +++ b/data/advent24b.txt @@ -0,0 +1,5 @@ +inp z +mod z 4 +inp w +sub w 3 +eql z w diff --git a/problems/day24.html b/problems/day24.html new file mode 100644 index 0000000..d5aeec8 --- /dev/null +++ b/problems/day24.html @@ -0,0 +1,167 @@ + + + + +Day 24 - Advent of Code 2021 + + + + + + + + +

Advent of Code

Neil Smith (AoC++) 48*

      /^2021$/

+ + + +
+

--- Day 24: Arithmetic Logic Unit ---

Magic smoke starts leaking from the submarine's arithmetic logic unit (ALU). Without the ability to perform basic arithmetic and logic functions, the submarine can't produce cool patterns with its Christmas lights!

+

It also can't navigate. Or run the oxygen system.

+

Don't worry, though - you probably have enough oxygen left to give you enough time to build a new ALU.

+

The ALU is a four-dimensional processing unit: it has integer variables w, x, y, and z. These variables all start with the value 0. The ALU also supports six instructions:

+
    +
  • inp a - Read an input value and write it to variable a.
    • +
  • add a b - Add the value of a to the value of b, then store the result in variable a.
    • +
  • mul a b - Multiply the value of a by the value of b, then store the result in variable a.
    • +
  • div a b - Divide the value of a by the value of b, truncate the result to an integer, then store the result in variable a. (Here, "truncate" means to round the value toward zero.)
    • +
  • mod a b - Divide the value of a by the value of b, then store the remainder in variable a. (This is also called the modulo operation.)
    • +
  • eql a b - If the value of a and b are equal, then store the value 1 in variable a. Otherwise, store the value 0 in variable a.
    • +
+

In all of these instructions, a and b are placeholders; a will always be the variable where the result of the operation is stored (one of w, x, y, or z), while b can be either a variable or a number. Numbers can be positive or negative, but will always be integers.

+

The ALU has no jump instructions; in an ALU program, every instruction is run exactly once in order from top to bottom. The program halts after the last instruction has finished executing.

+

(Program authors should be especially cautious; attempting to execute div with b=0 or attempting to execute mod with a<0 or b<=0 will cause the program to crash and might even damage the ALU. These operations are never intended in any serious ALU program.)

+

For example, here is an ALU program which takes an input number, negates it, and stores it in x:

+
inp x
+mul x -1
+
+

Here is an ALU program which takes two input numbers, then sets z to 1 if the second input number is three times larger than the first input number, or sets z to 0 otherwise:

+
inp z
+inp x
+mul z 3
+eql z x
+
+

Here is an ALU program which takes a non-negative integer as input, converts it into binary, and stores the lowest (1's) bit in z, the second-lowest (2's) bit in y, the third-lowest (4's) bit in x, and the fourth-lowest (8's) bit in w:

+
inp w
+add z w
+mod z 2
+div w 2
+add y w
+mod y 2
+div w 2
+add x w
+mod x 2
+div w 2
+mod w 2
+
+

Once you have built a replacement ALU, you can install it in the submarine, which will immediately resume what it was doing when the ALU failed: validating the submarine's model number. To do this, the ALU will run the MOdel Number Automatic Detector program (MONAD, your puzzle input).

+

Submarine model numbers are always fourteen-digit numbers consisting only of digits 1 through 9. The digit 0 cannot appear in a model number.

+

When MONAD checks a hypothetical fourteen-digit model number, it uses fourteen separate inp instructions, each expecting a single digit of the model number in order of most to least significant. (So, to check the model number 13579246899999, you would give 1 to the first inp instruction, 3 to the second inp instruction, 5 to the third inp instruction, and so on.) This means that when operating MONAD, each input instruction should only ever be given an integer value of at least 1 and at most 9.

+

Then, after MONAD has finished running all of its instructions, it will indicate that the model number was valid by leaving a 0 in variable z. However, if the model number was invalid, it will leave some other non-zero value in z.

+

MONAD imposes additional, mysterious restrictions on model numbers, and legend says the last copy of the MONAD documentation was eaten by a tanuki. You'll need to figure out what MONAD does some other way.

+

To enable as many submarine features as possible, find the largest valid fourteen-digit model number that contains no 0 digits. What is the largest model number accepted by MONAD?

+
+

Your puzzle answer was 91398299697996.

--- Part Two ---

As the submarine starts booting up things like the Retro Encabulator, you realize that maybe you don't need all these submarine features after all.

+

What is the smallest model number accepted by MONAD?

+
+

Your puzzle answer was 41171183141291.

Both parts of this puzzle are complete! They provide two gold stars: **

+

At this point, you should return to your Advent calendar and try another puzzle.

+

If you still want to see it, you can get your puzzle input.

+

You can also this puzzle.

+
+ + + + + + \ No newline at end of file -- 2.34.1