From bd832427bc40335470dbba0a08dad20843638168 Mon Sep 17 00:00:00 2001 From: shu Date: Thu, 12 Dec 2019 20:45:35 +0100 Subject: [PATCH] Day 11 Part 1 --- 2019/day11/Intcode.hs | 152 ++++++++++++++++++++++++++++++++++++++++++ 2019/day11/day11.hs | 54 +++++++++++++++ 2019/day11/input | 1 + 3 files changed, 207 insertions(+) create mode 100644 2019/day11/Intcode.hs create mode 100644 2019/day11/day11.hs create mode 100644 2019/day11/input diff --git a/2019/day11/Intcode.hs b/2019/day11/Intcode.hs new file mode 100644 index 0000000..7696ed2 --- /dev/null +++ b/2019/day11/Intcode.hs @@ -0,0 +1,152 @@ +module Intcode + ( TuringMachine(TM, tape, pointer, pointerOffset, output, input, + state) + , step + , tapePreprocess + , TMOutState(Continue, AwaitInput, Halt) + , execSteps + ) where + +import Control.DeepSeq as DeepSeq +import Data.Char +import Data.List as L +import Debug.Trace +import Data.Maybe +import Data.Vector as V hiding + ( (++) + , concatMap + , elem + , head + , last + , length + , map + , reverse + , splitAt + ) +import qualified Data.Vector as V ((++), last) + +data TMOutState + = Continue + | AwaitInput + | Halt + deriving (Enum, Eq, Show) + +data Mode + = Position + | Immediate + | Relative + deriving (Enum, Eq, Show) + +data TuringMachine = + TM + { tape :: Vector Integer + , pointer :: Integer + , pointerOffset :: Integer + , output :: [Integer] + , input :: Maybe Integer + , state :: TMOutState + } + deriving (Show) + +tapePreprocess :: Vector Integer -> Vector Integer +tapePreprocess t = (V.++) t $ V.replicate 500 0 + +opLength :: Integer -> Integer +opLength x + | n `elem` "1278" = 4 + | n `elem` "56" = 3 + | n `elem` "349" = 2 + | otherwise = 1 + where + n = last $ show x + +parseModes :: String -> [Mode] +parseModes m = L.replicate (3 - length l) Position ++ l + where + l = map (toEnum . digitToInt) m + +paramChange :: + [Mode] -> Integer -> Vector Integer -> Vector Integer -> Vector Integer +paramChange m rbase opvec t = imap f (V.tail opvec) + where + f i a = + case m !! i of + Immediate -> a + Position -> t ! fromInteger a + Relative -> t ! fromInteger (a + rbase) + +getOpModes :: Vector Integer -> (String, [Mode]) +getOpModes opvec = (op_dedup, parsed_modes) + where + (op, modes) = splitAt 2 $ reverse $ show $ opvec ! 0 + parsed_modes = reverse $ parseModes $ reverse modes + op_dedup = + if last op == '0' + then [head op] + else op + +step :: TuringMachine -> TuringMachine +step tm = + case op of + "1" -> tmBinop (+) + "2" -> tmBinop (*) + "3" -> if isJust (input tm) then (getNewTM (fromJust $ input tm)){input = Nothing} else tm {state = AwaitInput} + "4" -> tmn {output = V.last params : output tm} + "5" -> + tm + { pointer = + if params ! 0 /= 0 + then params ! 1 + else pNew + } + "6" -> + tm + { pointer = + if params ! 0 == 0 + then params ! 1 + else pNew + } + "7" -> + tmBinop + (\x y -> + if x < y + then 1 + else 0) + "8" -> + tmBinop + (\x y -> + if x == y + then 1 + else 0) + "9" -> tmn {pointerOffset = pointerOffset tm + (params ! 0)} + "99" -> tm {state = Halt} + _ -> error "Illegal Opcode." + where + pNew = pointer tm + opLength (tape tm ! fromInteger (pointer tm)) + tmn = tm {pointer = pNew} + opvec = + slice + (fromInteger (pointer tm)) + (fromInteger (pNew - pointer tm)) + (tape tm) + (op, m) = getOpModes opvec + params = paramChange m (pointerOffset tm) opvec (tape tm) + tmBinop x = getNewTM ((params ! 0) `x` (params ! 1)) + {-without the following DeepSeq call, thunks build up eternally and + the vectors won’t be garbage collected: >4GB RAM usage, god knows + how much with larger tapes (my laptop crashed), now it’s a cozy ~20mB-} + getNewTM x = + tmn {tape = DeepSeq.force (tape tm // [(target, x)]), state = Continue} + target = + fromInteger $ + case m !! (length params - 1) of + Relative -> V.last opvec + pointerOffset tm + _ -> V.last opvec + +execSteps :: TuringMachine -> TuringMachine +execSteps tm = + case state tmNew of + Continue -> execSteps tmNew + _ -> tmNew + where + tmNew = step tm diff --git a/2019/day11/day11.hs b/2019/day11/day11.hs new file mode 100644 index 0000000..535090b --- /dev/null +++ b/2019/day11/day11.hs @@ -0,0 +1,54 @@ +module Main where + +import Intcode +import Data.List.Split +import qualified Data.Map.Strict as M +import qualified Data.Vector as V +import Linear.V2 +import Debug.Trace + +data RoboState = + RoboState + { hull :: M.Map (V2 Int) Integer + , position :: V2 Int + , direction :: V2 Int + } deriving Show + +main :: IO () +main = do + content <- readFile "input" + let program = V.fromList $ concatMap (map read . splitOn ",") (lines content) + let run x = + runIntcode + (TM + { tape = tapePreprocess program + , pointer = 0 + , pointerOffset = 0 + , output = [] + , input = Just 0 + , state = Continue + }, RoboState {hull = M.empty, position = V2 0 0, direction = V2 0 1 }) + print "hue" + print $ length $ hull $ snd $ run 0 + -- concat + -- ["Part 1: " ++ show a ++ ", Part 2: " ++ show b | a <- out1, b <- out2] + +runIntcode :: (TuringMachine, RoboState) -> (TuringMachine, RoboState) +runIntcode (tm,rb) = + case state tmNew of + Continue -> runIntcode (tmNew,rb) + AwaitInput -> runIntcode $ updateState (tmNew,rb) + _ -> (tmNew,rb) + where + tmNew = execSteps tm + +updateState :: (TuringMachine, RoboState) -> (TuringMachine, RoboState) +updateState (tm, rb) = (tmNew, rbNew) + where hullNew = M.insert (position rb) (output tm !! 1) (hull rb) + dirNew = if output tm !! 0 == 0 + then perp $ direction rb + else iterate perp (direction rb) !! 3 + posNew = (position rb + dirNew) + floorNext = M.findWithDefault 0 posNew (hull rb) + rbNew = rb{hull = hullNew, position = posNew, direction = dirNew} + tmNew = tm{input = Just floorNext, output = []} diff --git a/2019/day11/input b/2019/day11/input new file mode 100644 index 0000000..7cd37cb --- /dev/null +++ b/2019/day11/input @@ -0,0 +1 @@ +3,8,1005,8,319,1106,0,11,0,0,0,104,1,104,0,3,8,1002,8,-1,10,101,1,10,10,4,10,108,0,8,10,4,10,1002,8,1,28,3,8,1002,8,-1,10,1001,10,1,10,4,10,1008,8,1,10,4,10,102,1,8,51,2,1008,18,10,3,8,1002,8,-1,10,1001,10,1,10,4,10,1008,8,1,10,4,10,101,0,8,77,1,1006,8,10,1006,0,88,3,8,1002,8,-1,10,1001,10,1,10,4,10,1008,8,1,10,4,10,1002,8,1,106,1006,0,47,2,5,0,10,3,8,102,-1,8,10,101,1,10,10,4,10,1008,8,0,10,4,10,101,0,8,135,2,105,3,10,2,1101,6,10,3,8,102,-1,8,10,101,1,10,10,4,10,1008,8,0,10,4,10,1002,8,1,165,3,8,102,-1,8,10,101,1,10,10,4,10,108,0,8,10,4,10,1002,8,1,186,1,1009,11,10,1,9,3,10,2,1003,10,10,1,107,11,10,3,8,1002,8,-1,10,101,1,10,10,4,10,1008,8,1,10,4,10,1002,8,1,225,1006,0,25,1,1009,14,10,1,1008,3,10,3,8,102,-1,8,10,101,1,10,10,4,10,108,1,8,10,4,10,1002,8,1,257,1,1006,2,10,3,8,1002,8,-1,10,1001,10,1,10,4,10,1008,8,0,10,4,10,101,0,8,284,2,1004,7,10,1006,0,41,2,1106,17,10,1,104,3,10,101,1,9,9,1007,9,919,10,1005,10,15,99,109,641,104,0,104,1,21101,0,937108545948,1,21102,1,336,0,1105,1,440,21102,1,386577203612,1,21102,347,1,0,1105,1,440,3,10,104,0,104,1,3,10,104,0,104,0,3,10,104,0,104,1,3,10,104,0,104,1,3,10,104,0,104,0,3,10,104,0,104,1,21102,1,21478178819,1,21102,1,394,0,1106,0,440,21102,21477985447,1,1,21101,405,0,0,1105,1,440,3,10,104,0,104,0,3,10,104,0,104,0,21101,984458351460,0,1,21101,428,0,0,1106,0,440,21101,709048034148,0,1,21102,439,1,0,1106,0,440,99,109,2,21201,-1,0,1,21101,0,40,2,21101,471,0,3,21102,461,1,0,1105,1,504,109,-2,2106,0,0,0,1,0,0,1,109,2,3,10,204,-1,1001,466,467,482,4,0,1001,466,1,466,108,4,466,10,1006,10,498,1101,0,0,466,109,-2,2105,1,0,0,109,4,2101,0,-1,503,1207,-3,0,10,1006,10,521,21101,0,0,-3,22102,1,-3,1,21201,-2,0,2,21102,1,1,3,21102,540,1,0,1106,0,545,109,-4,2105,1,0,109,5,1207,-3,1,10,1006,10,568,2207,-4,-2,10,1006,10,568,22101,0,-4,-4,1105,1,636,21201,-4,0,1,21201,-3,-1,2,21202,-2,2,3,21102,587,1,0,1106,0,545,21202,1,1,-4,21102,1,1,-1,2207,-4,-2,10,1006,10,606,21101,0,0,-1,22202,-2,-1,-2,2107,0,-3,10,1006,10,628,22101,0,-1,1,21101,628,0,0,105,1,503,21202,-2,-1,-2,22201,-4,-2,-4,109,-5,2105,1,0