1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
{-
Copyright (C) 2017 Yuchen Pei.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Affero General Public
License along with this program. If not, see
<https://www.gnu.org/licenses/>.
-}
{-# 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"
|
