From 36b7ae3736c9ab52da7994bde0cb3ed657efc721 Mon Sep 17 00:00:00 2001
From: Yuchen Pei <me@ypei.me>
Date: Thu, 28 Dec 2017 23:06:19 +0100
Subject: All done!

---
 Puzzle25.hs | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 Puzzle25.hs

(limited to 'Puzzle25.hs')

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"
-- 
cgit v1.2.3