Advent of Code 2019 day 23

January 21, 2020 in #advent of code #haskell

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 .~ emptyPacket

The 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.

Share on Google+
No Newer Posts