Day 18

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
+    let ind = getIndex i
-        value = getValue v reg
+        val = getValue v reg
-    in (reg // [(index, reg ! index `f` value)], pos + 1, freq, rec)
+    in (reg // [(ind, reg ! ind `f` val)], pos + 1, freq, rec)
 
 jgz :: Value -> Value -> State -> State
 jgz condition offset (reg, pos, freq, rec) =
@@ -47,7 +50,7 @@ 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)
+        "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)
@@ -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

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

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