Updated Intcode computer + update day2, 5, 7 and WIP on day 9
This commit is contained in:
Xavier Morel
+7
-1
@@ -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
|
||||
|
||||
+2
-2
@@ -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))
|
||||
|
||||
+1
-1
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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 ()
|
||||
|
||||
+138
-83
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user