From: Neil Smith <neil.git@njae.me.uk> Date: Tue, 19 Apr 2022 09:40:34 +0000 (+0100) Subject: Done day 24 X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=8f8a643512f241b116b6da3cc43d2a9cd7360a42;p=advent-of-code-21.git Done day 24 --- 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 @@ +<!DOCTYPE html> +<html lang="en-us"> +<head> +<meta charset="utf-8"/> +<title>Day 24 - Advent of Code 2021</title> +<!--[if lt IE 9]><script src="/static/html5.js"></script><![endif]--> +<link href='//fonts.googleapis.com/css?family=Source+Code+Pro:300&subset=latin,latin-ext' rel='stylesheet' type='text/css'/> +<link rel="stylesheet" type="text/css" href="/static/style.css?28"/> +<link rel="stylesheet alternate" type="text/css" href="/static/highcontrast.css?0" title="High Contrast"/> +<link rel="shortcut icon" href="/favicon.png"/> +<script>window.addEventListener('click', function(e,s,r){if(e.target.nodeName==='CODE'&&e.detail===3){s=window.getSelection();s.removeAllRanges();r=document.createRange();r.selectNodeContents(e.target);s.addRange(r);}});</script> +</head><!-- + + + + +Oh, hello! Funny seeing you here. + +I appreciate your enthusiasm, but you aren't going to find much down here. +There certainly aren't clues to any of the puzzles. The best surprises don't +even appear in the source until you unlock them for real. + +Please be careful with automated requests; I'm not a massive company, and I can +only take so much traffic. Please be considerate so that everyone gets to play. + +If you're curious about how Advent of Code works, it's running on some custom +Perl code. Other than a few integrations (auth, analytics, social media), I +built the whole thing myself, including the design, animations, prose, and all +of the puzzles. + +The puzzles are most of the work; preparing a new calendar and a new set of +puzzles each year takes all of my free time for 4-5 months. A lot of effort +went into building this thing - I hope you're enjoying playing it as much as I +enjoyed making it for you! + +If you'd like to hang out, I'm @ericwastl on Twitter. + +- Eric Wastl + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +--> +<body> +<header><div><h1 class="title-global"><a href="/">Advent of Code</a></h1><nav><ul><li><a href="/2021/about">[About]</a></li><li><a href="/2021/events">[Events]</a></li><li><a href="https://teespring.com/stores/advent-of-code" target="_blank">[Shop]</a></li><li><a href="/2021/settings">[Settings]</a></li><li><a href="/2021/auth/logout">[Log Out]</a></li></ul></nav><div class="user">Neil Smith <a href="/2021/support" class="supporter-badge" title="Advent of Code Supporter">(AoC++)</a> <span class="star-count">48*</span></div></div><div><h1 class="title-event"> <span class="title-event-wrap">/^</span><a href="/2021">2021</a><span class="title-event-wrap">$/</span></h1><nav><ul><li><a href="/2021">[Calendar]</a></li><li><a href="/2021/support">[AoC++]</a></li><li><a href="/2021/sponsors">[Sponsors]</a></li><li><a href="/2021/leaderboard">[Leaderboard]</a></li><li><a href="/2021/stats">[Stats]</a></li></ul></nav></div></header> + +<div id="sidebar"> +<div id="sponsor"><div class="quiet">Our <a href="/2021/sponsors">sponsors</a> help make Advent of Code possible:</div><div class="sponsor"><a href="https://2021-aoc-templates.util.repl.co/" target="_blank" onclick="if(ga)ga('send','event','sponsor','sidebar',this.href);" rel="noopener">Replit</a> - Code and host in your browser with no setup in Python, React, Kaboom.js, Java, C, Nix, you name it, even Solidity. Happy coding!</div></div> +</div><!--/sidebar--> + +<main> +<article class="day-desc"><h2>--- Day 24: Arithmetic Logic Unit ---</h2><p><a href="https://en.wikipedia.org/wiki/Magic_smoke" target="_blank">Magic smoke</a> starts leaking from the submarine's <a href="https://en.wikipedia.org/wiki/Arithmetic_logic_unit">arithmetic logic unit</a> (ALU). Without the ability to perform basic arithmetic and logic functions, the submarine can't produce cool patterns with its Christmas lights!</p> +<p>It also can't navigate. Or run the oxygen system.</p> +<p>Don't worry, though - you <em>probably</em> have enough oxygen left to give you enough time to build a new ALU.</p> +<p>The ALU is a four-dimensional processing unit: it has integer variables <code>w</code>, <code>x</code>, <code>y</code>, and <code>z</code>. These variables all start with the value <code>0</code>. The ALU also supports <em>six instructions</em>:</p> +<ul> +<li><code>inp a</code> - Read an input value and write it to variable <code>a</code>.</li> +<li><code>add a b</code> - Add the value of <code>a</code> to the value of <code>b</code>, then store the result in variable <code>a</code>.</li> +<li><code>mul a b</code> - Multiply the value of <code>a</code> by the value of <code>b</code>, then store the result in variable <code>a</code>.</li> +<li><code>div a b</code> - Divide the value of <code>a</code> by the value of <code>b</code>, truncate the result to an integer, then store the result in variable <code>a</code>. (Here, "truncate" means to round the value toward zero.)</li> +<li><code>mod a b</code> - Divide the value of <code>a</code> by the value of <code>b</code>, then store the <em>remainder</em> in variable <code>a</code>. (This is also called the <a href="https://en.wikipedia.org/wiki/Modulo_operation" target="_blank">modulo</a> operation.)</li> +<li><code>eql a b</code> - If the value of <code>a</code> and <code>b</code> are equal, then store the value <code>1</code> in variable <code>a</code>. Otherwise, store the value <code>0</code> in variable <code>a</code>.</li> +</ul> +<p>In all of these instructions, <code>a</code> and <code>b</code> are placeholders; <code>a</code> will always be the variable where the result of the operation is stored (one of <code>w</code>, <code>x</code>, <code>y</code>, or <code>z</code>), while <code>b</code> can be either a variable or a number. Numbers can be positive or negative, but will always be integers.</p> +<p>The ALU has no <em>jump</em> 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.</p> +<p>(Program authors should be especially cautious; attempting to execute <code>div</code> with <code>b=0</code> or attempting to execute <code>mod</code> with <code>a<0</code> or <code>b<=0</code> will cause the program to crash and might even <span title="Maybe this is what happened to the last one.">damage the ALU</span>. These operations are never intended in any serious ALU program.)</p> +<p>For example, here is an ALU program which takes an input number, negates it, and stores it in <code>x</code>:</p> +<pre><code>inp x +mul x -1 +</code></pre> +<p>Here is an ALU program which takes two input numbers, then sets <code>z</code> to <code>1</code> if the second input number is three times larger than the first input number, or sets <code>z</code> to <code>0</code> otherwise:</p> +<pre><code>inp z +inp x +mul z 3 +eql z x +</code></pre> +<p>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 <code>z</code>, the second-lowest (2's) bit in <code>y</code>, the third-lowest (4's) bit in <code>x</code>, and the fourth-lowest (8's) bit in <code>w</code>:</p> +<pre><code>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 +</code></pre> +<p>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 <em>model number</em>. To do this, the ALU will run the MOdel Number Automatic Detector program (MONAD, your puzzle input).</p> +<p>Submarine model numbers are always <em>fourteen-digit numbers</em> consisting only of digits <code>1</code> through <code>9</code>. The digit <code>0</code> <em>cannot</em> appear in a model number.</p> +<p>When MONAD checks a hypothetical fourteen-digit model number, it uses fourteen separate <code>inp</code> instructions, each expecting a <em>single digit</em> of the model number in order of most to least significant. (So, to check the model number <code>13579246899999</code>, you would give <code>1</code> to the first <code>inp</code> instruction, <code>3</code> to the second <code>inp</code> instruction, <code>5</code> to the third <code>inp</code> instruction, and so on.) This means that when operating MONAD, each input instruction should only ever be given an integer value of at least <code>1</code> and at most <code>9</code>.</p> +<p>Then, after MONAD has finished running all of its instructions, it will indicate that the model number was <em>valid</em> by leaving a <code>0</code> in variable <code>z</code>. However, if the model number was <em>invalid</em>, it will leave some other non-zero value in <code>z</code>.</p> +<p>MONAD imposes additional, mysterious restrictions on model numbers, and legend says the last copy of the MONAD documentation was eaten by a <a href="https://en.wikipedia.org/wiki/Japanese_raccoon_dog" target="_blank">tanuki</a>. You'll need to <em>figure out what MONAD does</em> some other way.</p> +<p>To enable as many submarine features as possible, find the largest valid fourteen-digit model number that contains no <code>0</code> digits. <em>What is the largest model number accepted by MONAD?</em></p> +</article> +<p>Your puzzle answer was <code>91398299697996</code>.</p><article class="day-desc"><h2 id="part2">--- Part Two ---</h2><p>As the submarine starts booting up things like the <a href="https://www.youtube.com/watch?v=RXJKdh1KZ0w" target="_blank">Retro Encabulator</a>, you realize that maybe you don't need all these submarine features after all.</p> +<p><em>What is the smallest model number accepted by MONAD?</em></p> +</article> +<p>Your puzzle answer was <code>41171183141291</code>.</p><p class="day-success">Both parts of this puzzle are complete! They provide two gold stars: **</p> +<p>At this point, you should <a href="/2021">return to your Advent calendar</a> and try another puzzle.</p> +<p>If you still want to see it, you can <a href="24/input" target="_blank">get your puzzle input</a>.</p> +<p>You can also <span class="share">[Share<span class="share-content">on + <a href="https://twitter.com/intent/tweet?text=I%27ve+completed+%22Arithmetic+Logic+Unit%22+%2D+Day+24+%2D+Advent+of+Code+2021&url=https%3A%2F%2Fadventofcode%2Ecom%2F2021%2Fday%2F24&related=ericwastl&hashtags=AdventOfCode" target="_blank">Twitter</a> + <a href="javascript:void(0);" onclick="var mastodon_instance=prompt('Mastodon Instance / Server Name?'); if(typeof mastodon_instance==='string' && mastodon_instance.length){this.href='https://'+mastodon_instance+'/share?text=I%27ve+completed+%22Arithmetic+Logic+Unit%22+%2D+Day+24+%2D+Advent+of+Code+2021+%23AdventOfCode+https%3A%2F%2Fadventofcode%2Ecom%2F2021%2Fday%2F24'}else{return false;}" target="_blank">Mastodon</a +></span>]</span> this puzzle.</p> +</main> + +<!-- ga --> +<script> +(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){ +(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o), +m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m) +})(window,document,'script','//www.google-analytics.com/analytics.js','ga'); +ga('create', 'UA-69522494-1', 'auto'); +ga('set', 'anonymizeIp', true); +ga('send', 'pageview'); +</script> +<!-- /ga --> +</body> +</html> \ No newline at end of file