diff --git a/y2019/src/Day2.hs b/y2019/src/Day2.hs index 09a6a5a..45e2e27 100644 --- a/y2019/src/Day2.hs +++ b/y2019/src/Day2.hs @@ -2,8 +2,14 @@ module Day2 (day2) where import Intcode +replaceNth :: Int -> a -> [a] -> [a] +replaceNth _ _ [] = [] +replaceNth n newVal (x:xs) + | n == 0 = newVal:xs + | otherwise = x:replaceNth (n-1) newVal xs + computeVerbNoun :: Int -> Int -> [Int] -> Int -computeVerbNoun noun verb input = (fst (computer [] newInput [] 0)) !! 0 +computeVerbNoun noun verb input = (runProgramV1 newInput) !! 0 where newInput = replaceNth 1 noun . replaceNth 2 verb $ input bruteforce :: Int -> Int -> [Int] -> Int -> Int diff --git a/y2019/src/Day5.hs b/y2019/src/Day5.hs index 9f4a9f3..70ef52c 100644 --- a/y2019/src/Day5.hs +++ b/y2019/src/Day5.hs @@ -11,8 +11,8 @@ day5 = do let intCodes = parseProgram input - let (_, outputP1) = computer [1] intCodes [] 0 + let outputP1 = runProgramV2 [1] intCodes putStrLn ("Part1: " ++ show (outputP1 !! 0)) - let (_, outputP2) = computer [5] intCodes [] 0 + let outputP2 = runProgramV2 [5] intCodes putStrLn ("Part2: " ++ show (outputP2 !! 0)) diff --git a/y2019/src/Day7.hs b/y2019/src/Day7.hs index ba65c8e..7121081 100644 --- a/y2019/src/Day7.hs +++ b/y2019/src/Day7.hs @@ -5,7 +5,7 @@ import Intcode processProgram :: [Int] -> [Int] -> Int processProgram program inputs = head outputs - where (_, outputs) = computer inputs program [] 0 + where outputs = runProgramV2 inputs program chainProcesses :: [Int] -> [Int] -> Int -> Int chainProcesses program (phase:phases) signal diff --git a/y2019/src/Day9.hs b/y2019/src/Day9.hs new file mode 100644 index 0000000..0c854f5 --- /dev/null +++ b/y2019/src/Day9.hs @@ -0,0 +1,12 @@ +module Day9 (day9) where + +import Intcode + +day9 :: IO () +day9 = do + putStrLn $ "AoC 2019 day 9" + input <- getLine + let memory = parseProgram input + + let outputP1 = runProgramV2 [1] memory + putStrLn $ "Part1: " ++ show outputP1 diff --git a/y2019/src/DayPicker.hs b/y2019/src/DayPicker.hs index 25183e6..8297597 100644 --- a/y2019/src/DayPicker.hs +++ b/y2019/src/DayPicker.hs @@ -13,6 +13,7 @@ import Day5 import Day6 import Day7 import Day8 +import Day9 -- TODO Better way? load :: [String] -> IO () @@ -25,6 +26,7 @@ load ("5":_) = day5 load ("6":_) = day6 load ("7":_) = day7 load ("8":_) = day8 +load ("9":_) = day9 load _ = putStrLn "Unavailable date" dayPicker :: IO () diff --git a/y2019/src/Intcode.hs b/y2019/src/Intcode.hs index a604f5c..6785c99 100644 --- a/y2019/src/Intcode.hs +++ b/y2019/src/Intcode.hs @@ -1,101 +1,156 @@ -module Intcode (computer, parseProgram, replaceNth) where +module Intcode (parseProgram, runProgramV1, runProgramV2) where +import Data.Map import Data.List.Split +import Data.Char --- import Debug.Trace -trace _ x = x +import Debug.Trace +-- trace _ x = x -replaceNth :: Int -> a -> [a] -> [a] -replaceNth _ _ [] = [] -replaceNth n newVal (x:xs) - | n == 0 = newVal:xs - | otherwise = x:replaceNth (n-1) newVal xs +data ParamMode = Position | Direct | Relative deriving (Show) + +data State = State { _index :: Int, + _relIndex :: Int, + _input :: [Int], + _output :: [Int], + _memory :: Map Int Int, + _running :: Bool } deriving (Show) + +data Instr = Instr { _opcode :: Int, + _p1 :: (ParamMode, Int), + _p2 :: (ParamMode, Int), + _p3 :: (ParamMode, Int) + } -- computeOpCode: Take an INT and returns a tuple4: -- - Int = opcode --- - Subsequent bools = Mode of nth param (True = direct / False = pos mode) -computeOpCode :: Int -> (Int, Bool, Bool, Bool) -computeOpCode input = trace ("ComputeOpCode " ++ show input ++ " -> " ++ show result) result +-- - Subsequent ints = Mode of nth param (0 = pos, 1 = direct, 2 = relative) +computeOpCode :: Int -> (Int, ParamMode, ParamMode, ParamMode) +computeOpCode input = result -- trace ("Compute opcode " ++ show input ++ " -> " ++ show result) result where opcode = input `mod` 100 digits = show input len = length digits - firstParamMode = if len > 2 then (digits !! (len - 3)) == '1' else False - secondParamMode = if len > 3 then (digits !! (len - 4)) == '1' else False - thirdParamMode = if len > 4 then (digits !! (len - 5)) == '1' else False - result = (opcode, firstParamMode, secondParamMode, thirdParamMode) + mode1 = convertToPM $ if len > 2 then (ord $ digits !! (len - 3)) - 48 else 0 + mode2 = convertToPM $ if len > 3 then (ord $ digits !! (len - 4)) - 48 else 0 + mode3 = convertToPM $ if len > 4 then (ord $ digits !! (len - 5)) - 48 else 0 + result = (opcode, mode1, mode2, mode3) + convertToPM 0 = Position + convertToPM 1 = Direct + convertToPM 2 = Relative -getValue :: [Int] -> (Int, Bool) -> Int -getValue _ (n, True) = n -getValue r (n, False) = r !! n +getInstruction :: State -> Instr +getInstruction s = Instr opcode param1 param2 param3 + where (opcode, m1, m2, m3) = computeOpCode $ getMemoryAt 0 + param1 = (m1, getMemoryAt 1) + param2 = (m2, getMemoryAt 2) + param3 = (m3, getMemoryAt 3) + getMemoryAt n = (_memory s) ! (n + _index s) --- opcode 1 -opcodeAddition :: [Int] -> (Int, Int, Int) -> [Int] -opcodeAddition regs (operand1, operand2, resultIndex) = replaceNth resultIndex result regs - where result = operand1 + operand2 +getValueSafe :: State -> (ParamMode, Int) -> Int +getValueSafe _ (Position, n) = n +getValueSafe _ (Direct, n) = n +getValueSafe s (Relative, n) = findWithDefault 0 (n + _relIndex s) (_memory s) --- opcode 2 -opcodeMultiplication :: [Int] -> (Int, Int, Int) -> [Int] -opcodeMultiplication regs (operand1, operand2, resultIndex) = replaceNth resultIndex result regs - where result = operand1 * operand2 +getValue :: State -> (ParamMode, Int) -> Int +getValue s (Position, n) = findWithDefault 0 n (_memory s) +getValue _ (Direct, n) = n +getValue s (Relative, n) = findWithDefault 0 (n + _relIndex s) (_memory s) --- opcode 7 -opcodeLessThan :: [Int] -> (Int, Int, Int) -> [Int] -opcodeLessThan regs (operand1, operand2, resultIndex) = replaceNth resultIndex result regs - where result = if operand1 < operand2 then 1 else 0 +compute :: State -> Instr -> State +-- OPCODE 1 - ADDITION +compute s (Instr 1 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory } + where newIndex = (_index s) + 4 + newMemory = insert resultIndex result (_memory s) + resultIndex = getValueSafe s p3 + value1 = getValue s p1 + value2 = getValue s p2 + result = value1 + value2 + dbg x = trace ("ADD\t\t"++ show p1 ++ " [" ++ show value1 ++ "] + "++ show p2 ++" [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] " ++ show p3) x +-- OPCODE 2 - MULTIPLICATION +compute s (Instr 2 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory } + where newIndex = (_index s) + 4 + newMemory = insert resultIndex result (_memory s) + resultIndex = getValueSafe s p3 + value1 = getValue s p1 + value2 = getValue s p2 + result = value1 * value2 + dbg x = trace ("MULT\t\t" ++ show p1 ++ " [" ++ show value1 ++ "] * "++ show p2++" [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x +-- OPCODE 3 - READ +compute s (Instr 3 p1 _ _) = dbg s { _index = newIndex, _memory = newMemory, _input = newInput } + where newIndex = (_index s) + 2 + newMemory = insert resultIndex value (_memory s) + resultIndex = getValueSafe s p1 + value = head $ _input s + newInput = tail $ _input s + dbg x = trace ("READ\t\t[" ++ show value ++ "]\t-> @ [" ++ show resultIndex ++ "] " ++ show p1) x +-- OPCODE 4 - OUTPUT +compute s (Instr 4 p1 _ _) = dbg s { _index = newIndex, _output = newOutput } + where newIndex = (_index s) + 2 + newOutput = value:(_output s) + value = getValue s p1 + dbg x = trace ("OUTPUT\t\t" ++ show p1 ++ " [" ++ show value ++ "]") x +-- OPCODE 5 - JUMP-IF-TRUE +compute s (Instr 5 p1 p2 _) = dbg s { _index = newIndex } + where value = getValue s p1 + jumpTo = getValue s p2 + newIndex = if value /= 0 then jumpTo else (_index s) + 3 + dbg x = trace ("JUMP-IF-TRUE\t" ++ show p1 ++ " [" ++ show value ++ "] JMP TO " ++ show p2 ++ " [" ++ show jumpTo ++ "]\t-> INDEX " ++ show newIndex) x +-- OPCODE 6 - JUMP-IF-FALSE +compute s (Instr 6 p1 p2 _) = dbg s { _index = newIndex } + where value = getValue s p1 + jumpTo = getValue s p2 + newIndex = if value == 0 then jumpTo else (_index s) + 3 + dbg x = trace ("JUMP-IF-FALSE\t" ++ show p1 ++ " [" ++ show value ++ "] JMP TO " ++ show p2 ++ " [" ++ show jumpTo ++ "]\t-> INDEX " ++ show newIndex) x +-- OPCODE 7 - LESS-THAN +compute s (Instr 7 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory } + where newIndex = (_index s) + 4 + value1 = getValue s p1 + value2 = getValue s p2 + resultIndex = getValueSafe s p3 + result = if value1 < value2 then 1 else 0 + newMemory = insert resultIndex result (_memory s) + dbg x = trace ("LESS-THAN\t" ++ show p1 ++ " [" ++ show value1 ++ "] vs " ++ show p2 ++ " [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x +-- OPCODE 8 - EQUALS +compute s (Instr 8 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory } + where newIndex = (_index s) + 4 + value1 = getValue s p1 + value2 = getValue s p2 + result = if value1 == value2 then 1 else 0 + resultIndex = getValueSafe s p3 + newMemory = insert resultIndex result (_memory s) + dbg x = trace ("EQUALS\t\t" ++ show p1 ++ " [" ++ show value1 ++ "] vs " ++ show p2 ++ " [" ++ show value2 ++ "] =\t[" ++ show result ++ "]\t-> @ [" ++ show resultIndex ++ "] "++ show p3) x +-- OPCODE 9 - REL-OFFSET +compute s (Instr 9 p1 _ _) = dbg s { _index = newIndex, _relIndex = newRelIndex } + where value = getValue s p1 + newIndex = (_index s) + 2 + relIndex = _relIndex s + newRelIndex = value + relIndex + dbg x = trace ("REL-OFFSET\t" ++ show p1 ++ " [" ++ show value ++ "] + CUR [" ++ show relIndex ++ "] =\t[" ++ show newRelIndex ++ "]") x +-- OPCODE 99 - EXIT +compute s (Instr 99 _ _ _) = dbg s { _running = False } + where dbg x = trace ("EXIT") x --- opcode 8 -opcodeEqual :: [Int] -> (Int, Int, Int) -> [Int] -opcodeEqual regs (operand1, operand2, resultIndex) = replaceNth resultIndex result regs - where result = if operand1 == operand2 then 1 else 0 +-- ELSE: NOT HANDLED +compute s (Instr n _ _ _) = trace ("Unhandled opcode " ++ show n) s { _running = False } -computer :: [Int] -> [Int] -> [Int] -> Int -> ([Int], [Int]) -computer readValues input output index - | opcode == 1 = let newInput = opcodeAddition input (p1, p2, p3) - p1 = getValue' (val1, mode1) - p2 = getValue' (val2, mode2) - p3 = getValue' (val3, True) - newIndex = index + 4 - in trace ("Opcode1 (add) (" ++ show p1 ++ ") + (" ++ show p2 ++ ") -> @" ++ show p3) computer readValues newInput output newIndex - | opcode == 2 = let newInput = opcodeMultiplication input (p1, p2, p3) - p1 = getValue' (val1, mode1) - p2 = getValue' (val2, mode2) - p3 = getValue' (val3, True) - newIndex = index + 4 - in trace ("Opcode2 (mult) (" ++ show p1 ++ ") * (" ++ show p2 ++ ") -> @" ++ show p3) (computer readValues newInput output newIndex) - | opcode == 3 = let newInput = replaceNth p1 (head readValues) input - p1 = getValue' (val1, True) - newIndex = index + 2 - in trace ("Opcode3 (read) (1) -> @" ++ show p1) computer (tail readValues) newInput output newIndex - | opcode == 4 = let newOutput = p1:output - p1 = getValue' (val1, mode1) - newIndex = index + 2 - in trace ("Opcode4 (output) " ++ show p1) computer readValues input newOutput newIndex - | opcode == 5 = let p1 = getValue' (val1, mode1) - p2 = getValue' (val2, mode2) - newIndex = if p1 /= 0 then p2 else index + 3 - in trace ("Opcode5 (jump-if-true) " ++ show p1 ++ " != 0 ? -> JMP @" ++ show p2) computer readValues input output newIndex - | opcode == 6 = let p1 = getValue' (val1, mode1) - p2 = getValue' (val2, mode2) - newIndex = if p1 == 0 then p2 else index + 3 - in trace ("Opcode6 (jump-if-false) " ++ show p1 ++ " == 0 ? -> JMP @" ++ show p2) computer readValues input output newIndex - | opcode == 7 = let p1 = getValue' (val1, mode1) - p2 = getValue' (val2, mode2) - p3 = getValue' (val3, True) - newInput = opcodeLessThan input (p1, p2, p3) - newIndex = index + 4 - in trace ("Opcode7 (less-than) " ++ show p1 ++ " < " ++ show p2 ++ " ? -> @" ++ show p3) computer readValues newInput output newIndex - | opcode == 8 = let p1 = getValue' (val1, mode1) - p2 = getValue' (val2, mode2) - p3 = getValue' (val3, True) - newInput = opcodeEqual input (p1, p2, p3) - newIndex = index + 4 - in trace ("Opcode7 (equal) " ++ show p1 ++ " == " ++ show p2 ++ " ? -> @" ++ show p3) computer readValues newInput output newIndex - | otherwise = (input, output) - where (opcode, mode1, mode2, mode3) = computeOpCode (input !! index) - getValue' = getValue input - val1 = input !! (index + 1) - val2 = input !! (index + 2) - val3 = input !! (index + 3) +runProgram :: State -> State +runProgram s + | _running(s) == True = let instr = getInstruction s in runProgram (compute s instr) + | otherwise = s parseProgram :: String -> [Int] -parseProgram input = map read (splitOn "," input) +parseProgram input = Prelude.map read (splitOn "," input) + +-- Memory -> updated memory +runProgramV1 :: [Int] -> [Int] +runProgramV1 mem = Prelude.map snd . toList $ _memory endState + where initialState = State 0 0 [] [] memory True + endState = runProgram initialState + memory = fromList $ zip (iterate (+1) 0) mem + +-- Input -> memory -> output +runProgramV2 :: [Int] -> [Int] -> [Int] +runProgramV2 input mem = _output endState + where initialState = State 0 0 input [] memory True + endState = runProgram initialState + memory = fromList $ zip (iterate (+1) 0) mem