-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
--- /dev/null
+-- 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
--- /dev/null
+-- 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
--- /dev/null
+-- 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
--- /dev/null
+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
--- /dev/null
+inp w
+add z w
+add z 2
+mod z 3
+add z -1
--- /dev/null
+inp z
+mod z 4
+inp w
+sub w 3
+eql z w
--- /dev/null
+<!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
projects / advent-of-code-21.git / commitdiff