Day 23 was a return to the orchestration of Intcode machines. The specification of how to run the network was ambiguous, and the Reddit thread implied that the timing of the different machines didn't matter that much: the results were the same regardless of how the execution of the different machines was interleaved. But I decided to do it the most "proper" way and have the machines completely synchronised. Each machine would operate one instruction, round-robin style, and then each machine would operate the next instruction.
I reused the "encapsulated machine" idea first introduced in Day 7: each encapsulated machine would maintain its own state and input and output queues.
The requirement for each machine to execute one step at a time meant I couldn't use the existing runAll function in the Intcode module. I replaced it with the runNetworkMachineStep function which is almost the same, apart from the lack of a recursive call.
Each machine had to be fed an extra -1 if it wanted input but there was none available. That was handled by runEncapsulatedMachine, which added the extra input if runNetworkMachineStep reported the machine was Blocked.
runEncapsulatedMachine :: EncapsulatedMacine -> EncapsulatedMacine
runEncapsulatedMachine e = e & machine .~ m''
& executionState .~ halted'
& currentInput .~ input'
& machineOutput %~ ( ++ output' )
where (halted, m', output) = runRWS runNetworkMachineStep (e ^. currentInput) (e ^. machine)
input' = if halted == Blocked
then (e ^. currentInput) ++ [-1]
else e ^. currentInput
(halted', m'', output') = if halted == Blocked
then runRWS runNetworkMachineStep input' (e ^. machine)
else (halted, m', output)
runNetworkMachineStep :: ProgrammedMachine ExecutionState
runNetworkMachineStep = do
mem <- gets _memory
ip <- gets _ip
input <- ask
iIndex <- gets _inputIndex
let acutalInputLength = length input
let requiredInputLength = iIndex + 1
if (mem!ip == 99)
then return Terminated
else if (mem!ip == 3 && requiredInputLength > acutalInputLength)
then return Blocked
else do
runStep
return Runnable
Part 1
The next thing to handle was all the extraction and enqueuing of packets. Because Part 1 required stopping when a packet was sent to address 255, I had to include the detection of packets with the checks for termination of the network.
runNetworkUntil255 :: Network -> Integer
runNetworkUntil255 net0
| not $ null goalPackets = (head goalPackets) ^. packetY
| otherwise = runNetworkUntil255 net3
where net1 = runNetworkStep net0
(net2, packets) = extractPackets net1
net3 = enqueuePackets net2 packets
goalPackets = filter isNatPacket packets
runNetworkStep just maps runEncapsulatedMachine over the whole network, stored as a Map from address to runEncapsulatedMachine1.
runNetworkStep :: Network -> Network
runNetworkStep net = M.map runEncapsulatedMachine net
Then I had to write the extractPackets and enqueuePackets functions to handle the packets, and the isNatPacket function to detect the goal packet.
extractPackets makes two passes over the network's machines. The first pass collects any completed packets, the second removes completed packets from the machines' output queues.
extractPackets :: Network -> (Network, [Packet])
extractPackets net = (net', packets)
where packets = concat $ M.elems $ M.map extractPacket net
net' = M.map stripPacket net
extractPacket :: EncapsulatedMacine -> [Packet]
extractPacket e = if length output >= 3
then [Packet { _destination = output!!0
, _packetX = output!!1
, _packetY = output!!2} ]
else []
where output = (e ^. machineOutput)
stripPacket :: EncapsulatedMacine -> EncapsulatedMacine
stripPacket e = if length (e ^. machineOutput) >= 3
then e & machineOutput %~ (drop 3)
else e
enqueuePackets takes the packets and adds them to the input queues of the relevant machines.
enqueuePackets :: Network -> [Packet] -> Network
enqueuePackets net packets = foldl' enqueuePacket net packets
enqueuePacket :: Network -> Packet -> Network
enqueuePacket net packet
| d `M.member` net = M.insert d e' net
| otherwise = net
where d = packet ^. destination
e = net!d
e' = e & currentInput %~ (++ [packet ^. packetX, packet ^. packetY])
All that's left is the definition of the data structures needed: the EncapsulatedMachine, the Network, and the Packet.
data EncapsulatedMacine = EncapsulatedMacine
{ _machine :: Machine
, _executionState :: ExecutionState
, _currentInput :: [Integer]
, _machineOutput :: [Integer]
} deriving (Eq, Show)
makeLenses ''EncapsulatedMacine
type Network = M.Map Integer EncapsulatedMacine
data Packet = Packet
{ _destination :: Integer
, _packetX :: Integer
, _packetY :: Integer
} deriving (Show, Eq, Ord)
makeLenses ''Packet
Part 2
This required a modification of the network to include the NAT and the previous Y value sent.
data NatNetwork = NatNetwork
{ _natNetwork :: Network
, _natPacket :: Packet
, _natPreviousY :: Integer
} deriving (Show, Eq)
makeLenses ''NatNetwork
Part 2 used runNetworkUntilIdle instead of runNetworkUntil255. This function captures packes sent to address 255 and stores them in the NAT fields.
runNetworkUntilIdle :: NatNetwork -> NatNetwork
runNetworkUntilIdle natNet
| isIdle net0 = natNet
| otherwise = runNetworkUntilIdle natNet'
where net0 = natNet ^. natNetwork
net1 = runNetworkStep net0
(net2, packets) = extractPackets net1
net3 = enqueuePackets net2 packets
natPackets = filter isNatPacket packets
np = if null natPackets
then natNet ^. natPacket
else head natPackets
natNet' = natNet & natNetwork .~ net3
& natPacket .~ np
The idle network detection is done by isIdle. This detects an idle network by checking that all inputs have at least two -1 values at the end, and that all output queues are empty. (Just checking for a single -1 at the end of each inpt queue wasn't sufficient to detect an idle network.)
isIdle :: Network -> Bool
isIdle net = inputBlocked && noOutput
where inputBlocked = all (\e -> (last $ e ^. currentInput) == -1 && (last $ init $ e ^. currentInput) == -1) $ M.elems net
noOutput = all (\e -> null $ e ^. machineOutput) $ M.elems net
The entire of Part 2 is done by running the network to idleness, pushing out the NAT packet, then running it again to idleness. The only wrinkle here is that the termination test is done after the network is run to idleness, as restarting the network resets the packet stored in the NAT.
runNetworkUntilTermination :: NatNetwork -> Integer
runNetworkUntilTermination natNet
| part2Termination natNet1 = natNet1 ^. natPacket . packetY
| otherwise = runNetworkUntilTermination natNet2
where natNet1 = runNetworkUntilIdle natNet
np = (natNet1 ^. natPacket) & destination .~ 0
net = natNet1 ^. natNetwork
net2 = enqueuePacket net np
natNet2 = natNet1 & natNetwork .~ net2
& natPreviousY .~ (np ^. packetY)
& natPacket .~ emptyPacketThe final piece of the puzzle is the test for termination, which compares the current and previous NAT Y values.
part2Termination :: NatNetwork -> Bool
part2Termination natNet = thisY == prevY
where thisY = natNet ^. natPacket . packetY
prevY = natNet ^. natPreviousY
And that's it! It runs very slowly, but then I've not attempted to do any kind of optimisation.
Code
You can find the code locally or on Github.