Updated Intcode computer + update day2, 5, 7 and WIP on day 9

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

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

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

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

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

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