Mithror
/
AdventOfCode2019
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Day9

Browse Source
pull/2/head
Gaël Depreeuw 5 years ago
parent b7be857e07
commit 4bd458ca0d
6 changed files with 134 additions and 114 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 8
      app/Main.hs
  2. 1
      app/input_day9
  3. 1
      output
  4. 10
      src/Day7.hs
  5. 21
      src/Day9.hs
  6. 207
      src/IntCode.hs

8
app/Main.hs
Unescape View File

@ -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
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

1
app/input_day9
Unescape View File

@ -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

1
output
Unescape View File

@ -0,0 +1 @@
HALTED {outputs = [203,0]}

10
src/Day7.hs
Unescape View File

@ -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)
let (p, os) = getOutputs $ runProgram x (Just i)
(ps, o') = runLoop (head os) xs in
(p : ps, o')

21
src/Day9.hs
Unescape View File

@ -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

207
src/IntCode.hs
Unescape View File

@ -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)

Write Preview
Loading…
Cancel
Save