From 345d628347db6c63410f8d7aaa408b15f67c7d0a Mon Sep 17 00:00:00 2001 From: shu Date: Wed, 11 Dec 2019 20:21:55 +0100 Subject: [PATCH] Day 9: Refactor We enterprise now --- 2019/day9/Intcode.hs | 147 +++++++++++++++++++++++++++++++++++++++++++ 2019/day9/day9.hs | 107 +++++++++---------------------- 2 files changed, 176 insertions(+), 78 deletions(-) create mode 100644 2019/day9/Intcode.hs diff --git a/2019/day9/Intcode.hs b/2019/day9/Intcode.hs new file mode 100644 index 0000000..fcbd2c5 --- /dev/null +++ b/2019/day9/Intcode.hs @@ -0,0 +1,147 @@ +module Intcode + ( TuringMachine(TM, tape, pointer, pointerOffset, output, input, + state) + , step + , tapePreprocess + , TMAction(Continue, Output, Halt) + ) where + +import Control.DeepSeq as DeepSeq +import Control.Exception +import Data.Char +import Data.List as L +import Data.Vector as V hiding + ( (++) + , concatMap + , elem + , head + , last + , length + , map + , reverse + , splitAt + ) +import qualified Data.Vector as V ((++), last) + +data TMAction + = Continue + | Output + | 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 :: [Integer] + , state :: TMAction + } + deriving (Show) + +data IntcodeExcept = + UnknownOpCodeException + deriving (Show) + +instance Exception IntcodeExcept + +tapePreprocess :: Vector Integer -> Vector Integer +tapePreprocess t = (V.++) t $ V.replicate 105 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" -> (getNewTM $ head $ input tm) {input = L.tail $ input tm} + "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} + _ -> throw UnknownOpCodeException + 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)])} + target = + fromInteger $ + case m !! (length params - 1) of + Relative -> V.last opvec + pointerOffset tm + _ -> V.last opvec diff --git a/2019/day9/day9.hs b/2019/day9/day9.hs index 8a76648..7e76175 100644 --- a/2019/day9/day9.hs +++ b/2019/day9/day9.hs @@ -1,82 +1,33 @@ +module Main where + +import Intcode import Data.List.Split -import Data.List as L -import Data.Vector as V hiding ((++), concatMap, map, elem, last, head, length, splitAt, reverse) -import qualified Data.Vector as V ((++), last) -import Data.Char -import Control.DeepSeq as DeepSeq - -data OutAction = Continue | Output | Halt deriving (Enum, Eq, Show) -data Mode = Position | Immediate | Relative deriving (Enum, Eq, Show) -type Tape = Vector Integer -type TapeSection = Vector Integer -type TuringMachine = (Tape,Integer,Integer) +import qualified Data.Vector as V +main :: IO () main = do - content <- readFile "input" - let tape = fromList $ concatMap (map read . splitOn ",") (lines content) - let run x = execSteps ((tapePreprocess tape,0,0),[x],[],Continue) - let (_,_,out1,_) = run 1 - let (_,_,out2,_) = run 2 - print $ L.concat ["Part 1: " ++ show a ++ ", Part 2: " ++ show b | a<-out1,b<-out2] + 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 = [x] + , state = Continue + }) + let out1 = output $ run 1 + let out2 = output $ run 2 + print $ + concat + ["Part 1: " ++ show a ++ ", Part 2: " ++ show b | a <- out1, b <- out2] -tapePreprocess :: TapeSection -> TapeSection -tapePreprocess t = (V.++) t $ V.replicate 105 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 -> TapeSection -> Tape -> TapeSection -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 :: TapeSection -> (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 :: TapeSection -> (TuringMachine, [Integer], [Integer]) -> (TuringMachine, OutAction, [Integer], [Integer]) -step opvec ((t,p,rbase),input,output) = case op of - "1" -> (tm_binop (+),Continue,input,output) - "2" -> (tm_binop (*),Continue,input,output) - "3" -> (new_tm t $ head input,Continue,L.tail input,output) - "4" -> ((t,p,rbase),Output,input,V.last params:output) - "5" -> ((t, if params ! 0/=0 then params ! 1 else p,rbase),Continue,input,output) - "6" -> ((t, if params ! 0==0 then params ! 1 else p,rbase),Continue,input,output) - "7" -> (tm_binop (\x y->if x (tm_binop (\x y->if x==y then 1 else 0),Continue,input,output) - "9" -> ((t,p,rbase + (params ! 0)),Continue,input,output) - "99" -> ((t,p,rbase),Halt,input,output) - where (op,m) = getOpModes opvec - params = paramChange m rbase opvec t - tm_binop x = new_tm t ((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-} - new_tm t x = DeepSeq.force (t // [(target, x)],p,rbase) - target = fromInteger $ case m !! (length params -1) of - Relative -> V.last opvec + rbase - _ -> V.last opvec - -execSteps :: (TuringMachine, [Integer], [Integer], OutAction) -> (TuringMachine, [Integer], [Integer], OutAction) -execSteps ((t,p,rbase),input,output,halt) = - let command_length = opLength $! t ! fromInteger p - opvec = slice (fromInteger p) (fromInteger command_length) t - ((t_new,p_new,rbase_new),cond,input_new,output_new) = - step opvec ((t,p+command_length,rbase),input,output) in - case cond of - Halt -> ((t_new,p_new,rbase_new),input_new,output_new,cond) - _ -> execSteps ((t_new,p_new,rbase_new),input_new,output_new,cond) +runIntcode :: TuringMachine -> TuringMachine +runIntcode tm = + case state tmNew of + Continue -> runIntcode tmNew + _ -> tmNew + where + tmNew = step tm