Advent of Code 2019 day 23

    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 
                    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 = 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 $ extractPacket net
                net' = 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.


    You can find the code locally or on Github.

    Neil Smith

    Read more posts by this author.