advent23/src/advent23.hs

   1 import Debug.Trace
   2
   3 import Intcode
   4
   5 import qualified Data.Text.IO as TIO
   6
   7 import qualified Data.Map.Strict as M
   8 import Data.Map.Strict ((!))
   9 import Data.List
  10 -- import Data.Function (on)
  11 import Control.Lens
  12 import Control.Monad.RWS.Strict
  13
  14
  15 data EncapsulatedMacine = EncapsulatedMacine
  16     { _machine :: Machine
  17     , _executionState :: ExecutionState
  18     , _currentInput :: [Integer]
  19     , _machineOutput :: [Integer]
  20     } deriving (Show, Eq)
  21 makeLenses ''EncapsulatedMacine
  22
  23 type Network = M.Map Integer EncapsulatedMacine
  24
  25 data Packet = Packet
  26     { _destination :: Integer
  27     , _packetX :: Integer
  28     , _packetY :: Integer
  29     } deriving (Show, Eq)
  30 makeLenses ''Packet
  31
  32
  33 main :: IO ()
  34 main = do
  35         text <- TIO.readFile "data/advent23.txt"
  36         let mem = parseMachineMemory text
  37         print $ part1 mem
  38         -- print $ part2 mem
  39
  40
  41 part1 mem = runNetworkUntil255 net
  42     where   net = buildNetwork mem
  43
  44 runNetworkUntil255 :: Network -> Packet
  45 runNetworkUntil255 net0
  46     | not $ null goalPackets = head packets
  47     | otherwise = runNetworkUntil255 net3
  48     where   net1 = runNetworkStep net0
  49             (net2, packets) = extractPackets net1
  50             net3 = enqueuePackets net2 packets
  51             goalPackets = filter (packet255) packets
  52
  53
  54 packet255 :: Packet -> Bool
  55 packet255 packet = (packet ^. destination) == 255
  56
  57
  58 buildNetwork :: [Integer] -> Network
  59 buildNetwork mem = M.fromList $ map (\i -> (i, encapsulate mem i)) [0..49]
  60
  61
  62 encapsulate :: [Integer] -> Integer -> EncapsulatedMacine
  63 encapsulate mem input = EncapsulatedMacine
  64     { _machine = makeMachine mem
  65     , _executionState = Runnable
  66     , _machineOutput = []
  67     , _currentInput = [input]
  68     }
  69
  70
  71
  72
  73 -- pipelineTrace :: Pipeline -> String
  74 -- pipelineTrace pipeline = show $ M.toList $ M.map emTrace pipeline
  75
  76 -- emTrace e = intercalate " ; " terms
  77 --     where terms = [ show $ _executionState e
  78 --                   , "in"
  79 --                   , show $ _currentInput e
  80 --                   , "out"
  81 --                   , show $ _machineOutput e
  82 --                   ]
  83
  84 runNetworkStep :: Network -> Network
  85 runNetworkStep net = M.map runEncapsulatedMachine net
  86
  87 extractPackets :: Network -> (Network, [Packet])
  88 extractPackets net = (net', packets)
  89     where   packets = concat $ M.elems $ M.map extractPacket net
  90             net' = M.map stripPacket net
  91
  92 extractPacket :: EncapsulatedMacine -> [Packet]
  93 extractPacket e = if length output >= 3
  94                   then [Packet { _destination = fromIntegral $ output!!0
  95                                , _packetX = output!!1
  96                                , _packetY = output!!2} ]
  97                   else []
  98     where   output = (e ^. machineOutput)
  99
 100 stripPacket :: EncapsulatedMacine -> EncapsulatedMacine
 101 stripPacket e = if length (e ^. machineOutput) >= 3
 102                 then e & machineOutput %~ (drop 3)
 103                 else e
 104
 105 enqueuePackets :: Network -> [Packet] -> Network
 106 enqueuePackets net packets = foldl' enqueuePacket net packets
 107
 108 enqueuePacket :: Network -> Packet -> Network
 109 enqueuePacket net packet
 110     | d `M.member` net = M.insert d e' net
 111     | otherwise = net
 112     where   d = packet ^. destination
 113             e = net!d
 114             e' = e & currentInput %~ (++ [packet ^. packetX, packet ^. packetY])
 115
 116
 117 runEncapsulatedMachine :: EncapsulatedMacine -> EncapsulatedMacine
 118 runEncapsulatedMachine e = e & machine .~ m''
 119                              & executionState .~ halted'
 120                              & currentInput .~ input'
 121                              & machineOutput %~ ( ++ output' )
 122     where   (halted, m', output) = runRWS runNetworkMachineStep (e ^. currentInput) (e ^. machine)
 123             input' = if halted == Blocked
 124                      then (e ^. currentInput) ++ [-1]
 125                      else e ^. currentInput
 126             (halted', m'', output') = if halted == Blocked
 127                                       then runRWS runNetworkMachineStep input' (e ^. machine)
 128                                       else (halted, m', output)
 129
 130
 131 runNetworkMachineStep :: ProgrammedMachine ExecutionState
 132 runNetworkMachineStep = do
 133     mem <- gets _memory
 134     ip <- gets _ip
 135     input <- ask
 136     iIndex <- gets _inputIndex
 137     let acutalInputLength = length input
 138     let requiredInputLength = iIndex + 1
 139     if (mem!ip == 99)
 140     then return Terminated
 141     else if (mem!ip == 3 && requiredInputLength > acutalInputLength)
 142          then return Blocked
 143          else do
 144                 runStep
 145                 return Runnable