diff options
Diffstat (limited to 'Puzzle25.hs')
| -rw-r--r-- | Puzzle25.hs | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/Puzzle25.hs b/Puzzle25.hs new file mode 100644 index 0000000..656e91d --- /dev/null +++ b/Puzzle25.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +import Text.Parsec.Prim +import Text.Parsec.Char +import Text.Parsec.Combinator +import Data.Functor.Identity (Identity) +import Data.Either (fromRight) +import Data.Map (Map) +import qualified Data.Map as Map + +type Rule = Map (Char, Int) (Int, Char, Int) + +run :: Int -> Int -> Char -> [Int] -> Rule -> [Int] +run 0 _ _ tape _ = tape +run !n !cursor !st !tape !rule = + run (n - 1) cursor'' st' tape'' rule + where val = tape !! cursor + (shift, st', val') = rule Map.! (st, val) + tape' = (take cursor tape) ++ (val':(drop (cursor + 1) tape)) + cursor' = cursor + shift + tape'' = if (cursor' == -1) then 0:tape' else if (cursor' >= length tape) then tape' ++ [0] else tape' + cursor'' = max cursor' 0 + +turingParse :: Stream s Identity Char => Parsec s () (Int, Char, Rule) +turingParse = do + (initN, initSt) <- preamble + rule <- Map.fromList <$> (mconcat <$> many1 paragraph) + return (initN, initSt, rule) + +preamble :: Stream s Identity Char => Parsec s () (Int, Char) +preamble = do + string "Begin in state " + initSt <- anyChar + string ".\nPerform a diagnostic checksum after " + initN <- read <$> many1 digit + string " steps.\n\n" + return (initN, initSt) + +paragraph :: Stream s Identity Char => Parsec s () [((Char, Int), (Int, Char, Int))] +paragraph = do + string "In state " + st <- anyChar + string ":\n" >> many space + (val0, val0', shift0, st0') <- branch + many space + (val1, val1', shift1, st1') <- branch + newline + return [((st, val0), (shift0, st0', val0')), ((st, val1), (shift1, st1', val1'))] + +branch :: Stream s Identity Char => Parsec s () (Int, Int, Int, Char) +branch = do + string "If the current value is " + val <- read <$> many1 digit + string ":\n" >> many space >> string "- Write the value " + val' <- read <$> many1 digit + string ".\n" >> many space >> string "- Move one slot to the " + shift <- (\x -> if x == "left" then -1 else 1) <$> ((string "left") <|> (string "right")) + string ".\n" >> many space >> string "- Continue with state " + st' <- anyChar + string ".\n" + return (val, val', shift, st') + +solve1 xs = let (initN, initSt, rule) = fromRight (0, 'A', Map.empty) $ parse turingParse "" xs in + sum $ run initN 0 initSt [0] rule + +main = putStr $ show $ solve1 input + +input0 = "Begin in state A.\nPerform a diagnostic checksum after 6 steps.\n\nIn state A:\n If the current value is 0:\n - Write the value 1.\n - Move one slot to the right.\n - Continue with state B.\n If the current value is 1:\n - Write the value 0.\n - Move one slot to the left.\n - Continue with state B.\n\nIn state B:\n If the current value is 0:\n - Write the value 1.\n - Move one slot to the left.\n - Continue with state A.\n If the current value is 1:\n - Write the value 1.\n - Move one slot to the right.\n - Continue with state A.\n\n" + +input = "Begin in state A.\nPerform a diagnostic checksum after 12399302 steps.\n\nIn state A:\n If the current value is 0:\n - Write the value 1.\n - Move one slot to the right.\n - Continue with state B.\n If the current value is 1:\n - Write the value 0.\n - Move one slot to the right.\n - Continue with state C.\n\nIn state B:\n If the current value is 0:\n - Write the value 0.\n - Move one slot to the left.\n - Continue with state A.\n If the current value is 1:\n - Write the value 0.\n - Move one slot to the right.\n - Continue with state D.\n\nIn state C:\n If the current value is 0:\n - Write the value 1.\n - Move one slot to the right.\n - Continue with state D.\n If the current value is 1:\n - Write the value 1.\n - Move one slot to the right.\n - Continue with state A.\n\nIn state D:\n If the current value is 0:\n - Write the value 1.\n - Move one slot to the left.\n - Continue with state E.\n If the current value is 1:\n - Write the value 0.\n - Move one slot to the left.\n - Continue with state D.\n\nIn state E:\n If the current value is 0:\n - Write the value 1.\n - Move one slot to the right.\n - Continue with state F.\n If the current value is 1:\n - Write the value 1.\n - Move one slot to the left.\n - Continue with state B.\n\nIn state F:\n If the current value is 0:\n - Write the value 1.\n - Move one slot to the right.\n - Continue with state A.\n If the current value is 1:\n - Write the value 1.\n - Move one slot to the right.\n - Continue with state E.\n\n" |