From 022008fdd1e316e61eb607118592b72249731934 Mon Sep 17 00:00:00 2001 From: Jonathan Chan Date: Mon, 18 Dec 2017 13:38:37 -0800 Subject: [PATCH] Day 18 --- 18.hs => 18a.hs | 25 ++++++----- 18b.hs | 113 ++++++++++++++++++++++++++++++++++++++++++++++++ README.md | 1 + 3 files changed, 128 insertions(+), 11 deletions(-) rename 18.hs => 18a.hs (68%) create mode 100644 18b.hs diff --git a/18.hs b/18a.hs similarity index 68% rename from 18.hs rename to 18a.hs index 5efb27c..61d8601 100644 --- a/18.hs +++ b/18a.hs @@ -1,3 +1,4 @@ +import Text.Read (readMaybe) import Data.Sequence (Seq, fromList, index) import Data.Vector.Unboxed (Vector, (!), (//)) import qualified Data.Vector.Unboxed as V (replicate) @@ -22,7 +23,9 @@ getValue value registers = case value of parseValue :: String -> Value parseValue str = - Register $ head str -- TODO: implement correctly! + case readMaybe str of + Just i -> Number i + Nothing -> Register $ head str son :: Value -> State -> State son freq (reg, pos, _, rec) = @@ -34,9 +37,9 @@ rcv v (reg, pos, freq, rec) = app :: (Int -> Int -> Int) -> Value -> Value -> State -> State app f i v (reg, pos, freq, rec) = - let index = getIndex i - value = getValue v reg - in (reg // [(index, reg ! index `f` value)], pos + 1, freq, rec) + let ind = getIndex i + val = getValue v reg + in (reg // [(ind, reg ! ind `f` val)], pos + 1, freq, rec) jgz :: Value -> Value -> State -> State jgz condition offset (reg, pos, freq, rec) = @@ -47,12 +50,12 @@ parseLine str = let op : vs = words str in case op of "snd" -> son $ parseValue $ head vs - "set" -> app const (parseValue $ head vs) (parseValue $ last vs) - "add" -> app (+) (parseValue $ head vs) (parseValue $ last vs) - "mul" -> app (*) (parseValue $ head vs) (parseValue $ last vs) - "mod" -> app mod (parseValue $ head vs) (parseValue $ last vs) - "rcv" -> rcv $ parseValue $ head vs - "jgz" -> jgz (parseValue $ head vs) (parseValue $ last vs) + "set" -> app (flip const) (parseValue $ head vs) (parseValue $ last vs) + "add" -> app (+) (parseValue $ head vs) (parseValue $ last vs) + "mul" -> app (*) (parseValue $ head vs) (parseValue $ last vs) + "mod" -> app mod (parseValue $ head vs) (parseValue $ last vs) + "rcv" -> rcv $ parseValue $ head vs + "jgz" -> jgz (parseValue $ head vs) (parseValue $ last vs) -- precondition: pos < length instructions executeNextInstruction :: Seq Instruction -> State -> State @@ -66,6 +69,6 @@ recover instructions (reg, pos, freq, rec) = main :: IO () main = do - instructions <- fmap (fromList . map parseLine . lines) $ readFile "18.hs" + instructions <- fmap (fromList . map parseLine . lines) $ readFile "18.txt" let initialState = (V.replicate 5 0, 0, 0, 0) print $ recover instructions initialState \ No newline at end of file diff --git a/18b.hs b/18b.hs new file mode 100644 index 0000000..601a67f --- /dev/null +++ b/18b.hs @@ -0,0 +1,113 @@ +import Text.Read (readMaybe) +import Data.Sequence (Seq, fromList, empty, index, deleteAt, (|>)) +import qualified Data.Sequence as S (null) +import Data.Vector.Unboxed (Vector, (!), (//)) +import qualified Data.Vector.Unboxed as V (replicate) + +-- DEFINITIONS + +type Registers = Vector Int +type Program = (Registers, Int, Seq Int) +type Instruction = ProgramId -> State -> State +data State = State Program Program (Bool, Bool) Int +data Value = Register Char | Number Int +data ProgramId = Zero | One + +-- HELPERS + +getPos :: ProgramId -> State -> Int +getPos Zero (State (_, pos, _) _ _ _) = pos +getPos One (State _ (_, pos, _) _ _) = pos + +getStop :: ProgramId -> State -> Bool +getStop Zero (State _ _ (stop, _) _) = stop +getStop One (State _ _ (_, stop) _) = stop + +setStop :: ProgramId -> Bool -> State -> State +setStop Zero b (State p0 p1 (_, stop1) count) = State p0 p1 (b, stop1) count +setStop One b (State p0 p1 (stop0, _) count) = State p0 p1 (stop0, b) count + +pop :: Seq Int -> (Seq Int, Int) +pop queue = (deleteAt 0 queue, queue `index` 0) + +swap :: State -> State +swap (State p0 p1 (stop0, stop1) count) = State p1 p0 (stop1, stop0) count + +getIndex :: Value -> Int +getIndex (Register c) = case c of + 'a' -> 0 + 'b' -> 1 + 'f' -> 2 + 'i' -> 3 + 'p' -> 4 + +getValue :: Value -> Registers -> Int +getValue value registers = case value of + Number i -> i + c -> registers ! (getIndex c) + +-- OPERATIONS + +sen :: Value -> ProgramId -> State -> State +sen v Zero (State (reg0, pos0, que0) (reg1, pos1, que1) stop count) = + setStop One False $ State (reg0, pos0 + 1, que0) (reg1, pos1, que1 |> getValue v reg0) stop count +sen v One (State (reg0, pos0, que0) (reg1, pos1, que1) stop count) = + setStop Zero False $ State (reg0, pos0, que0 |> getValue v reg1) (reg1, pos1 + 1, que1) stop (count + 1) + +rcv :: Value -> ProgramId -> State -> State +rcv i Zero (State (reg0, pos0, que0) p1 stop count) = + if S.null que0 then setStop Zero True $ State (reg0, pos0, que0) p1 stop count else + let ind = getIndex i + (que, val) = pop que0 + in State (reg0 // [(ind, val)], pos0 + 1, que) p1 stop count +rcv i One state = swap . rcv i Zero . swap $ state + +app :: (Int -> Int -> Int) -> Value -> Value -> ProgramId -> State -> State +app f i v Zero (State (reg0, pos0, que0) p1 stop count) = + let ind = getIndex i + val = getValue v reg0 + in State (reg0 // [(ind, reg0 ! ind `f` val)], pos0 + 1, que0) p1 stop count +app f i v One state = swap . app f i v Zero . swap $ state + +jgz :: Value -> Value -> ProgramId -> State -> State +jgz condition offset Zero (State (reg0, pos0, que0) p1 stop count) = + State (reg0, pos0 + if getValue condition reg0 > 0 then getValue offset reg0 else 1, que0) p1 stop count +jgz condition offset One state = swap . jgz condition offset Zero . swap $ state + +-- PARSE + +parseLine :: String -> Instruction +parseLine str = + let op : vs = words str + in case op of + "snd" -> sen $ parseValue $ head vs + "set" -> app (flip const) (parseValue $ head vs) (parseValue $ last vs) + "add" -> app (+) (parseValue $ head vs) (parseValue $ last vs) + "mul" -> app (*) (parseValue $ head vs) (parseValue $ last vs) + "mod" -> app mod (parseValue $ head vs) (parseValue $ last vs) + "rcv" -> rcv $ parseValue $ head vs + "jgz" -> jgz (parseValue $ head vs) (parseValue $ last vs) + where parseValue s = case readMaybe s of + Just i -> Number i + Nothing -> Register $ head s + +-- SOLVE + +executeNextInstruction :: Seq Instruction -> ProgramId -> State -> State +executeNextInstruction instructions pid state = + let pos = getPos pid state + in if pos >= length instructions then setStop pid True state + else (instructions `index` pos) pid state + +getCount :: Seq Instruction -> State -> Int +getCount _ (State _ _ (True, True) count) = count +getCount instructions state = + if not $ getStop Zero state + then getCount instructions $ executeNextInstruction instructions Zero state + else getCount instructions $ executeNextInstruction instructions One state + +main :: IO () +main = do + instructions <- fmap (fromList . map parseLine . lines) $ readFile "18.txt" + let initialState = (State (V.replicate 5 0, 0, empty) (V.replicate 5 0 // [(4, 1)], 0, empty) (False, False) 0) :: State + print $ getCount instructions initialState \ No newline at end of file diff --git a/README.md b/README.md index 833dce3..6ae4615 100644 --- a/README.md +++ b/README.md @@ -26,6 +26,7 @@ These are the runtimes of only one trial but the variances are fairly small and | 15 | 62.242 | | 16 | 0.462 | | 17 | 6.753 | 1.865 +| 18 | 0.118 | Problems that should be optimized further: 15