From 11affea893dfb3ccffa8f242fcd07af399501125 Mon Sep 17 00:00:00 2001 From: gaedep59197 <51162575+gaedep59197@users.noreply.github.com> Date: Thu, 12 Dec 2019 14:29:31 +0100 Subject: [PATCH] Day9 (#2) --- app/Main.hs | 8 +- app/input_day9 | 1 + output | 1 + src/Day7.hs | 10 +-- src/Day9.hs | 21 +++++ src/IntCode.hs | 207 +++++++++++++++++++++++-------------------------- 6 files changed, 134 insertions(+), 114 deletions(-) create mode 100755 app/input_day9 create mode 100644 output create mode 100644 src/Day9.hs diff --git a/app/Main.hs b/app/Main.hs index 05b47e0..4253151 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,6 +8,7 @@ import Day5 import Day6 import Day7 import Day8 +import Day9 import System.IO import Data.List.Split import Data.Set @@ -69,4 +70,9 @@ main = do putStr "[Day 8-1] Result: " print $ day8_result1 r_day8 putStrLn "[Day 8-2] Result: " - day8_result2 r_day8 \ No newline at end of file + day8_result2 r_day8 + r_day9 <- readFile "./app/input_day9" + putStr "[Day 9-1] Result: " + print $ day9_result1 r_day9 + putStr "[Day 9-2] Result: " + print $ day9_result2 r_day9 \ No newline at end of file diff --git a/app/input_day9 b/app/input_day9 new file mode 100755 index 0000000..3b60249 --- /dev/null +++ b/app/input_day9 @@ -0,0 +1 @@ +1102,34463338,34463338,63,1007,63,34463338,63,1005,63,53,1102,1,3,1000,109,988,209,12,9,1000,209,6,209,3,203,0,1008,1000,1,63,1005,63,65,1008,1000,2,63,1005,63,902,1008,1000,0,63,1005,63,58,4,25,104,0,99,4,0,104,0,99,4,17,104,0,99,0,0,1101,0,39,1005,1102,1,1,1021,1101,0,212,1025,1101,0,24,1014,1102,22,1,1019,1101,0,35,1003,1101,38,0,1002,1101,0,571,1026,1102,32,1,1006,1102,31,1,1000,1102,25,1,1018,1102,1,37,1016,1101,0,820,1023,1102,1,29,1004,1101,564,0,1027,1101,0,375,1028,1101,26,0,1013,1102,1,370,1029,1101,21,0,1007,1101,0,0,1020,1102,1,30,1001,1102,36,1,1011,1102,1,27,1017,1101,0,28,1012,1101,0,217,1024,1101,823,0,1022,1102,1,20,1009,1101,0,23,1010,1101,34,0,1015,1101,33,0,1008,109,5,1208,0,39,63,1005,63,199,4,187,1106,0,203,1001,64,1,64,1002,64,2,64,109,13,2105,1,6,4,209,1105,1,221,1001,64,1,64,1002,64,2,64,109,-4,21108,40,39,-1,1005,1013,241,1001,64,1,64,1105,1,243,4,227,1002,64,2,64,109,5,21102,41,1,-1,1008,1018,40,63,1005,63,267,1001,64,1,64,1106,0,269,4,249,1002,64,2,64,109,-28,1202,10,1,63,1008,63,30,63,1005,63,291,4,275,1106,0,295,1001,64,1,64,1002,64,2,64,109,24,21107,42,43,-4,1005,1011,313,4,301,1106,0,317,1001,64,1,64,1002,64,2,64,109,-8,21108,43,43,3,1005,1010,335,4,323,1105,1,339,1001,64,1,64,1002,64,2,64,109,-8,1207,4,34,63,1005,63,359,1001,64,1,64,1106,0,361,4,345,1002,64,2,64,109,26,2106,0,3,4,367,1106,0,379,1001,64,1,64,1002,64,2,64,109,-21,2102,1,-2,63,1008,63,37,63,1005,63,399,1105,1,405,4,385,1001,64,1,64,1002,64,2,64,109,2,1207,-2,30,63,1005,63,427,4,411,1001,64,1,64,1105,1,427,1002,64,2,64,109,4,2108,36,-5,63,1005,63,447,1001,64,1,64,1106,0,449,4,433,1002,64,2,64,109,-13,1201,8,0,63,1008,63,41,63,1005,63,469,1106,0,475,4,455,1001,64,1,64,1002,64,2,64,109,14,21107,44,43,3,1005,1014,495,1001,64,1,64,1106,0,497,4,481,1002,64,2,64,109,2,1205,8,511,4,503,1106,0,515,1001,64,1,64,1002,64,2,64,109,14,1206,-6,527,1105,1,533,4,521,1001,64,1,64,1002,64,2,64,109,-29,2107,31,8,63,1005,63,551,4,539,1105,1,555,1001,64,1,64,1002,64,2,64,109,28,2106,0,1,1001,64,1,64,1106,0,573,4,561,1002,64,2,64,109,-3,21101,45,0,-4,1008,1019,45,63,1005,63,595,4,579,1105,1,599,1001,64,1,64,1002,64,2,64,109,-23,1208,2,39,63,1005,63,615,1105,1,621,4,605,1001,64,1,64,1002,64,2,64,109,15,2108,32,-9,63,1005,63,643,4,627,1001,64,1,64,1105,1,643,1002,64,2,64,109,-9,2107,33,0,63,1005,63,659,1106,0,665,4,649,1001,64,1,64,1002,64,2,64,109,7,21101,46,0,2,1008,1015,49,63,1005,63,689,1001,64,1,64,1106,0,691,4,671,1002,64,2,64,109,-8,2101,0,-3,63,1008,63,35,63,1005,63,711,1105,1,717,4,697,1001,64,1,64,1002,64,2,64,109,12,1202,-9,1,63,1008,63,31,63,1005,63,741,1001,64,1,64,1105,1,743,4,723,1002,64,2,64,109,-27,2102,1,10,63,1008,63,31,63,1005,63,769,4,749,1001,64,1,64,1105,1,769,1002,64,2,64,109,9,2101,0,1,63,1008,63,31,63,1005,63,791,4,775,1106,0,795,1001,64,1,64,1002,64,2,64,109,28,1206,-7,809,4,801,1105,1,813,1001,64,1,64,1002,64,2,64,2105,1,-4,1106,0,829,4,817,1001,64,1,64,1002,64,2,64,109,-15,21102,47,1,-2,1008,1010,47,63,1005,63,851,4,835,1106,0,855,1001,64,1,64,1002,64,2,64,109,5,1205,3,867,1106,0,873,4,861,1001,64,1,64,1002,64,2,64,109,-12,1201,0,0,63,1008,63,39,63,1005,63,895,4,879,1105,1,899,1001,64,1,64,4,64,99,21101,0,27,1,21102,913,1,0,1106,0,920,21201,1,47951,1,204,1,99,109,3,1207,-2,3,63,1005,63,962,21201,-2,-1,1,21101,0,940,0,1105,1,920,21201,1,0,-1,21201,-2,-3,1,21101,0,955,0,1106,0,920,22201,1,-1,-2,1105,1,966,21202,-2,1,-2,109,-3,2105,1,0 diff --git a/output b/output new file mode 100644 index 0000000..d9c56a6 --- /dev/null +++ b/output @@ -0,0 +1 @@ +HALTED {outputs = [203,0]} diff --git a/src/Day7.hs b/src/Day7.hs index 6c087d2..ea15995 100644 --- a/src/Day7.hs +++ b/src/Day7.hs @@ -16,9 +16,9 @@ calculateAmpForPhases phases p = foldr f 0 $ reverse phases where f a b = calculateAmp a b p calculateAmp :: Integer -> Integer -> String -> Integer -calculateAmp phase input = fromJust +calculateAmp phase input = head . snd - . getOutput + . getOutputs . flip runProgram (Just input) . flip runProgram (Just phase) . parseProgram @@ -44,6 +44,6 @@ runRest i ps = runLoop :: Input -> [Program] -> ([Program], Output) runLoop i [] = ([],i) runLoop i (x:xs) = - let (p, mo) = getOutput $ runProgram x (Just i) - (ps, o) = runLoop (fromJust mo) xs in - (p : ps, o) \ No newline at end of file + let (p, os) = getOutputs $ runProgram x (Just i) + (ps, o') = runLoop (head os) xs in + (p : ps, o') \ No newline at end of file diff --git a/src/Day9.hs b/src/Day9.hs new file mode 100644 index 0000000..7c74cee --- /dev/null +++ b/src/Day9.hs @@ -0,0 +1,21 @@ +module Day9 + ( + module Day9 + ) where + +import IntCode + +day9_result1 :: String -> Integer +day9_result1 = head + . snd + . getOutputs + . flip runProgram (Just 1) + . parseProgram + +day9_result2 :: String -> Integer +day9_result2 = head + . snd + . getOutputs + . flip runProgram (Just 2) + . parseProgram + \ No newline at end of file diff --git a/src/IntCode.hs b/src/IntCode.hs index d47d300..035e693 100644 --- a/src/IntCode.hs +++ b/src/IntCode.hs @@ -7,7 +7,7 @@ module IntCode , Program(..) , parseProgram , runProgram - , getOutput + , getOutputs , isHalted ) where @@ -17,55 +17,67 @@ import Control.Applicative import qualified Data.Text as T import qualified Data.Attoparsec.Text as P import qualified Data.Vector as V +import qualified Data.Map as M -data ADDR = POSITION Int - | IMMEDIATE Integer - deriving (Show) +import Debug.Trace + +-- type Memory = V.Vector Integer +type Memory = M.Map Int Integer + +newtype ADDR = ADDR { runADDR :: Program -> Integer } +newtype WADDR = WADDR { runWADDR :: Program -> Int } + -- POSITION Int + -- | IMMEDIATE Integer + -- deriving (Show) +-- instance Show ADDR where +-- show a = "_" type Input = Integer type Output = Integer -data Instruction = ADD ADDR ADDR Int - | MUL ADDR ADDR Int - | STORE Int - | LOAD Int +data Instruction = ADD ADDR ADDR WADDR + | MUL ADDR ADDR WADDR + | STORE WADDR + | LOAD ADDR --{ runLoad :: Program -> Integer } | JMPT ADDR ADDR | JMPF ADDR ADDR - | LT' ADDR ADDR Int - | EQ' ADDR ADDR Int + | LT' ADDR ADDR WADDR + | EQ' ADDR ADDR WADDR + | RB ADDR --{ runLoad :: Program -> Integer } | HALT - deriving (Show) + -- deriving (Show) -type Memory = V.Vector Integer type PC = Int -- type RunningProg = ([Input], Memory, PC, [Output]) data Program = RUNNING { memory :: Memory , pc ::PC - , output :: Maybe Output } + , output :: [Output] + , rbase :: Integer } | WAITING { memory :: Memory , pc ::PC - , output :: Maybe Output } - | HALTED { outputs :: Output } + , output :: [Output] + , rbase :: Integer } + | HALTED { outputs :: [Output] } deriving (Show) parseProgram :: String -> Program -parseProgram s = WAITING (parseMemory (T.pack s)) 0 Nothing +parseProgram s = RUNNING (parseMemory (T.pack s)) 0 [] 0 parseMemory :: T.Text -> Memory parseMemory t = let parsed = P.parse (P.sepBy1 (P.signed P.decimal) (P.char ',')) t in case parsed of - P.Done _ r -> V.fromList r - P.Partial f -> V.fromList $ + P.Done _ r -> M.fromList $ zip [0..] r + P.Partial f -> M.fromList . zip [0..] $ fromMaybe [] (P.maybeResult (P.feed parsed "")) - _ -> V.empty + _ -> M.empty -getOutput :: Program -> (Program, Maybe Output) -getOutput (HALTED o) = (HALTED o, Just o) -getOutput (RUNNING m c o) = (RUNNING m c Nothing, o) -getOutput (WAITING m c o) = (WAITING m c Nothing, o) +getOutputs :: Program -> (Program, [Output]) +getOutputs (HALTED o) = (HALTED o, o) +getOutputs (RUNNING m c o b) = (RUNNING m c [] b, o) +getOutputs (WAITING m c o b) = (WAITING m c [] b, o) isHalted :: Program -> Bool isHalted HALTED{} = True @@ -73,41 +85,58 @@ isHalted _ = False runProgram :: Program -> Maybe Input -> Program runProgram p@HALTED{} _ = p -runProgram p@(WAITING m c o) Nothing = p -runProgram (WAITING m c o) mi = runProgram (RUNNING m c o) mi -runProgram p@(RUNNING m' pc _) i = +runProgram p@WAITING{} Nothing = p +runProgram (WAITING m c o b) mi = runProgram (RUNNING m c o b) mi +runProgram p@(RUNNING m' pc _ _) i = let inst = parseInstruction m' pc (p', input) = executeInstruction i p inst in - runProgram p' input + runProgram p' input + +fd :: Memory -> Int -> Integer +fd m i = M.findWithDefault 0 i m parseInstruction :: Memory -> PC -> Instruction parseInstruction p i = - let inst = p V.! i - a = (inst `div` 10000) /= 0 - b = (inst `mod` 10000) `div` 1000 /= 0 - c = (inst `mod` 1000) `div` 100 /= 0 + let inst = p `fd` i + a = (inst `div` 10000) + b = (inst `mod` 10000) `div` 1000 + c = (inst `mod` 1000) `div` 100 de = (inst `mod` 100) - addr b a = if b then IMMEDIATE a else POSITION (fromInteger a) + -- addr b a = case b of + -- 0 -> ADDR $ fromIntegral . flip fd (fromInteger a) . memory + -- 1 -> ADDR $ const (fromIntegral a) + -- 2 -> ADDR $ fromInteger . (+a) . rbase + -- _ -> error "not supported mode" + waddr b a = case b of + 0 -> WADDR $ fromInteger . const a + 2 -> WADDR $ fromInteger . (+a) . rbase + _ -> error $ "not supported write mode " ++ show b ++ " " ++ show a + raddr b a = case b of + 0 -> ADDR $ flip fd (fromInteger a) . memory + 1 -> ADDR $ const a + 2 -> ADDR $ \p -> fd (memory p) (fromInteger $ rbase p + a) + _ -> error $ "not supported load mode " ++ show b ++ " " ++ show a in case de of - 1 -> ADD (addr c (p V.! (i+1))) - (addr b (p V.! (i+2))) - (fromInteger (p V.! (i+3))) - 2 -> MUL (addr c (p V.! (i+1))) - (addr b (p V.! (i+2))) - (fromInteger (p V.! (i+3))) - 3 -> STORE $ fromInteger (p V.! (i+1)) - 4 -> LOAD $ fromInteger (p V.! (i+1)) - 5 -> JMPT (addr c (p V.! (i+1))) (addr b (p V.! (i+2))) - 6 -> JMPF (addr c (p V.! (i+1))) (addr b (p V.! (i+2))) - 7 -> LT' (addr c (p V.! (i+1))) - (addr b (p V.! (i+2))) - (fromInteger (p V.! (i+3))) - 8 -> EQ' (addr c (p V.! (i+1))) - (addr b (p V.! (i+2))) - (fromInteger (p V.! (i+3))) + 1 -> ADD (raddr c (p `fd` (i+1))) + (raddr b (p `fd` (i+2))) + (waddr a (p `fd` (i+3))) + 2 -> MUL (raddr c (p `fd` (i+1))) + (raddr b (p `fd` (i+2))) + (waddr a (p `fd` (i+3))) + 3 -> STORE $ waddr c (p `fd` (i+1)) + 4 -> LOAD $ raddr c (p `fd` (i+1)) + 5 -> JMPT (raddr c (p `fd` (i+1))) (raddr b (p `fd` (i+2))) + 6 -> JMPF (raddr c (p `fd` (i+1))) (raddr b (p `fd` (i+2))) + 7 -> LT' (raddr c (p `fd` (i+1))) + (raddr b (p `fd` (i+2))) + (waddr a (p `fd` (i+3))) + 8 -> EQ' (raddr c (p `fd` (i+1))) + (raddr b (p `fd` (i+2))) + (waddr a (p `fd` (i+3))) + 9 -> RB $ raddr c (p `fd` (i+1)) 99 -> HALT - _ -> error $ "unknown instruction " ++ show ((a,b,c), de) + _ -> error $ "unknown instruction " ++ show ((a,b,c), de, p, i) executeInstruction :: Maybe Input -> Program @@ -115,64 +144,26 @@ executeInstruction :: Maybe Input -> (Program, Maybe Input) executeInstruction mi p@(HALTED _) _ = (p, mi) executeInstruction Nothing p@WAITING{} _ = (p, Nothing) -executeInstruction (Just input) p@(WAITING m pc o) i = - executeInstruction (Just input) (RUNNING m pc o) i -- try running again -executeInstruction mi (RUNNING p pc outputs) i = +-- executeInstruction input p@(WAITING _ _ (Just _) _) _ = (p, input) +executeInstruction input p@(WAITING m pc o b) i = + executeInstruction input (RUNNING m pc o b) i -- try running again +executeInstruction mi p@(RUNNING m pc outputs base) i = case i of - ADD (POSITION a) (POSITION b) c -> - (RUNNING (p V.// [(c, (p V.! a) + (p V.! b))]) (pc + 4) outputs, mi) - ADD (POSITION a) (IMMEDIATE b) c -> - (RUNNING (p V.// [(c, (p V.! a) + b)]) (pc + 4) outputs, mi) - ADD (IMMEDIATE a) (POSITION b) c -> - (RUNNING (p V.// [(c, a + (p V.! b))]) (pc + 4) outputs, mi) - ADD (IMMEDIATE a) (IMMEDIATE b) c -> - (RUNNING (p V.// [(c, a + b)]) (pc + 4) outputs, mi) - MUL (POSITION a) (POSITION b) c -> - (RUNNING (p V.// [(c, (p V.! a) * (p V.! b))]) (pc + 4) outputs, mi) - MUL (POSITION a) (IMMEDIATE b) c -> - (RUNNING (p V.// [(c, (p V.! a) * b)]) (pc + 4) outputs, mi) - MUL (IMMEDIATE a) (POSITION b) c -> - (RUNNING (p V.// [(c, a * (p V.! b))]) (pc + 4) outputs, mi) - MUL (IMMEDIATE a) (IMMEDIATE b) c -> - (RUNNING (p V.// [(c, a * b)]) (pc + 4) outputs, mi) + ADD a b c -> + (RUNNING (M.insert (runWADDR c p) (fromIntegral (runADDR a p + runADDR b p)) m) (pc + 4) outputs base, mi) + MUL a b c -> + (RUNNING (M.insert (runWADDR c p) (fromIntegral (runADDR a p * runADDR b p)) m) (pc + 4) outputs base, mi) STORE a -> case mi of - Nothing -> (WAITING p pc outputs, mi) - Just b -> (RUNNING (p V.// [(a, b)]) (pc + 2) outputs, Nothing) - LOAD a -> (RUNNING p (pc + 2) (Just $ p V.! a), mi) - JMPT (POSITION a) (POSITION b) -> - (RUNNING p (if (p V.! a) /= 0 then fromInteger (p V.! b) else pc + 3) outputs, mi) - JMPT (POSITION a) (IMMEDIATE b) -> - (RUNNING p (if (p V.! a) /= 0 then fromInteger b else pc + 3) outputs, mi) - JMPT (IMMEDIATE a) (POSITION b) -> - (RUNNING p (if a /= 0 then fromInteger (p V.! b) else pc + 3) outputs, mi) - JMPT (IMMEDIATE a) (IMMEDIATE b) -> - (RUNNING p (if a /= 0 then fromInteger b else pc + 3) outputs, mi) - JMPF (POSITION a) (POSITION b) -> - (RUNNING p (if (p V.! a) == 0 then fromInteger (p V.! b) else pc + 3) outputs, mi) - JMPF (POSITION a) (IMMEDIATE b) -> - (RUNNING p (if (p V.! a) == 0 then fromInteger b else pc + 3) outputs, mi) - JMPF (IMMEDIATE a) (POSITION b) -> - (RUNNING p (if a == 0 then fromInteger (p V.! b) else pc + 3) outputs, mi) - JMPF (IMMEDIATE a) (IMMEDIATE b) -> - (RUNNING p (if a == 0 then fromInteger b else pc + 3) outputs, mi) - LT' (POSITION a) (POSITION b) c -> - (RUNNING (p V.// [(c, if (p V.! a) < (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi) - LT' (POSITION a) (IMMEDIATE b) c -> - (RUNNING (p V.// [(c, if (p V.! a) < b then 1 else 0)]) (pc + 4) outputs, mi) - LT' (IMMEDIATE a) (POSITION b) c -> - (RUNNING (p V.// [(c, if a < (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi) - LT' (IMMEDIATE a) (IMMEDIATE b) c -> - (RUNNING (p V.// [(c, if a < b then 1 else 0)]) (pc + 4) outputs, mi) - EQ' (POSITION a) (POSITION b) c -> - (RUNNING (p V.// [(c, if (p V.! a) == (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi) - EQ' (POSITION a) (IMMEDIATE b) c -> - (RUNNING (p V.// [(c, if (p V.! a) == b then 1 else 0)]) (pc + 4) outputs, mi) - EQ' (IMMEDIATE a) (POSITION b) c -> - (RUNNING (p V.// [(c, if a == (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi) - EQ' (IMMEDIATE a) (IMMEDIATE b) c -> - (RUNNING (p V.// [(c, if a == b then 1 else 0)]) (pc + 4) outputs, mi) - HALT -> (HALTED (fromJust outputs), mi) - -extractHead :: [a] -> Maybe (a, [a]) -extractHead [] = Nothing -extractHead (x:xs) = Just (x, xs) + Nothing -> (WAITING m pc outputs base, mi) + Just b -> (RUNNING (M.insert (runWADDR a p) b m) (pc + 2) outputs base, Nothing) + LOAD a -> (RUNNING m (pc + 2) (outputs ++ [runADDR a p]) base, mi) + JMPT a b -> + (RUNNING m (if runADDR a p /= 0 then fromInteger $ runADDR b p else pc + 3) outputs base, mi) + JMPF a b -> + (RUNNING m (if runADDR a p == 0 then fromInteger $ runADDR b p else pc + 3) outputs base, mi) + LT' a b c -> + (RUNNING (M.insert (runWADDR c p) (if runADDR a p < runADDR b p then 1 else 0) m) (pc + 4) outputs base, mi) + EQ' a b c -> + (RUNNING (M.insert (runWADDR c p) (if runADDR a p == runADDR b p then 1 else 0) m) (pc + 4) outputs base, mi) + RB a -> (RUNNING m (pc + 2) outputs (base + runADDR a p), mi) + HALT -> (HALTED outputs, mi)