1
\$\begingroup\$

Problem

The problem definition is here. For a quick summary:

  • an IntCode program is an array of ints
  • the program counter starts from index 0, where it reads an opcode, followed by 0 or more arguments at the next indices, then proceeds to the index after the last argument
  • opcode 1 takes 3 arguments, a, b, and z, and sets program[z] = program[a] + program[b]
  • opcode 2 does the same but multiplies instead
  • opcode 99 takes 0 arguments and halts the program

In part 1, we take the input, replace index 1 with 12 and index 2 with 2 (restore 12 2), run the program and return index 0.

In part 2 (not shown in the link unless you solve part 1), we find which ints to replace index 1 and 2 with to produce a result where index 0 equals 19690720.


My thoughts on this code are that it could probably be simpler. I tried to separate the program counter logic from the instruction execution logic (interpret vs step), but it seems like that resulted in the need for a strange combinator whileWith. I was wondering whether there are better combinators to express this kind of loop, or if there's another approach entirely.

I considered wrapping step in ContT or ExceptT, which would allow some of the nesting to be flattened by using early exit instead, but I wasn't sure which way is best in terms of extensibility.

Any suggestions on this code are welcome, including style, structure, algorithm, etc!

Code

import Control.Arrow (second)
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List (find)

data Status = InvalidOp | Terminated | Running | InvalidAddress
  deriving (Show, Eq)

newtype Program = Program {
  getInts :: Array Int Int
} deriving (Show)

-- Execute the instruction starting at `start`
step :: STArray s Int Int -> Int -> Int -> ST s Status
step arr len start = do
  op <- readArray arr start
  case op of
    99 -> return Terminated
    _ -> do
      [i, j, store] <- forM [start+1..start+3] (readArray arr)
      if not $ all inBounds [i, j, store] then
        return InvalidAddress
      else do
        [a, b] <- forM [i, j] (readArray arr)
        case op of
          1 -> writeArray arr store (a+b) >> return Running
          2 -> writeArray arr store (a*b) >> return Running
          _ -> return InvalidOp

  where inBounds ix = 0 <= ix && ix < len

interpret :: Program -> Program
interpret (Program prog) = Program $ runSTArray $ do
  let len = succ . uncurry subtract $ bounds prog
  mArr <- thaw prog
  whileWith (== Running) [0, 4..len-1]
    (step mArr len)
  return mArr

readProgram :: String -> Program
readProgram str =
  let nums = fmap read $ split ',' str
  in
  Program $ listArray (0, length nums - 1) nums

restore :: Int -> Int -> Program -> Program
restore a b = Program . (// [(1, a), (2, b)]) . getInts

-- pt 2

findNounVerb :: Program -> Int -> Maybe (Int, Int)
findNounVerb prog target =
  find ((== target) . (! 0) . getInts . interpret . ($ prog) . uncurry restore) $
      [(n, v) | n <- [0..1000], v <- [0..n]]

-- util --

split :: Eq a => a -> [a] -> [[a]]
split _ [] = []
split k xs = curr : split k rest
  where (curr, rest) = second (drop 1) $ span (/= k) xs

whileWith :: (Monad m) => (ret -> Bool) -> [inp] -> (inp -> m ret) -> m ()
whileWith _ [] _ = return ()
whileWith pred (x:xs) step = do
  res <- step x
  when (pred res) $
    whileWith pred xs step

-- end util --

main :: IO ()
main = do
  prog <- readProgram <$> getContents

  -- pt 1:
  putStrLn "Part 1:"
  let output = (! 0) . getInts . interpret . restore 12 2 $ prog
  putStrLn $ "Output: " ++ show output
  putStrLn ""

  -- pt 2:
  putStrLn "Part 2:"
  let Just (noun, verb) = findNounVerb prog 19690720
  putStrLn $ "Noun: " ++ show noun ++ "\n" ++ "Verb: " ++ show verb
  print $ 100*noun + verb
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.