[2019] Day 13

2019/problem13/Makefile

@@ -0,0 +1,7 @@
+all: solve
+
+solve: solve.hs
+	ghc -o solve solve.hs
+
+clean:
+	rm -f solve *.o *.hi

2019/problem13/README.md

@@ -0,0 +1,37 @@
+# Day 13: Care Package
+
+## Part One
+
+As you ponder the solitude of space and the ever-increasing three-hour roundtrip for messages between you and Earth, you notice that the Space Mail Indicator Light is blinking. To help keep you sane, the Elves have sent you a care package.
+
+It's a new game for the ship's arcade cabinet! Unfortunately, the arcade is all the way on the other end of the ship. Surely, it won't be hard to build your own - the care package even comes with schematics.
+
+The arcade cabinet runs Intcode software like the game the Elves sent (your puzzle input). It has a primitive screen capable of drawing square tiles on a grid. The software draws tiles to the screen with output instructions: every three output instructions specify the x position (distance from the left), y position (distance from the top), and tile id. The tile id is interpreted as follows:
+
+```
+0 is an empty tile. No game object appears in this tile.
+1 is a wall tile. Walls are indestructible barriers.
+2 is a block tile. Blocks can be broken by the ball.
+3 is a horizontal paddle tile. The paddle is indestructible.
+4 is a ball tile. The ball moves diagonally and bounces off objects.
+```
+
+For example, a sequence of output values like 1,2,3,6,5,4 would draw a horizontal paddle tile (1 tile from the left and 2 tiles from the top) and a ball tile (6 tiles from the left and 5 tiles from the top).
+
+Start the game. How many block tiles are on the screen when the game exits?
+
+## Part Two
+
+The game didn't run because you didn't put in any quarters. Unfortunately, you did not bring any quarters. Memory address 0 represents the number of quarters that have been inserted; set it to 2 to play for free.
+
+The arcade cabinet has a joystick that can move left and right. The software reads the position of the joystick with input instructions:
+
+```
+If the joystick is in the neutral position, provide 0.
+If the joystick is tilted to the left, provide -1.
+If the joystick is tilted to the right, provide 1.
+```
+
+The arcade cabinet also has a segment display capable of showing a single number that represents the player's current score. When three output instructions specify X=-1, Y=0, the third output instruction is not a tile; the value instead specifies the new score to show in the segment display. For example, a sequence of output values like -1,0,12345 would show 12345 as the player's current score.
+
+Beat the game by breaking all the blocks. What is your score after the last block is broken?

2019/problem13/input.txt

@@ -0,0 +1 @@
+1,380,379,385,1008,2367,810138,381,1005,381,12,99,109,2368,1101,0,0,383,1102,0,1,382,21001,382,0,1,20101,0,383,2,21102,37,1,0,1106,0,578,4,382,4,383,204,1,1001,382,1,382,1007,382,36,381,1005,381,22,1001,383,1,383,1007,383,24,381,1005,381,18,1006,385,69,99,104,-1,104,0,4,386,3,384,1007,384,0,381,1005,381,94,107,0,384,381,1005,381,108,1105,1,161,107,1,392,381,1006,381,161,1102,1,-1,384,1106,0,119,1007,392,34,381,1006,381,161,1101,0,1,384,20101,0,392,1,21101,22,0,2,21101,0,0,3,21101,0,138,0,1105,1,549,1,392,384,392,21001,392,0,1,21102,22,1,2,21101,3,0,3,21101,161,0,0,1106,0,549,1101,0,0,384,20001,388,390,1,21001,389,0,2,21102,1,180,0,1106,0,578,1206,1,213,1208,1,2,381,1006,381,205,20001,388,390,1,20101,0,389,2,21101,0,205,0,1106,0,393,1002,390,-1,390,1101,0,1,384,21002,388,1,1,20001,389,391,2,21102,228,1,0,1106,0,578,1206,1,261,1208,1,2,381,1006,381,253,21002,388,1,1,20001,389,391,2,21101,0,253,0,1105,1,393,1002,391,-1,391,1102,1,1,384,1005,384,161,20001,388,390,1,20001,389,391,2,21102,279,1,0,1105,1,578,1206,1,316,1208,1,2,381,1006,381,304,20001,388,390,1,20001,389,391,2,21101,0,304,0,1106,0,393,1002,390,-1,390,1002,391,-1,391,1101,1,0,384,1005,384,161,21002,388,1,1,20102,1,389,2,21102,1,0,3,21102,1,338,0,1105,1,549,1,388,390,388,1,389,391,389,21001,388,0,1,21002,389,1,2,21101,4,0,3,21101,365,0,0,1105,1,549,1007,389,23,381,1005,381,75,104,-1,104,0,104,0,99,0,1,0,0,0,0,0,0,213,16,19,1,1,18,109,3,21202,-2,1,1,22102,1,-1,2,21101,0,0,3,21102,1,414,0,1105,1,549,21201,-2,0,1,21201,-1,0,2,21101,429,0,0,1106,0,601,2101,0,1,435,1,386,0,386,104,-1,104,0,4,386,1001,387,-1,387,1005,387,451,99,109,-3,2106,0,0,109,8,22202,-7,-6,-3,22201,-3,-5,-3,21202,-4,64,-2,2207,-3,-2,381,1005,381,492,21202,-2,-1,-1,22201,-3,-1,-3,2207,-3,-2,381,1006,381,481,21202,-4,8,-2,2207,-3,-2,381,1005,381,518,21202,-2,-1,-1,22201,-3,-1,-3,2207,-3,-2,381,1006,381,507,2207,-3,-4,381,1005,381,540,21202,-4,-1,-1,22201,-3,-1,-3,2207,-3,-4,381,1006,381,529,21201,-3,0,-7,109,-8,2106,0,0,109,4,1202,-2,36,566,201,-3,566,566,101,639,566,566,1202,-1,1,0,204,-3,204,-2,204,-1,109,-4,2105,1,0,109,3,1202,-1,36,594,201,-2,594,594,101,639,594,594,20102,1,0,-2,109,-3,2105,1,0,109,3,22102,24,-2,1,22201,1,-1,1,21102,1,439,2,21102,1,233,3,21102,1,864,4,21101,0,630,0,1106,0,456,21201,1,1503,-2,109,-3,2105,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,2,0,0,2,2,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,2,2,0,2,0,2,0,0,0,0,0,0,0,1,1,0,0,2,2,0,0,0,2,2,2,0,0,0,2,0,2,2,0,0,0,0,2,2,2,0,0,0,2,2,0,0,0,2,0,1,1,0,0,0,2,2,2,2,2,0,0,2,0,2,0,2,0,2,0,2,0,0,0,0,2,2,0,0,2,0,2,2,2,2,0,1,1,0,0,2,0,2,0,0,2,0,2,0,0,0,2,2,2,0,0,2,0,2,2,0,2,2,2,0,0,0,0,0,2,2,0,1,1,0,2,0,2,0,2,2,2,2,0,0,2,2,0,0,2,0,2,2,0,2,2,2,0,0,0,0,0,0,0,0,0,2,0,1,1,0,0,2,0,0,0,2,2,2,0,0,0,0,0,2,0,2,0,0,0,2,0,2,2,2,0,0,2,0,2,0,0,0,0,1,1,0,2,0,0,0,2,0,2,2,0,0,0,0,2,2,0,2,0,0,2,2,0,0,0,0,0,2,0,2,2,0,0,0,0,1,1,0,2,2,2,0,2,0,0,2,0,2,0,0,0,2,2,0,2,0,0,0,0,2,0,0,2,0,2,0,2,0,0,2,0,1,1,0,0,0,0,0,0,2,2,0,0,2,2,0,2,2,0,2,0,0,0,2,2,0,0,0,0,0,2,0,0,2,2,2,0,1,1,0,2,2,0,2,0,2,2,0,2,2,2,0,2,0,0,2,2,0,0,2,2,0,2,0,0,0,0,0,2,0,0,0,0,1,1,0,0,2,0,0,2,2,0,2,2,0,2,2,0,2,2,0,0,2,0,0,0,0,0,2,2,0,0,0,2,2,0,0,0,1,1,0,0,2,2,0,2,0,2,2,0,2,2,0,0,2,2,2,0,0,0,0,0,0,0,2,0,0,2,0,0,0,2,0,0,1,1,0,2,2,2,0,0,2,0,0,0,2,0,0,2,0,2,0,0,2,2,0,0,0,2,0,2,2,2,0,0,0,0,2,0,1,1,0,0,0,2,2,0,2,0,0,2,0,0,0,2,2,2,0,0,0,2,2,0,0,2,0,0,0,0,2,0,0,0,0,0,1,1,0,0,2,2,2,0,0,2,0,0,0,0,0,2,0,2,2,2,2,0,0,0,2,0,0,2,0,2,0,2,0,2,2,0,1,1,0,0,0,2,0,0,0,0,0,0,0,2,0,0,2,2,0,2,2,0,0,2,0,2,2,0,2,0,0,0,0,2,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,6,16,92,72,80,96,26,54,61,9,5,36,81,14,76,83,59,88,74,16,69,57,76,35,51,42,88,8,89,80,10,96,1,1,18,93,46,94,5,40,63,18,90,31,7,8,46,96,13,53,21,13,66,64,67,26,11,77,23,46,8,20,97,24,26,9,11,65,36,71,13,35,18,81,66,40,88,89,56,9,24,8,78,16,44,20,57,1,69,13,71,77,37,68,31,18,32,60,37,70,8,3,46,41,18,50,78,87,4,94,91,82,96,76,15,73,47,85,6,8,92,7,46,72,68,90,22,78,6,66,1,26,98,85,80,66,95,39,62,81,52,35,98,71,58,8,55,16,93,75,77,47,36,41,91,39,20,97,13,5,31,67,91,96,10,75,7,95,59,43,90,94,25,89,21,66,98,11,2,49,67,25,96,91,72,51,41,47,1,76,30,55,20,5,97,61,73,43,79,13,16,81,1,27,11,96,47,89,48,26,25,34,37,64,13,53,69,41,30,39,93,80,34,75,41,30,42,42,49,68,49,37,40,62,93,77,86,49,72,52,5,78,31,86,86,62,60,56,17,19,80,2,39,49,50,85,63,48,61,95,82,21,18,85,16,86,45,75,28,97,33,21,56,96,40,33,95,69,53,75,47,70,51,80,92,4,54,79,59,42,15,30,86,27,86,63,64,36,27,98,49,58,78,5,16,57,61,32,14,25,51,75,96,93,25,87,20,76,32,96,96,39,84,48,62,82,11,36,1,11,44,71,86,58,4,74,35,3,31,3,27,52,78,96,10,43,16,93,93,61,23,54,90,47,81,70,81,26,89,17,63,60,48,29,77,53,80,80,12,79,80,76,37,80,79,54,17,73,68,15,40,64,81,5,62,74,27,42,72,93,2,21,46,29,76,51,61,13,19,21,96,45,38,47,87,47,67,95,82,56,51,32,1,73,59,83,65,33,92,8,94,14,45,60,20,87,82,1,29,9,15,10,76,90,27,80,30,65,9,79,2,97,41,75,8,68,23,37,19,80,22,15,52,93,79,79,23,61,37,5,88,28,5,44,31,36,20,37,71,45,21,25,16,2,79,28,67,19,47,9,19,64,46,8,88,29,75,65,22,64,32,78,20,88,48,72,90,84,50,59,63,20,86,58,50,97,14,61,10,68,45,81,43,27,95,95,80,91,68,17,83,55,49,41,9,33,51,19,60,54,24,43,68,36,60,5,20,97,14,55,70,35,27,96,80,32,3,63,52,70,31,2,58,3,70,54,35,83,87,83,50,14,97,47,38,44,71,52,3,97,83,24,36,11,45,5,87,21,80,88,98,45,42,37,96,28,42,72,47,39,58,78,23,24,50,78,1,87,81,32,49,21,60,28,33,29,5,38,36,8,59,52,66,67,15,95,87,61,67,80,54,58,36,89,72,96,78,32,58,37,39,76,43,69,20,96,26,71,98,50,36,46,18,68,24,50,43,32,95,70,18,18,66,84,18,13,44,44,6,4,42,37,31,88,18,82,29,41,88,12,96,58,61,72,72,79,80,60,48,15,26,24,29,45,7,36,2,16,31,13,60,13,84,53,4,5,94,52,39,8,14,6,30,70,75,46,13,38,57,24,24,69,51,87,96,65,57,57,14,10,27,97,98,18,4,92,47,6,17,66,93,3,82,83,56,75,82,75,92,35,68,1,43,51,24,13,57,33,87,62,92,38,61,90,1,95,45,4,70,63,34,43,67,5,91,75,23,55,27,70,52,16,78,87,46,2,56,89,88,58,23,95,31,98,96,22,11,61,29,55,77,50,55,96,64,33,14,51,25,47,48,3,15,2,18,63,12,56,47,88,74,32,87,21,74,53,37,93,21,37,9,42,16,39,57,57,59,57,96,88,17,14,5,85,18,40,54,47,80,22,35,84,10,43,91,10,82,85,52,70,69,64,44,93,77,72,80,39,86,20,44,48,24,72,810138

2019/problem13/solve.hs

@@ -0,0 +1,179 @@
+{-# Language RecordWildCards #-}
+
+import Data.Maybe
+import Data.List
+import qualified Data.Map as Map
+import Data.List.Split
+import Data.Vector (Vector, (!), (//), toList, fromList)
+import System.Environment
+
+type Memory = Map.Map Integer Integer
+
+data MemoryMessVm = MemoryMessVm {
+    pc :: Integer,
+    rb :: Integer,
+    mem :: Memory,
+    halt :: Bool
+}
+
+data Param = Ref Integer | Val Integer | RbRef Integer deriving (Show, Eq)
+
+data Instruction =
+  Add Param Param Param
+  | Mul Param Param Param
+  | Input Param
+  | Output Param
+  | JmpZero Param Param
+  | JmpNz Param Param
+  | CmpLe Param Param Param
+  | CmpEq Param Param Param
+  | SetRb Param
+  | Halt
+  deriving (Show, Eq)
+
+data StepSideEffect =
+    StepHalt MemoryMessVm
+    | StepInput (Integer -> MemoryMessVm)
+    | StepOutput Integer MemoryMessVm
+
+fetch :: Memory -> Integer -> Integer
+fetch mem index = Map.findWithDefault 0 index mem
+
+save :: Memory -> Integer -> Integer -> Memory
+save mem index value = Map.insert index value mem
+
+evalParam :: MemoryMessVm -> Param -> Integer
+evalParam vm@MemoryMessVm{..} (Ref x) = fetch mem x
+evalParam vm@MemoryMessVm{..} (RbRef x) = fetch mem (rb + x)
+evalParam vm@MemoryMessVm{..} (Val x) = x
+
+updateMem :: MemoryMessVm -> Param -> Integer -> Memory
+updateMem vm@MemoryMessVm{..} (Ref x) value = save mem x value
+updateMem vm@MemoryMessVm{..} (RbRef x) value = save mem (rb + x) value
+updateMem vm@MemoryMessVm{..} (Val _) _ = error "unavaiable"
+
+currentValue :: MemoryMessVm -> Integer -> Integer
+currentValue vm@MemoryMessVm{..} i = fetch mem (pc + i)
+
+param :: Integer -> Integer -> Param
+param 0 x = Ref x
+param 1 x = Val x
+param 2 x = RbRef x
+
+currentInstruction :: MemoryMessVm -> Instruction
+currentInstruction vm = case opCode of
+  1 -> Add (param' 1) (param' 2) (param' 3)
+  2 -> Mul (param' 1) (param' 2) (param' 3)
+  3 -> Input (param' 1)
+  4 -> Output (param' 1)
+  5 -> JmpNz (param' 1) (param' 2)
+  6 -> JmpZero (param' 1) (param' 2)
+  7 -> CmpLe (param' 1) (param' 2) (param' 3)
+  8 -> CmpEq (param' 1) (param' 2) (param' 3)
+  9 -> SetRb (param' 1)
+  99 -> Halt
+  x -> error ("Unknown op " ++ show x)
+  where opCode = val 0 `mod` 100
+        getMode i x = x `div` (10^i) `mod` 10
+        val = currentValue vm
+        param' i = param (getMode (i+1) (val 0)) (val i)
+
+evalOp :: MemoryMessVm -> Instruction -> MemoryMessVm
+evalOp vm@MemoryMessVm{..} inst  = case inst of
+    Add a b out  -> vm{ pc = pc + 4, mem = updateMem vm out (op a + op b) }
+    Mul a b out  -> vm{ pc = pc + 4, mem = updateMem vm out (op a * op b) }
+    JmpNz a b -> evalJmp (/=0) a b
+    JmpZero a b -> evalJmp (==0) a b
+    CmpLe a b out -> evalCmp (<) a b out
+    CmpEq a b out -> evalCmp (==) a b out
+    SetRb out -> vm { pc = pc + 2, rb = rb + (op out) }
+  where
+    op = evalParam vm
+    evalJmp f a b
+      | f . op $ a = vm { pc = op b }
+      | otherwise = vm { pc = pc + 3 }
+    evalCmp f a b out =
+      let val = if f (op a) (op b) then 1 else 0
+      in vm { pc = pc + 4, mem = updateMem vm out val }
+
+
+execute :: MemoryMessVm -> StepSideEffect
+execute vm@MemoryMessVm{..} = case current of
+    Halt -> StepHalt vm { halt = True }
+    Input out -> StepInput (\stdin -> vm { pc = pc + 2, mem = updateMem vm out stdin })
+    Output o -> StepOutput (evalParam vm o) (vm { pc = pc + 2 })
+    _ -> execute . evalOp vm $ current
+  where current = currentInstruction vm
+
+parseNumberList :: String -> [Integer]
+parseNumberList = map toInteger . splitOn ","
+  where toInteger = read::String->Integer
+
+loadProgram :: [Integer] -> MemoryMessVm
+loadProgram program = MemoryMessVm {
+    pc = 0, rb = 0, mem = mem, halt = False }
+  where mem = Map.fromList . zip [0..] $ program
+
+data SideEffect =
+  EffectInput (Integer -> SideEffect)
+  | EffectOutput Integer SideEffect
+  | EffectHalt
+
+exec :: MemoryMessVm -> SideEffect
+exec vm = case execute vm of
+    StepHalt _ -> EffectHalt
+    StepInput f -> EffectInput (exec . f)
+    StepOutput o vm' -> EffectOutput o (exec vm')
+
+data Tile = Empty | Wall | Block | Paddle | Ball deriving (Show, Eq)
+
+tile :: Integer -> Tile
+tile 0 = Empty
+tile 1 = Wall
+tile 2 = Block
+tile 3 = Paddle
+tile 4 = Ball
+
+loadTiles :: MemoryMessVm -> [((Integer, Integer), Tile)]
+loadTiles vm = loadTiles' (exec vm)
+  where loadTiles' EffectHalt = []
+        loadTiles' (EffectOutput x (EffectOutput y (EffectOutput id e))) = ((x, y), tile id):(loadTiles' e)
+
+data GameState = GameState {
+    score :: Integer,
+    ballX :: Maybe Integer,
+    paddleX :: Maybe Integer
+};
+
+play :: MemoryMessVm -> Integer
+play vm = play' newGame (exec vm)
+  where newGame = GameState { score = 0, ballX = Nothing, paddleX = Nothing }
+        play' game@GameState{..} effect = case effect of
+            EffectHalt -> score
+            (EffectOutput (-1) (EffectOutput 0 (EffectOutput score' e))) -> play' game{ score = score' } e
+            (EffectOutput x (EffectOutput _ (EffectOutput id e))) -> case tile id of
+                Ball -> play' game{ ballX = Just x } e
+                Paddle -> play' game{ paddleX = Just x} e
+                _ -> play' game e
+            (EffectInput f)
+                | ballX > paddleX -> play' game (f 1)
+                | ballX < paddleX -> play' game (f (-1))
+                | otherwise -> play' game (f 0)
+
+solve :: String -> Int
+solve input = length . filter (==Block) . map snd . loadTiles $ vm
+  where startup = parseNumberList $ input
+        vm = loadProgram startup
+
+solve2 :: String -> Integer
+solve2 input = play vm{mem = initMem}
+  where startup = parseNumberList $ input
+        vm = loadProgram startup
+        initMem = save (mem vm) 0 2
+
+main :: IO ()
+main = do
+  [f] <- getArgs
+  content <- readFile f
+  putStrLn . show . solve $ content
+  putStrLn . show . solve2 $ content