From a7b6c99605435b65ade68ad00fbf5b0979ad931f Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Tue, 14 Jan 2020 15:42:37 +0000 Subject: [PATCH] Done part 1 --- advent23/package.yaml | 62 +++++++++++++++++ advent23/src/advent23.hs | 145 +++++++++++++++++++++++++++++++++++++++ data/advent23.txt | 1 + stack.yaml | 1 + 4 files changed, 209 insertions(+) create mode 100644 advent23/package.yaml create mode 100644 advent23/src/advent23.hs create mode 100644 data/advent23.txt diff --git a/advent23/package.yaml b/advent23/package.yaml new file mode 100644 index 0000000..31d69cf --- /dev/null +++ b/advent23/package.yaml @@ -0,0 +1,62 @@ +# This YAML file describes your package. Stack will automatically generate a +# Cabal file when you run `stack build`. See the hpack website for help with +# this file: . + +name: advent23 +synopsis: Advent of Code +version: '0.0.1' + +default-extensions: +- AllowAmbiguousTypes +- ApplicativeDo +- BangPatterns +- BlockArguments +- DataKinds +- DeriveFoldable +- DeriveFunctor +- DeriveGeneric +- DeriveTraversable +- EmptyCase +- FlexibleContexts +- FlexibleInstances +- FunctionalDependencies +- GADTs +- GeneralizedNewtypeDeriving +- ImplicitParams +- KindSignatures +- LambdaCase +- MonadComprehensions +- MonoLocalBinds +- MultiParamTypeClasses +- MultiWayIf +- NegativeLiterals +- NumDecimals +- OverloadedLists +- OverloadedStrings +- PartialTypeSignatures +- PatternGuards +- PatternSynonyms +- PolyKinds +- RankNTypes +- RecordWildCards +- ScopedTypeVariables +- TemplateHaskell +- TransformListComp +- TupleSections +- TypeApplications +- TypeInType +- TypeOperators +- ViewPatterns + + +executables: + advent23: + main: advent23.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - text + - containers + - intcode + - lens + - mtl diff --git a/advent23/src/advent23.hs b/advent23/src/advent23.hs new file mode 100644 index 0000000..2ea9176 --- /dev/null +++ b/advent23/src/advent23.hs @@ -0,0 +1,145 @@ +import Debug.Trace + +import Intcode + +import qualified Data.Text.IO as TIO + +import qualified Data.Map.Strict as M +import Data.Map.Strict ((!)) +import Data.List +-- import Data.Function (on) +import Control.Lens +import Control.Monad.RWS.Strict + + +data EncapsulatedMacine = EncapsulatedMacine + { _machine :: Machine + , _executionState :: ExecutionState + , _currentInput :: [Integer] + , _machineOutput :: [Integer] + } deriving (Show, Eq) +makeLenses ''EncapsulatedMacine + +type Network = M.Map Integer EncapsulatedMacine + +data Packet = Packet + { _destination :: Integer + , _packetX :: Integer + , _packetY :: Integer + } deriving (Show, Eq) +makeLenses ''Packet + + +main :: IO () +main = do + text <- TIO.readFile "data/advent23.txt" + let mem = parseMachineMemory text + print $ part1 mem + -- print $ part2 mem + + +part1 mem = runNetworkUntil255 net + where net = buildNetwork mem + +runNetworkUntil255 :: Network -> Packet +runNetworkUntil255 net0 + | not $ null goalPackets = head packets + | otherwise = runNetworkUntil255 net3 + where net1 = runNetworkStep net0 + (net2, packets) = extractPackets net1 + net3 = enqueuePackets net2 packets + goalPackets = filter (packet255) packets + + +packet255 :: Packet -> Bool +packet255 packet = (packet ^. destination) == 255 + + +buildNetwork :: [Integer] -> Network +buildNetwork mem = M.fromList $ map (\i -> (i, encapsulate mem i)) [0..49] + + +encapsulate :: [Integer] -> Integer -> EncapsulatedMacine +encapsulate mem input = EncapsulatedMacine + { _machine = makeMachine mem + , _executionState = Runnable + , _machineOutput = [] + , _currentInput = [input] + } + + + + +-- pipelineTrace :: Pipeline -> String +-- pipelineTrace pipeline = show $ M.toList $ M.map emTrace pipeline + +-- emTrace e = intercalate " ; " terms +-- where terms = [ show $ _executionState e +-- , "in" +-- , show $ _currentInput e +-- , "out" +-- , show $ _machineOutput e +-- ] + +runNetworkStep :: Network -> Network +runNetworkStep net = M.map runEncapsulatedMachine net + +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 = fromIntegral $ 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 :: 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]) + + +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 diff --git a/data/advent23.txt b/data/advent23.txt new file mode 100644 index 0000000..63300e3 --- /dev/null +++ b/data/advent23.txt @@ -0,0 +1 @@ +3,62,1001,62,11,10,109,2249,105,1,0,2140,1911,1023,1505,1973,1204,1103,674,1742,1474,2218,1167,1773,2072,1058,1942,1235,1536,1332,1806,1134,606,796,2107,736,1678,990,639,1433,2181,837,1268,1606,1878,2004,765,571,901,1299,1367,1837,1569,2035,961,1402,1709,932,868,705,1637,0,0,0,0,0,0,0,0,0,0,0,0,3,64,1008,64,-1,62,1006,62,88,1006,61,170,1106,0,73,3,65,20101,0,64,1,20102,1,66,2,21102,105,1,0,1105,1,436,1201,1,-1,64,1007,64,0,62,1005,62,73,7,64,67,62,1006,62,73,1002,64,2,132,1,132,68,132,1002,0,1,62,1001,132,1,140,8,0,65,63,2,63,62,62,1005,62,73,1002,64,2,161,1,161,68,161,1101,1,0,0,1001,161,1,169,102,1,65,0,1102,1,1,61,1101,0,0,63,7,63,67,62,1006,62,203,1002,63,2,194,1,68,194,194,1006,0,73,1001,63,1,63,1105,1,178,21102,1,210,0,106,0,69,2101,0,1,70,1102,0,1,63,7,63,71,62,1006,62,250,1002,63,2,234,1,72,234,234,4,0,101,1,234,240,4,0,4,70,1001,63,1,63,1106,0,218,1106,0,73,109,4,21101,0,0,-3,21101,0,0,-2,20207,-2,67,-1,1206,-1,293,1202,-2,2,283,101,1,283,283,1,68,283,283,22001,0,-3,-3,21201,-2,1,-2,1106,0,263,21201,-3,0,-3,109,-4,2105,1,0,109,4,21101,1,0,-3,21101,0,0,-2,20207,-2,67,-1,1206,-1,342,1202,-2,2,332,101,1,332,332,1,68,332,332,22002,0,-3,-3,21201,-2,1,-2,1105,1,312,21202,-3,1,-3,109,-4,2106,0,0,109,1,101,1,68,358,21001,0,0,1,101,3,68,366,21002,0,1,2,21101,0,376,0,1105,1,436,21201,1,0,0,109,-1,2105,1,0,1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536,131072,262144,524288,1048576,2097152,4194304,8388608,16777216,33554432,67108864,134217728,268435456,536870912,1073741824,2147483648,4294967296,8589934592,17179869184,34359738368,68719476736,137438953472,274877906944,549755813888,1099511627776,2199023255552,4398046511104,8796093022208,17592186044416,35184372088832,70368744177664,140737488355328,281474976710656,562949953421312,1125899906842624,109,8,21202,-6,10,-5,22207,-7,-5,-5,1205,-5,521,21101,0,0,-4,21101,0,0,-3,21101,0,51,-2,21201,-2,-1,-2,1201,-2,385,470,21001,0,0,-1,21202,-3,2,-3,22207,-7,-1,-5,1205,-5,496,21201,-3,1,-3,22102,-1,-1,-5,22201,-7,-5,-7,22207,-3,-6,-5,1205,-5,515,22102,-1,-6,-5,22201,-3,-5,-3,22201,-1,-4,-4,1205,-2,461,1106,0,547,21101,0,-1,-4,21202,-6,-1,-6,21207,-7,0,-5,1205,-5,547,22201,-7,-6,-7,21201,-4,1,-4,1105,1,529,21202,-4,1,-7,109,-8,2105,1,0,109,1,101,1,68,563,21001,0,0,0,109,-1,2106,0,0,1101,29983,0,66,1101,3,0,67,1102,598,1,68,1102,1,302,69,1101,1,0,71,1102,604,1,72,1106,0,73,0,0,0,0,0,0,41,914,1101,0,19759,66,1101,2,0,67,1102,633,1,68,1101,302,0,69,1102,1,1,71,1101,637,0,72,1106,0,73,0,0,0,0,13,16574,1101,65981,0,66,1101,0,3,67,1101,666,0,68,1102,1,302,69,1102,1,1,71,1102,672,1,72,1105,1,73,0,0,0,0,0,0,23,2962,1102,93283,1,66,1101,1,0,67,1101,701,0,68,1102,1,556,69,1101,0,1,71,1101,0,703,72,1106,0,73,1,6381,28,316542,1102,21991,1,66,1102,1,1,67,1102,732,1,68,1101,0,556,69,1102,1,1,71,1101,0,734,72,1106,0,73,1,72610,28,158271,1102,59083,1,66,1102,1,1,67,1101,0,763,68,1101,0,556,69,1102,0,1,71,1102,1,765,72,1105,1,73,1,1321,1101,0,21859,66,1101,0,1,67,1101,0,792,68,1102,1,556,69,1101,0,1,71,1101,0,794,72,1105,1,73,1,4,22,32974,1102,16487,1,66,1102,1,6,67,1101,823,0,68,1101,302,0,69,1102,1,1,71,1102,1,835,72,1105,1,73,0,0,0,0,0,0,0,0,0,0,0,0,41,1828,1101,0,39761,66,1102,1,1,67,1102,864,1,68,1101,556,0,69,1102,1,1,71,1101,866,0,72,1105,1,73,1,29,11,160526,1101,7297,0,66,1101,2,0,67,1101,895,0,68,1102,1,302,69,1102,1,1,71,1101,899,0,72,1106,0,73,0,0,0,0,27,65981,1102,1,40351,66,1102,1,1,67,1102,1,928,68,1101,0,556,69,1102,1,1,71,1102,1,930,72,1106,0,73,1,97,22,98922,1101,1693,0,66,1102,1,1,67,1102,959,1,68,1102,556,1,69,1101,0,0,71,1102,961,1,72,1106,0,73,1,1200,1102,1,1759,66,1102,1,1,67,1102,988,1,68,1101,0,556,69,1101,0,0,71,1102,990,1,72,1106,0,73,1,1465,1101,0,49667,66,1101,1,0,67,1102,1,1017,68,1101,556,0,69,1101,2,0,71,1101,1019,0,72,1106,0,73,1,6163,22,16487,29,359132,1102,1,7591,66,1101,3,0,67,1101,1050,0,68,1102,302,1,69,1102,1,1,71,1101,1056,0,72,1105,1,73,0,0,0,0,0,0,41,1371,1102,1,39373,66,1101,1,0,67,1101,0,1085,68,1102,1,556,69,1101,0,8,71,1101,0,1087,72,1105,1,73,1,1,12,55469,17,58897,33,4261,16,87562,11,80263,38,35053,18,99289,29,179566,1101,0,39551,66,1101,0,1,67,1102,1,1130,68,1102,556,1,69,1101,1,0,71,1101,1132,0,72,1106,0,73,1,125,42,198788,1101,59863,0,66,1102,1,1,67,1102,1,1161,68,1101,556,0,69,1101,0,2,71,1101,1163,0,72,1106,0,73,1,10,42,149091,40,102513,1101,80263,0,66,1102,1,4,67,1102,1194,1,68,1101,302,0,69,1102,1,1,71,1102,1,1202,72,1105,1,73,0,0,0,0,0,0,0,0,13,24861,1102,1,32363,66,1102,1,1,67,1101,0,1231,68,1102,556,1,69,1101,0,1,71,1102,1233,1,72,1106,0,73,1,3,21,19759,1101,43781,0,66,1101,0,2,67,1101,0,1262,68,1101,0,302,69,1102,1,1,71,1102,1266,1,72,1105,1,73,0,0,0,0,22,49461,1102,74597,1,66,1102,1,1,67,1102,1,1295,68,1102,556,1,69,1102,1,1,71,1102,1297,1,72,1105,1,73,1,160,40,205026,1102,1,35053,66,1101,0,2,67,1101,1326,0,68,1101,302,0,69,1102,1,1,71,1101,0,1330,72,1106,0,73,0,0,0,0,18,297867,1101,99289,0,66,1101,3,0,67,1101,0,1359,68,1101,302,0,69,1101,1,0,71,1101,0,1365,72,1105,1,73,0,0,0,0,0,0,13,8287,1101,51287,0,66,1102,1,1,67,1102,1,1394,68,1101,0,556,69,1101,0,3,71,1102,1396,1,72,1105,1,73,1,5,42,49697,42,99394,40,136684,1101,0,5693,66,1102,1,1,67,1102,1429,1,68,1101,0,556,69,1101,1,0,71,1101,0,1431,72,1105,1,73,1,-1452,28,52757,1101,52757,0,66,1101,6,0,67,1101,0,1460,68,1101,253,0,69,1101,0,1,71,1102,1472,1,72,1106,0,73,0,0,0,0,0,0,0,0,0,0,0,0,21,39518,1101,0,15787,66,1101,1,0,67,1101,0,1501,68,1102,1,556,69,1102,1,1,71,1101,0,1503,72,1106,0,73,1,20,18,198578,1101,0,98299,66,1102,1,1,67,1101,1532,0,68,1101,556,0,69,1101,0,1,71,1102,1534,1,72,1106,0,73,1,29289,28,263785,1102,1,58897,66,1102,1,2,67,1101,1563,0,68,1102,302,1,69,1101,0,1,71,1102,1567,1,72,1105,1,73,0,0,0,0,33,8522,1101,0,457,66,1102,4,1,67,1102,1,1596,68,1101,253,0,69,1101,0,1,71,1101,1604,0,72,1106,0,73,0,0,0,0,0,0,0,0,45,71059,1101,23173,0,66,1102,1,1,67,1102,1,1633,68,1102,556,1,69,1101,1,0,71,1101,1635,0,72,1106,0,73,1,-3,29,269349,1101,0,4673,66,1102,1,1,67,1102,1,1664,68,1102,556,1,69,1102,1,6,71,1101,1666,0,72,1106,0,73,1,2,22,82435,47,7297,27,197943,29,89783,40,34171,40,170855,1102,90173,1,66,1101,1,0,67,1101,1705,0,68,1101,0,556,69,1101,0,1,71,1101,1707,0,72,1106,0,73,1,34693,12,110938,1101,71059,0,66,1102,1,2,67,1101,0,1736,68,1101,0,351,69,1102,1,1,71,1102,1740,1,72,1106,0,73,0,0,0,0,255,22469,1102,1,71263,66,1101,1,0,67,1102,1769,1,68,1102,1,556,69,1102,1,1,71,1102,1,1771,72,1106,0,73,1,11,22,65948,1102,1,55469,66,1102,1,2,67,1102,1800,1,68,1101,302,0,69,1102,1,1,71,1101,1804,0,72,1106,0,73,0,0,0,0,17,117794,1102,97961,1,66,1102,1,1,67,1102,1,1833,68,1101,0,556,69,1101,1,0,71,1102,1,1835,72,1105,1,73,1,-5377,28,211028,1102,34171,1,66,1101,0,6,67,1101,1864,0,68,1101,0,302,69,1102,1,1,71,1102,1876,1,72,1105,1,73,0,0,0,0,0,0,0,0,0,0,0,0,45,142118,1102,4261,1,66,1102,2,1,67,1102,1905,1,68,1101,0,302,69,1101,0,1,71,1101,1909,0,72,1105,1,73,0,0,0,0,16,43781,1102,21587,1,66,1102,1,1,67,1101,0,1938,68,1102,556,1,69,1102,1,1,71,1102,1940,1,72,1106,0,73,1,179,27,131962,1101,36373,0,66,1102,1,1,67,1102,1969,1,68,1102,556,1,69,1101,1,0,71,1101,0,1971,72,1105,1,73,1,-404,11,321052,1101,0,69593,66,1101,1,0,67,1101,0,2000,68,1102,556,1,69,1102,1,1,71,1101,2002,0,72,1106,0,73,1,16948,28,105514,1102,15569,1,66,1101,1,0,67,1101,2031,0,68,1102,1,556,69,1101,1,0,71,1101,2033,0,72,1106,0,73,1,71153,38,70106,1102,1,49697,66,1102,1,4,67,1101,0,2062,68,1102,1,302,69,1101,0,1,71,1102,1,2070,72,1106,0,73,0,0,0,0,0,0,0,0,40,68342,1101,0,8287,66,1101,0,3,67,1101,0,2099,68,1102,253,1,69,1102,1,1,71,1101,0,2105,72,1106,0,73,0,0,0,0,0,0,47,14594,1101,1481,0,66,1102,2,1,67,1101,0,2134,68,1101,302,0,69,1102,1,1,71,1101,2138,0,72,1105,1,73,0,0,0,0,41,457,1101,22469,0,66,1102,1,1,67,1101,2167,0,68,1101,556,0,69,1101,0,6,71,1101,2169,0,72,1106,0,73,1,19770,23,1481,36,29983,36,59966,2,7591,2,15182,2,22773,1102,89783,1,66,1102,1,4,67,1102,2208,1,68,1101,0,302,69,1102,1,1,71,1101,0,2216,72,1106,0,73,0,0,0,0,0,0,0,0,36,89949,1102,1,11987,66,1102,1,1,67,1101,2245,0,68,1102,556,1,69,1102,1,1,71,1102,1,2247,72,1106,0,73,1,14,11,240789 diff --git a/stack.yaml b/stack.yaml index fb6add8..afb8d2e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -60,6 +60,7 @@ packages: - advent20 - advent21 - advent22 +- advent23 # Dependency packages to be pulled from upstream that are not in the resolver. -- 2.34.1