Day 24 is in certainly in my top three of "least favourite AoC puzzles", if not the top spot. It's the sort of fiddly, detailed, laborious reverse-engineering puzzle that I really don't like. But that's my preference.
Data structures
The representation of the device follows the structure of the puzzle. The wires are a map from name to value. The gates are records containing the gate type, the input wires, and the output wire.
type Wires = M.Map String Int
data GateType = And | Or | Xor
deriving (Show, Eq, Ord)
data Gate = Gate { gType :: GateType, inputs :: [String], output :: String }
deriving (Show, Eq, Ord)
type Device = [Gate]Reading the input file is a typical parsing exercise, using gateify to build the Gate records.
wiresDeviceP = (,) <$> wiresP <* endOfLine <* endOfLine <*> deviceP
wiresP = M.fromList <$> wireP `sepBy` endOfLine
wireP = (,) <$> nameP <* string ": " <*> decimal
nameP = many1 (letter <|> digit)
deviceP = gateP `sepBy` endOfLine
gateP = gateify <$> nameP <* space <*> gateTypeP <* space <*> nameP <* string " -> " <*> nameP
where gateify i1 g i2 o = Gate g (sort [i1, i2]) oPart 1: simulation
Simulating the device uses the set of wires to drive the process. I canActivate a gate if I have values for both inputs. Given a gate can be activated, I can simulate a gate by looking up the type of gate, doing the correct operation, and pushing the result into the set of wires.
canActivateGate :: Wires -> Gate -> Bool
canActivateGate wires gate = all (`M.member` wires) gate.inputs
simulateGate :: Wires -> Gate -> Wires
simulateGate wires gate = M.insert gate.output result wires
where [i1, i2] = gate.inputs
result = case gate.gType of
And -> (wires M.! i1) .&. (wires M.! i2)
Or -> (wires M.! i1) .|. (wires M.! i2)
Xor -> (wires M.! i1) `xor` (wires M.! i2)I do the simulation by keeping two sets of gates: those I can activate, and those I can't yet. At each step, I simulate all the gates I can, and return the updated wires and the gates left to simulate. Collecting the gate outputs is done with the fold. Simulating the whole device is repeated simulation steps, until all gates have values.
simulate :: Wires -> Device -> Wires
simulate wires device = wires'
where (wires', []) = until (null . snd) simulateOnce (wires, device)
simulateOnce :: (Wires, Device) -> (Wires, Device)
simulateOnce (wires, device) = (wires', remaining)
where
(run, remaining) = partition (canActivateGate wires) device
wires' = foldl simulateGate wires runThe final stage is to find the output on the z wires.
part1 :: Wires -> Device -> Int
part1 wires device = wiresOutput $ simulate wires device
wiresOutput :: Wires -> Int
wiresOutput wires = M.foldlWithKey' go 0 outWires
where outWires = M.filterWithKey (\k _ -> isOutputWire k) wires
go acc w v = acc .|. (v .<<. codeOfName w)
isOutputWire :: String -> Bool
isOutputWire (x:_) = x == 'z'
codeOfName :: String -> Int
codeOfName s
| null ds = 1000
| otherwise = read ds
where ds = filter isDigit sPart 2
This is where it all goes wrong.
The first step is to get an understanding of what all these gates are doing and how they're structured. The puzzle description says that the network is a directed acyclic graph, so I can tree of the device going from a particular output wire to the inputs. I use the standard Data.Tree library for this. unfoldFromWire will take
unfoldFromWire :: Device -> String -> DeviceTree
unfoldFromWire device wire =
unfoldTree unfoldDevice (device, fromJust $ gateForWire device wire)
unfoldDevice :: (Device, Gate) -> (Gate, [(Device, Gate)])
unfoldDevice (device, gate) =
( gate
, fmap (\g -> (device, g)) feedGates
)
where feedGates = sort $ catMaybes $ fmap (gateForWire device) gate.inputsThat allowed me to see what was happening for the first few inputs.
ghci> putStrLn $ drawTree $ fmap show $ unfoldFromWire device "z00"
Gate {gType = Xor, inputs = ["x00","y00"], output = "z00"}
ghci> putStrLn $ drawTree $ fmap show $ unfoldFromWire device "z01"
Gate {gType = Xor, inputs = ["qtf","wqc"], output = "z01"}
|
+- Gate {gType = And, inputs = ["x00","y00"], output = "qtf"}
|
`- Gate {gType = Xor, inputs = ["x01","y01"], output = "wqc"}
ghci> putStrLn $ drawTree $ fmap show $ unfoldFromWire device "z02"
Gate {gType = Xor, inputs = ["cpb","wmr"], output = "z02"}
|
+- Gate {gType = Or, inputs = ["djn","tnr"], output = "cpb"}
| |
| +- Gate {gType = And, inputs = ["qtf","wqc"], output = "djn"}
| | |
| | +- Gate {gType = And, inputs = ["x00","y00"], output = "qtf"}
| | |
| | `- Gate {gType = Xor, inputs = ["x01","y01"], output = "wqc"}
| |
| `- Gate {gType = And, inputs = ["x01","y01"], output = "tnr"}
|
`- Gate {gType = Xor, inputs = ["x02","y02"], output = "wmr"}
Output zero is the xor of input zeros. Output one is the xor of input ones, combined with the carry from input zeros. Output two is the same structure, but using the carry from the previous position.
This makes sense, using the recursive structure of natural numbers to define a recursive adder circuit.
I tested that the first few bits of the adder circuit worked correctly, by testing all combinations of inputs. That all succeeded, and gave me confidence that the structures I was seeing for the first few bits were correct.
setInputs :: Int -> Int -> Wires
setInputs x y = M.union (bitsOf "x" x) (bitsOf "y" y)
ghci> filter not [ (x + y) == part1 (setInputs x y) device | x <- [0..127] , y <- [0..127] ]Then I had to find the errors. To do that, I had to build the structure I was expecting to see, so I could compare it against the structure I actually saw. makeAdder makes an adder of the appropriate number of levels.
makeAdder :: Int -> String -> Int -> DeviceTree
makeAdder 0 o _ = Node {rootLabel = Gate {gType = Xor, inputs = ["x00","y00"], output = o}, subForest = []}
makeAdder depth o n = Node {rootLabel = Gate {gType = Xor, inputs = [n0, n1], output = o}, subForest = [gAdd, gCarry]}
where gAdd = Node {rootLabel = Gate {gType = Xor, inputs = ["x" ++ show2d depth,"y" ++ show2d depth], output = n0}, subForest = []}
gCarry = makeCarry (depth-1) n1 (n + 2)
n0 = nonceStr n
n1 = nonceStr (n+1)
makeCarry :: Int -> String -> Int -> DeviceTree
makeCarry 0 o _ = Node {rootLabel = Gate {gType = And, inputs = ["x00","y00"], output = o}, subForest = []}
makeCarry depth o n = Node {rootLabel = Gate {gType = Or, inputs = [n0, n1], output = o}, subForest = [c0, c1]}
where c0 = Node {rootLabel = Gate {gType = And, inputs = [n2, n3], output = n0}, subForest = [c2, c3]}
c1 = Node {rootLabel = Gate {gType = And, inputs = ["x" ++ show2d depth,"y" ++ show2d depth], output = n1}, subForest = []}
c2 = makeCarry (depth-1) n2 (n + 4)
c3 = Node {rootLabel = Gate {gType = Xor, inputs = ["x" ++ show2d depth,"y" ++ show2d depth], output = n3}, subForest = []}
n0 = nonceStr n
n1 = nonceStr (n+1)
n2 = nonceStr (n+2)
n3 = nonceStr (n+3)
nonceStr :: Int -> String
nonceStr n = "n" ++ show nThat gave outputs like this:
ghci> putStrLn $ drawTree $ fmap show $ makeAdder 2 "o2" 0
Gate {gType = Xor, inputs = ["n0","n1"], output = "o2"}
|
+- Gate {gType = Xor, inputs = ["x02","y02"], output = "n0"}
|
`- Gate {gType = Or, inputs = ["n2","n3"], output = "n1"}
|
+- Gate {gType = And, inputs = ["n4","n5"], output = "n2"}
| |
| +- Gate {gType = And, inputs = ["x00","y00"], output = "n4"}
| |
| `- Gate {gType = Xor, inputs = ["x01","y01"], output = "n5"}
|
`- Gate {gType = And, inputs = ["x01","y01"], output = "n3"}
Up to renaming of intermediate wires, and reordering of inputs, this is isomorphic to the actual adder fragments I found above.
I built a function to test that equivalence.
equivalentTree :: DeviceTree -> DeviceTree -> Bool
equivalentTree (Node (Gate g1 i1 _) []) (Node (Gate g2 i2 _) []) =
g1 == g2 && i1 == i2
equivalentTree (Node (Gate g1 _ _) sub1@(_:_))
(Node (Gate g2 _ _) sub2@(_:_)) =
g1 == g2 && ( (all (uncurry equivalentTree) $ zip sub1 sub2)
|| (all (uncurry equivalentTree) $ zip sub1 (reverse sub2))
)
equivalentTree _ _ = FalseAll that was left was to look for where the trees didn't match, and make the corrections! In theory, simple enough. In practice, the obfuscated names of the wires made this a job I had no particular patience for. Luckily, I found a great post on Reddit by u/an-absolute-potato, who described a way of renaming the wires to more meaningful names. That make the process not easier, but at least tractable.
To rename a wire from one name to another, I change the name in every input and output for that wire.
renameWire :: String -> String -> Device -> Device
renameWire from to = fmap rename
where rename (Gate g i o) = Gate g (fmap renameName i) (renameName o)
renameName n | n == from = to
| otherwise = nrenameAll renames the output wire of a gate that has the given inputs. renameAllN does the same for all gates that match a given prefix. For instance, renameAll Xor "x21" "y21" "xor21" device will find all the gates with inputs x21 and y21, and rename their outputs to be xor21. renameAllN Xor "x" "y" "xor" 21 device will do the same, but building x21 from the prefix and number.
existingOutput :: GateType -> String -> String -> Device -> Maybe String
existingOutput gType i1 i2 device
| null gates = Nothing
| otherwise = Just $ output $ head gates
where
f (Gate g i _o) = g == gType && i1 `elem` i && i2 `elem` i
gates = filter f device
renameAll :: GateType -> String -> String -> String -> Device -> Device
renameAll gType i1 i2 newO device =
case mo of
Nothing -> device
Just o -> renameWire o newO device
where mo = existingOutput gType i1 i2 device
renameAllN :: GateType -> String -> String -> String -> Int -> Device -> Device
renameAllN gType p1 p2 po n device = renameAll gType i1 i2 pn device
where i1 = p1 ++ show2d n
i2 = p2 ++ show2d n
pn = po ++ show2d n
show2d :: Int -> String
show2d n | length (show n) == 1 = "0" ++ (show n)
| otherwise = show nThat allows me to rename all the gates with two "input" wires, e.g. x02 and y02 with a more sensible label.
renamings :: Device -> Device
renamings device = d3
where
d1 = foldr (renameAllN Xor "x" "y" "xor") device [0..44]
d2 = foldr (renameAllN And "x" "y" "and") d1 [0..44]
d3 = foldr (renameAllN Or "x" "y" "or") d2 [0..44]The next stage was to rename the two additional gates involved in the carry part of the adder. The "intermediate carry" gate took the output of the previous "carry" gate and the xor of the two input bits. The "carry" gate took the intermediate carry output and the and of the two inputs.
renameCarryI :: Int -> Device -> Device
renameCarryI n device = renameAll And ("xor" ++ show2d n) ("carry" ++ show2d (n-1)) ("int_carry" ++ show2d n) device
renameCarry :: Device -> Int -> Device
renameCarry device n = d2
where d1 = renameCarryI n device
d2 = renameAll Or ("int_carry" ++ show2d n) ("and" ++ show2d n) ("carry" ++ show2d n) d1That allowed me to rename all the correctly-wired parts of the adder. (Note the foldl at the last stage. That took me a few minute to track down the bug.)
renamings :: Device -> Device
renamings device = d5
where
d1 = foldr (renameAllN Xor "x" "y" "xor") device [0..44]
d2 = foldr (renameAllN And "x" "y" "and") d1 [0..44]
d3 = foldr (renameAllN Or "x" "y" "or") d2 [0..44]
d4 = renameWire "and00" "carry00" d3
d5 = foldl renameCarry d4 [1..44]Applying renamings to the device will produce human-sensible names for all the wires that are part of the correctly-wired adder. For output 2, you get this:
ghci> putStrLn $ drawTree $ fmap show $ unfoldFromWire device "z02"
Gate {gType = Xor, inputs = ["carry01","xor02"], output = "z02"}
|
+- Gate {gType = Or, inputs = ["int_carry01","and01"], output = "carry01"}
| |
| +- Gate {gType = And, inputs = ["carry00","xor01"], output = "int_carry01"}
| | |
| | +- Gate {gType = And, inputs = ["x00","y00"], output = "carry00"}
| | |
| | `- Gate {gType = Xor, inputs = ["x01","y01"], output = "xor01"}
| |
| `- Gate {gType = And, inputs = ["x01","y01"], output = "and01"}
|
`- Gate {gType = Xor, inputs = ["x02","y02"], output = "xor02"}If you take those renamed gates, sort by input, and look at the result, you find some correctly named wires and some not. The boundary between the two marks where things first go wrong.
ghci> putStrLn $ unlines $ fmap show $ sortOn (codeOfName . head . inputs) $ deviceThen it's a case of showing the tree for the next output along, showing the tree it should be, and comparing them to see what goes wrong. Sometimes, where an output has been rewired, you have to look at the next-but-one output. Often, you have to look at the original input file, not the renamed devices, to find all the wire names.
For me, the first error was that wires "vss" and "z14" were swapped. I could put them back with swapWires, that swaps the outputs of two gates.
swapWires :: String -> String -> Device -> Device
swapWires w1 w2 = renameOutput "swap" w2 . renameOutput w2 w1 . renameOutput w1 "swap"
where renameOutput from to = fmap rename
where rename (Gate g i o) = Gate g i (renameName o)
renameName n | n == from = to
| otherwise = nOver time, I found the errors, corrected them, gave human-sensible names to the rest, and tried again. Eventually, I got these renamings.
rdn :: IO Device
rdn = do
text <- TIO.readFile "../data/advent24.txt"
let (_, device) = successfulParse text
let r1 = swapWires "vss" "z14" device
let r2 = swapWires "kdh" "hjf" r1
let r3 = swapWires "z31" "kpp" r2
let r4 = swapWires "z35" "sgj" r3
return $ renamings r4I never want to have to do something like that again.
Code
You can get the code from my locally-hosted Git repo, or from Codeberg.