Day9 #2

Merged
gaedep59197 merged 1 commits from feature/day9 into master 5 years ago
  1. 6
      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,6 +8,7 @@ import Day5
import Day6
import Day7
import Day8
import Day9
import System.IO
import Data.List.Split
import Data.Set
@ -70,3 +71,8 @@ main = do
print $ day8_result1 r_day8
putStrLn "[Day 8-2] Result: "
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

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

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

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

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

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

Loading…
Cancel
Save