Add WIP day7 part 2

y2019/src/Day7.hs

@@ -7,24 +7,35 @@ processProgram :: [Int] -> [Int] -> Int
 processProgram program inputs = head outputs
   where outputs = runProgramV2 inputs program
 
+-- Memory -> phase (1st input) -> 2nd input -> outputs
 chainProcesses :: [Int] -> [Int] -> Int -> Int
-chainProcesses program (phase:phases) signal
+chainProcesses program (phase:nextPhases) signal
-  | null phases = newSignal
+  | (null nextPhases) = newSignal
-  | otherwise = chainProcesses program phases newSignal
+  | otherwise = chainProcesses program nextPhases newSignal
   where newSignal = processProgram program [phase, signal]
 
-testCombinations :: [Int] -> [([Int], Int)]
+testCombinationsP1 :: [Int] -> [([Int], Int)]
-testCombinations program = map (\p -> (p, chainProcesses program p 0)) phasesPerm
+testCombinationsP1 program = map (\p -> (p, chainProcesses program p 0)) phasesPerm
   where phasesPerm = permutations [0..4]
 
+testCombinationsP2 :: [Int] -> [([Int], Int)]
+testCombinationsP2 program = map (\p -> (p, runProgramV3 program p)) phasesPerm
+  where phasesPerm = permutations [5..9]
+
 day7 :: IO ()
 day7 = do
   putStrLn $ "AoC 2019 day 7"
   input <- getLine
 
   let program = parseProgram input
-  let combinations = testCombinations program
+  let combinationsP1 = testCombinationsP1 program
 
-  let p1 = maximumBy (\(_, a) (_, b) -> compare a b) combinations
+  let p1 = maximumBy (\(_, a) (_, b) -> compare a b) combinationsP1
 
   putStrLn $ "Part 1: " ++ (show p1)
+
+  -- WIP
+  let combinationsP2 = testCombinationsP2 program
+  let p2 = maximumBy (\(_, a) (_, b) -> compare a b) combinationsP2
+
+  putStrLn $ "Part 2 (WIP/Buggy): " ++ (show p2)

y2019/src/Intcode.hs

@@ -1,14 +1,16 @@
-module Intcode (parseProgram, runProgramV1, runProgramV2) where
+module Intcode (parseProgram, runProgramV1, runProgramV2, runProgramV3) where
 
 import Data.Map
 import Data.List.Split
 import Data.Char
 
-import Debug.Trace
+-- import Debug.Trace
--- trace _ x = x
+trace _ x = x
 
 data ParamMode = Position | Direct | Relative deriving (Show)
 
+data OpCode = OpAdd | OpMult | OpRead | OpWrite | OpJumpEq | OpJumpNeq | OpLT | OpEq | OpOffset | OpExit deriving (Eq, Show)
+
 data State = State { _index :: Int,
                      _relIndex :: Int,
                      _input :: [Int],
@@ -16,7 +18,7 @@ data State = State { _index :: Int,
                      _memory :: Map Int Int,
                      _running :: Bool } deriving (Show)
 
-data Instr = Instr { _opcode :: Int,
+data Instr = Instr { _opcode :: OpCode,
                      _p1 :: (ParamMode, Int),
                      _p2 :: (ParamMode, Int),
                      _p3 :: (ParamMode, Int)
@@ -25,9 +27,9 @@ data Instr = Instr { _opcode :: Int,
 -- computeOpCode: Take an INT and returns a tuple4:
 -- - Int = opcode
 -- - Subsequent ints = Mode of nth param (0 = pos, 1 = direct, 2 = relative)
-computeOpCode :: Int -> (Int, ParamMode, ParamMode, ParamMode)
+computeOpCode :: Int -> (OpCode, ParamMode, ParamMode, ParamMode)
 computeOpCode input = result -- trace ("Compute opcode " ++ show input ++ " -> " ++ show result) result
-  where opcode = input `mod` 100
+  where opcode = convertOpCode $ input `mod` 100
         digits = show input
         len = length digits
         mode1 = convertToPM $ if len > 2 then (ord $ digits !! (len - 3)) - 48 else 0
@@ -37,6 +39,16 @@ computeOpCode input = result -- trace ("Compute opcode " ++ show input ++ " -> "
         convertToPM 0 = Position
         convertToPM 1 = Direct
         convertToPM 2 = Relative
+        convertOpCode 1 = OpAdd
+        convertOpCode 2 = OpMult
+        convertOpCode 3 = OpRead
+        convertOpCode 4 = OpWrite
+        convertOpCode 5 = OpJumpEq
+        convertOpCode 6 = OpJumpNeq
+        convertOpCode 7 = OpLT
+        convertOpCode 8 = OpEq
+        convertOpCode 9 = OpOffset
+        convertOpCode 99 = OpExit
 
 getInstruction :: State -> Instr
 getInstruction s = Instr opcode param1 param2 param3
@@ -58,7 +70,7 @@ getValue s (Relative, n) = findWithDefault 0 (n + _relIndex s) (_memory s)
 
 compute :: State -> Instr -> State
 -- OPCODE 1 - ADDITION
-compute s (Instr 1 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
+compute s (Instr OpAdd p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
   where newIndex = (_index s) + 4
         newMemory = insert resultIndex result (_memory s)
         resultIndex = getValueSafe s p3
@@ -67,7 +79,7 @@ compute s (Instr 1 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
         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 }
+compute s (Instr OpMult p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
   where newIndex = (_index s) + 4
         newMemory = insert resultIndex result (_memory s)
         resultIndex = getValueSafe s p3
@@ -76,7 +88,7 @@ compute s (Instr 2 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
         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 }
+compute s (Instr OpRead p1 _ _) = dbg s { _index = newIndex, _memory = newMemory, _input = newInput }
   where newIndex = (_index s) + 2
         newMemory = insert resultIndex value (_memory s)
         resultIndex = getValueSafe s p1
@@ -84,25 +96,25 @@ compute s (Instr 3 p1 _ _) = dbg s { _index = newIndex, _memory = newMemory, _in
         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 }
+compute s (Instr OpWrite 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 }
+compute s (Instr OpJumpEq 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 }
+compute s (Instr OpJumpNeq 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 }
+compute s (Instr OpLT p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
   where newIndex = (_index s) + 4
         value1 = getValue s p1
         value2 = getValue s p2
@@ -111,7 +123,7 @@ compute s (Instr 7 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
         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 }
+compute s (Instr OpEq p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
   where newIndex = (_index s) + 4
         value1 = getValue s p1
         value2 = getValue s p2
@@ -120,18 +132,18 @@ compute s (Instr 8 p1 p2 p3) = dbg s { _index = newIndex, _memory = newMemory }
         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 }
+compute s (Instr OpOffset 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 }
+compute s (Instr OpExit _ _ _) = dbg s { _running = False }
   where dbg x = trace ("EXIT") x
 
 -- ELSE: NOT HANDLED
-compute s (Instr n _ _ _) = trace ("Unhandled opcode " ++ show n) s { _running = False }
+-- compute s (Instr n _ _ _) = trace ("Unhandled opcode " ++ show n) s { _running = False }
 
 runProgram :: State -> State
 runProgram s
@@ -141,16 +153,33 @@ runProgram s
 parseProgram :: String -> [Int]
 parseProgram input = Prelude.map read (splitOn "," input)
 
+makeMemory :: [Int] -> Map Int Int
+makeMemory mem = fromList $ zip (iterate (+1) 0) mem
+
 -- Memory -> updated memory
 runProgramV1 :: [Int] -> [Int]
 runProgramV1 mem = Prelude.map snd . toList $ _memory endState
-  where initialState = State 0 0 [] [] memory True
+  where initialState = State 0 0 [] [] (makeMemory mem) 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
+  where initialState = State 0 0 input [] (makeMemory mem) True
         endState = runProgram initialState
-        memory = fromList $ zip (iterate (+1) 0) mem
+
+-- Memory ->  Inputs (phases) -> Last output
+runProgramV3 :: [Int] -> [Int] -> Int
+runProgramV3 mem phases = chainProcesses instances [0]
+  where instances = Prelude.map (\p -> State 0 0 [p] [] (makeMemory mem) True) phases
+
+-- States -> Added input -> Last Output
+chainProcesses :: [State] -> [Int] -> Int
+chainProcesses (amp:nextAmps) input
+  | _running(amp) == False = out
+  | instrOp == OpWrite = chainProcesses (nextAmps ++ [curAmp]) [(head $ _output curAmp)]
+  | otherwise = chainProcesses (curAmp:nextAmps) []
+  where curAmp = compute amp {_input = (_input amp) ++ input } instr
+        instr = getInstruction amp
+        instrOp = _opcode(instr)
+        out = head (_output amp)