Advent of Code 2021 day 24

Day 24 took be a long time, both because the problem was hard and because I lost momentum as Real Life got in the way after Christmas.

The task is to find a 14-digit input to a virtual machine so that it ends in a particular state. The two parts of the problem are to find the largest and smallest input that satisfy the condition. The virtual machines' program is written in a somewhat convoluted way in something like assembler, meaning it's not clear what it's doing from a first reading. The space of 9¹⁴ possible inputs made exhaustive, single-threaded, search infeasible

I saw three approaches to solving this problem.

Reverse engineer the program to something higher level that could be reasoned about, and then solving the resulting problem
Using a lot of memory to store all possible executions of the machine, helped by the fact that several inputs would map to the same machine state
Using a heuristic to guide an exhaustive search
Offload the problem by using a constraint solver library

I decided that reverse engineering wasn't ideal, as I wanted a more general problem than just looking at the problem's source code for a while. I could have gone for using a constraint solver such as SBV, but I wasn't in the mood for that.

I did try replicating the "all possible executions" idea, as described by Matt Keeter. Unfortunately, that wasn't a good fit for Haskell given the lack of easy support for unboxed hash tables (as used by Matt). I did try using unboxed arrays, eventually working with the Massiv library. That seemed like it would have fitted all the data in memory, but I was getting myself tied up in knots with the different types of manifest and delayed arrays, conversion of one to the other, and attempting to write an in-place sort using those arrays.

Eventually, I gave up and tried the heuristic-guided exhaustive search. Essentially, this implementation is copied from the one by Daniel Lin.

The basic idea

At every inp statement, we have to pick a digit that's given to the machine. Overall, we have to pick the highest digits that lead to the machine finishing in the desired state. The trouble is, we don't know what digits to pick until we've picked them all.

The normal way of dealing with this sort of problem is nondeterminism. At each inp statement, we make a nondeterministic choice about what digit to choose, apply the constraint to our choice at the end (which will give a set of valid codes) and pick the one with the highest value.

The trouble is, we can only apply the constraint of "is this a valid code?" at the end of machine's execution, so we'd have to generate all 9¹⁴ possible inputs to do this (or, using laziness, skip through the first 9¹³ inputs that lead to invalid codes).

We can shortcut that with a heuristic that quickly answers the question "with these first few digits of input, is there any remaining input that would lead to a valid end state?" If there isn't, we can reject all codes that start with these few digits. We handle that question with interval arithmetic, keeping only the upper and lower bounds on the machine's register contents. Every time we come across a new inp instruction, we set the register to the inverval [1-9] and continue processing.

Data structures

I define types for Instructions, Registers and Arguments (which can be either registers or literal values). A machine is a Map of registers and values.

I also define an Interval and an IntervalMachine that represents the machine while evaluating the heuristic. The IntervalMachine uses Maybe Intervals to handle when an interval contains an illegal value. Finally, a CodeMachine holds both a LiteralMachine and the input code that led to this state.

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)

Running the machine

This is a fairly standard interpreter, using explicit recursion (to handle the choices dealing with the inp instruction). Each instruction is handled, the machine is updated, and the machine is then evaluated with the rest of the instructions.

The handling of the add instruction is typical for most of the instructions. It finds the values of the instruction's arguments, calculates the result, updates the machine, then calls runLit to handle the remaining arguments.

runLit :: [Instruction] -> [Integer] -> CodeMachine -> [CodeMachine]
runLit [] _ machine = [machine]
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

The other clauses, for the other instructions, are pretty much the same. The base case, when we've run out of instructions, returns the machine in a singleton list.

The inp-handling clause below is where the magic happens.

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

It's in the List monad, using the nondeterministic choice from digits to find the solution. It uses two auxiliary functions: plausible does the interval-based check and valid ensures that the final machine passes the overall test; if it does, it's returned as a solution.

valid is just checking the contents of the Z register. plausible is a bit more involved, as it converts the machine into the interval-based world (with intervalify), runs the converted machine to completion, then checks that the model could lead to a valid end-state.

valid :: CodeMachine -> Bool
valid (CodeMachine{..}) = (mMachine ! Z) == 0

plausible :: [Instruction] -> LiteralMachine -> Bool
plausible instrs litMachine = feasible ranMachine
  where intMachine = intervalify litMachine
        ranMachine = runInt instrs intMachine

intervalify :: LiteralMachine -> IntervalMachine
intervalify = M.map (\i -> Just (Interval i i))

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

Interval-based machine

runInt runs the interval-based machine. Without the need for nondeterminism, this is a fold over the instructions. Each instruction is handled by its own clause of interpretInt, and the interval arithmetic is done by new versions of the arithmetic operators.

This is complicated by the possibility of calculations that lead to invalid results. Essentially, this is when a division uses a divisor interval that contains zero; this could lead to an infinite result and thus lead to the rest of the computation failing. I represent infinity-containing intervals as Nothing and other, valid intervals as Just Interval. If an invalid interval is used later, it will make the whole machine invalid.

That means the interpretInt function must have type Maybe IntMachine -> Instruction -> Maybe IntMachine.

Within the clauses of interpretInt, the calculation of the result has type Maybe Interval -> Maybe Interval -> Maybe Interval, but the definition of each operation is easier if they're of type Interval -> Interval -> Maybe Interval. That's why I use Maybe as an Applicative to combine the arguments, then join to convert the Maybe (Maybe Interval) to the Maybe Interval result.

runInt :: [Instruction] -> IntervalMachine -> IntervalMachine
runInt instrs machine = foldl' interpretInt (Just machine) instrs

interpretInt :: Maybe IntervalMachine -> Instruction -> Maybe IntervalMachine
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

-- and so on...

The interval arithmetic operators take two intervals and return a Maybe Interval. They return Nothing if the operation involves a division and the divisor interval spans zero.

(+:), (*:), (/:), (%:), (=:) :: 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)

Finding solutions

After all the effort putting together the evaluator and heuristic, the final steps are much simpler. To find the largest code, we ask to find all codes, starting at 999..9 and counting down, then pick the first one. To find the smallest code, we start at 111...1 and count up.

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

Alternatives

There are a couple of other ways of handling the heuristic and using it to prune away unproductive paths. Daniel's original approach was to call an interval-based evaluation implausible if any register held an invalid value, whether or not that value was used later. (That's implemented as MainLax.hs). That runs slightly quicker, but I'm a bit concerned that it might exclude some executions that actually work out fine. But, both approaches give the same result.

Another alternative is to reorder where the guard statements occur in handling inputs.

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

That ends up giving the same results, but after a much longer runtime.

Code

You can get the code from my locally-hosed Git repo, or from Gitlab.