Advent of Code, Day 2
The Advent of Code, day 2, involves an interpreted integer computer, with three opcodes. The first task is to interpret the (self-modifying) program and find the output value - this is straightforward. The second task is to find two initial memory values that produce a fixed output value. This task is the subject of today’s post.
This post is presented as literate Haskell, but since I don’t provide you with the source of the site you’ll have to cut and paste it bit by bit to run it. Maybe some day I’ll improve on that, but not today.
No imports, no language extensions, let’s keep this one simple.
module Main whereEach participant gets a unique puzzle input. Mine has been cut and pasted into the program code below, because reading a text file isn’t the interesting part of the problem.
puzzle :: [Int]
puzzle =
[ 1, 12, 2, 3, 1, 1, 2, 3, 1, 3
, 4, 3, 1, 5, 0, 3, 2, 6, 1, 19
, 1, 19, 5, 23, 2, 10, 23, 27, 2, 27
, 13, 31, 1, 10, 31, 35, 1, 35, 9, 39
, 2, 39, 13, 43, 1, 43, 5, 47, 1, 47
, 6, 51, 2, 6, 51, 55, 1, 5, 55, 59
, 2, 9, 59, 63, 2, 6, 63, 67, 1, 13
, 67, 71, 1, 9, 71, 75, 2, 13, 75, 79
, 1, 79, 10, 83, 2, 83, 9, 87, 1, 5
, 87, 91, 2, 91, 6, 95, 2, 13, 95, 99
, 1, 99, 5,103, 1,103, 2,107, 1,107
, 10, 0, 99, 2, 0, 14, 0
]Each number is a memory cell value. The interpreter has an instruction pointer initialised to zero, and recognises three opcodes: 1 is addition, 2 is multiplication, and 99 halts the program. The two numeric instructions have three arguments, each an indirect address. The first is the address of the left operand, the second the right operand, and the third the result address. In the puzzle input above, 1, 12, 2, 3 represents the addition opcode, which will add the contents of memory cells 12 and 2 and store the result in memory cell 3.
The second and third cells are the variables. The numbers above are the required values for the first part of the task - what value do you get in memory cell zero after executing this program. The second part of the task is to find values that mean the end result is the value 19690720 (the date of the first moon landing). The obvious approach is to try combinations until the right answer is output: my initial solution was to manually try a few numbers to see how the output varied with respect to the input, and derive a formula.
Hoever, this problem should be solvable directly, without using trial and error.
Each step of the program computes a new value for some memory cell using other memory cells. The trick with the second task is that two of the memory cells have no defined value: the final value in cell zero will be some expression of two variables. The solution, then, is to construct that expression directly, and solve it for the two variables.
The value to be computed will be an expression tree, where the leaves are either literal integers taken from program memory, or variables identified by their memory location. The branches are one of the two operations.
data Expr = Lit Int
| Var Int
| Add Expr Expr
| Mul Expr Expr
deriving ShowAn expression can be evaluted to a result as long as it has no variables in it. This is where my code goes off the rails already: I use error instead of putting the partiality into the type. I’ll forgive myself, and as the only reader of my blog, therefore all my readers also forgive me.
evaluate :: Expr -> Int
evaluate (Lit x) = x
evaluate (Var x) = error "evaluating variable"
evaluate (Add a b) = evaluate a + evaluate b
evaluate (Mul a b) = evaluate a * evaluate bIf there are variables, the expression can have those variables substituted for values.
subst :: Int -> Int -> Expr -> Expr
subst var val (Lit x) = Lit x
subst var val (Var x) = if var == x then Lit val else Var x
subst var val (Add a b) = Add (subst var val a) (subst var val b)
subst var val (Mul a b) = Mul (subst var val a) (subst var val b)My code’s off-the-railness continues, with boolean blindness in the arguments, and recursion everywhere instead of catamorphisms. If you promise to stop being judgemental, I promise to stop being self-deprecating.
The first stage in solving the problem is to convert the initial memory footprint into an expression for the final value. The mkExpr function takes a list of variable positions and a program memory and produces a list of expression memory. The literal memory is first converted into expressions that are either a Lit or a Var, depending on the vars argument.
mkExpr :: [Int] -> [Int] -> [Expr]
mkExpr vars program =
let cells = zipWith eval program [0..] -- initial value
eval c i = if i `elem` vars then Var i else Lit c
in interpret cells 0The expression program is now interpreted, starting with an instruction pointer of zero.
The opcode to be executed must be evaluated first. Self-modifying code is fine, but code where the opcodes depend on variables is not - they’ll cause an error in evaluate. Since opcodes that depend on variables would mean the majority of programs are invalid, I do not expect this result. Spoiler: the assumption was valid. Also valid was the assumption that the instruction pointer would never stray out of bounds.
interpret :: [Expr] -> Int -> [Expr]
interpret cells ip = case evaluate (cells !! ip) ofThe two functional opcodes perform their respective operation, increase the instruction pointer, and tail-recursively continue interpretation. The halting opcode returns the current view of memory.
1 -> interpret (add cells ip) (ip + 4)
2 -> interpret (mul cells ip) (ip + 4)
99 -> cellsAny other opcode results in the dreaded error again. This time with a little debug info, although the error never arose.
_ -> error $ "invalid opcode " <> show (cells !! ip) <> " at " <> show ipPerforming an operation requires that the cell addresses can be evaluated. This is less of a firm assumption, as there would be many possible variable assignments that lead to functional but incorrect programs; for operands in particular programs would remain valid for all in-bounds addresses. Fortunately, this assumption also panned out.
The operand cells have their expressions retrieved. The destination cell is updated with a new expression using the two operands.
where
op f cells ip = let a = cells !! (evaluate $ cells !! (ip + 1))
b = cells !! (evaluate $ cells !! (ip + 2))
t = evaluate (cells !! (ip + 3))
in take t cells <> (f a b : drop (t + 1) cells)
add = op Add
mul = op MulThe example program from the task is [1, 9, 10, 3, 2, 3, 11, 0, 99, 30, 40, 50]. With no variables defined, this program produces an expression tree:
mkExpr [] [1, 9, 10, 3, 2, 3, 11, 0, 99, 30, 40, 50] = Mul (Add (Lit 30)
(Lit 40))
(Lit 50)And sure enough, (30 + 40) * 50 = 3500, the expected result.
Reading an expression tree isn’t all that fun though, so I added a pretty-printer that would parenthesis according to operator precedence:
pretty :: Expr -> String
pretty = pretty' 0
where
pretty' p (Lit n) = show n
pretty' p (Var n) = "v" <> show n
pretty' p (Add a b) = lparen p 1 <> pretty' 1 a <> " + " <> pretty' 1 b <> rparen p 1
pretty' p (Mul a b) = lparen p 2 <> pretty' 2 a <> " * " <> pretty' 2 b <> rparen p 2
lparen p q = if p > q then "(" else ""
rparen p q = if p > q then ")" else ""The result is easier to follow, and can be cut and paste into a command line calculator.
pretty (Mul (Add (Lit 30) (Lit 40)) (Lit 50)) = (30 + 40) * 50And if the pretty printer is run on the expression result for the puzzle input with two variables:
pretty $ mkExpr [1,2] puzzle !! 0 = 5 * (1 + (5 * (3 + 5 + 2 * 3 * (1 + 2 *
((4 + 4 * (2 * v1 + 1) * 5 + 3) * 5 + 1 + 2))) + 4) * 3) * 2 + 1 + v2 + 4The first observation to note about this is that v2 is a simple offset, while v1 has a multiplier. The equation will be of the form , but first it must be simplified to reduce all those literals down to just and .
simplify :: Expr -> ExprThis is an unremarkable expression simplifier, of the kind you’ll encounter over and over in any introduction to theorem proving, and many introductions to functional programming. The general gist of the addition simplifier is to look for opportunities to convert expressions of the form Add (expr (Lit x)) (Lit y) (i.e. “(expr + val) + val”) into expressions of the form Add expr (Lit $ x + y), removing one layer of nested addition. To accomplish this, the addition of two literals is immediately collapsed to one literal, any remaining literals on the left are moved to the right, the target sub-addition form is simplified, and any remaining nested literal additions have the literal moved to the outer expression.
simplify (Add a b) = let a' = simplify a
b' = simplify b
in case (a', b') of
(Lit x, Lit y) -> Lit (x + y)
(Lit _, _) -> simplify (Add b' a')
(Add x (Lit y), Lit z) -> Add x (Lit $ y + z)
(Add x (Lit y), z) -> Add (Add x z) (Lit y)
_ -> Add a' b'Multiplication looks for the same nested pattern. In addition, multiplication looks for the opportunity to distribute a literal multiplier into an addition where it can be recursively simplified.
simplify (Mul a b) = let a' = simplify a
b' = simplify b
in case (a', b') of
(Lit x, Lit y) -> Lit (x * y)
(Lit _, _) -> simplify (Mul b' a')
(Mul x (Lit y), Lit z) -> Mul x (Lit $ y * z)
(Mul x (Lit y), z) -> Mul (Mul x z) (Lit y)
(Add x y, Lit _) -> Add (simplify (Mul x b'))
(simplify (Mul y b'))
_ -> Mul a' b'Anything else is a literal or a variable, and cannot be simplified further.
simplify cell = cellAt this point, it’s a good idea to verify that simplify works as expected. I threw in the weakest kind of testing possible: check that evaluating my puzzle input when both simplified and unsimplified, using the task one values, produces the same output. This doesn’t check that I’ve simplified all possible expression forms, correctly or otherwise, only those encountered in my input. Ideally, it would use property-based checking to cover a wide range of variable values and programs, but I’m comfortable enough with this minor check on correctness.
test :: IO ()
test = do
let expr = mkExpr [1, 2] puzzle !! 0
let r1 = evaluate $ subst 2 2 $ subst 1 12 expr
let r2 = evaluate $ subst 2 2 $ subst 1 12 $ simplify expr
print r1
print r2Let’s take a look at my puzzle’s simplified expression.
pretty $ simplify $ mkExpr [1,2] puzzle !! 0 = v1 * 360000 + v2 + 250635This is now of the expected form. Solving this by hand is, of course, trivial, but we’re not here to do things by hand. Except write code, which we’re dong by hand. The last important step is instead to compute the final answer. The expression above must equal 19690720 to satisfy the task, giving an equation to solve. Fortunately, it’s a given that there is a unique integer solution, so a solver is trivial. Added literals are subtracted from both sides. Multiplied literals will produce a quotient and a remainder when dividing both sides, so an expression such as means is the quotient and is the remainder.
If the simplifier has failed to reduce the expression into one of these forms, the solver will also fail. Which it does not, for my puzzle input.
solve :: Expr -> Int -> [(Int, Int)]
solve (Var x) t = [(x, t)]
solve (Add (Mul x (Lit y)) z) t = let (x', z') = t `divMod` y
in solve x x' <> solve z z'
solve (Add x (Lit y)) t = solve x (t - y)
solve e t = error $ show e <> " = " <> show tAll that’s left to do is run the whole thing.
main :: IO ()
main = do
let expr = simplify $ mkExpr [1, 2] puzzle !! 0
putStrLn $ pretty expr <> " = 19690720"
let vars = solve expr 19690720
maybe (error "no solution") print $ do
noun <- lookup 1 vars
verb <- lookup 2 vars
pure (noun * 100 + verb)Which produces the output:
v1 * 360000 + v2 + 250635 = 19690720
5485The icon for this post is copyright Claire Jones, used without modification under a Creative Commons license.