diff --git a/hs/src/Aoc/Y2020.hs b/hs/src/Aoc/Y2020.hs index 19e3f94..ddb03fd 100644 --- a/hs/src/Aoc/Y2020.hs +++ b/hs/src/Aoc/Y2020.hs @@ -10,6 +10,7 @@ import qualified Aoc.Y2020.D04 as D04 import qualified Aoc.Y2020.D05 as D05 import qualified Aoc.Y2020.D06 as D06 import qualified Aoc.Y2020.D07 as D07 +import qualified Aoc.Y2020.D08 as D08 year :: Year year = Year 2020 @@ -20,4 +21,5 @@ year = Year 2020 , ( 5, D05.day) , ( 6, D06.day) , ( 7, D07.day) + , ( 8, D08.day) ] diff --git a/hs/src/Aoc/Y2020/D08.hs b/hs/src/Aoc/Y2020/D08.hs new file mode 100644 index 0000000..2a9e69c --- /dev/null +++ b/hs/src/Aoc/Y2020/D08.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Aoc.Y2020.D08 + ( day + ) where + +import qualified Data.Map as Map +import qualified Data.Set as Set + +import Aoc.Day +import Aoc.Parse + +data Opcode = Acc | Jmp | Nop + deriving (Show, Eq, Ord) + +data Instr = Instr Opcode Int + deriving (Show, Eq, Ord) + +parser :: Parser [Instr] +parser = manyLines $ Instr <$> (pOpcode <* char ' ') <*> signed (pure ()) decimal + where + pOpcode = (Acc <$ string "acc") <|> (Jmp <$ string "jmp") <|> (Nop <$ string "nop") + +data State = State + { sInstrs :: Map.Map Int Instr + , sIdx :: Int + , sAcc :: Int + } deriving (Show) + +newState :: [Instr] -> State +newState instrs = State (Map.fromList $ zip [0..] instrs) 0 0 + +incIdx :: Int -> State -> State +incIdx delta s = s { sIdx = delta + sIdx s } + +incAcc :: Int -> State -> State +incAcc delta s = s { sAcc = delta + sAcc s } + +step :: State -> Maybe State +step s = do + (Instr op val) <- sInstrs s Map.!? sIdx s + pure $ case op of + Acc -> incIdx 1 $ incAcc val s + Jmp -> incIdx val s + Nop -> incIdx 1 s + +run :: State -> [State] +run s = s : case step s of + Nothing -> [] + Just s' -> run s' + +untilRepeatingIdx :: [State] -> [State] +untilRepeatingIdx = helper Set.empty + where + helper _ [] = [] + helper idxs (s:ss) + | i `Set.member` idxs = [] + | otherwise = s : helper (Set.insert i idxs) ss + where i = sIdx s + +solver :: [Instr] -> IO () +solver instrs = do + let s = newState instrs + + putStrLn ">> Part 1" + print $ sAcc $ last $ untilRepeatingIdx $ run s + + putStrLn "" + putStrLn ">> Part 2" + +day :: Day +day = dayParse parser solver