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
|
module Main where
import qualified Data.Array as A
import Data.Foldable (toList)
import Text.Parsec hiding (getInput)
import Input
import Util
data Rule = S Char | D [[Int]]
deriving (Show)
parseRule :: String -> (Int, Rule)
parseRule = either (error . show) id . parse pRule ""
where
pRule :: Parsec String () (Int, Rule)
pRule = (,) <$> pNum <*> (string ": " >> pRhs)
pNum = read <$> many1 digit
pRhs = S <$> pString <|> D <$> (pConj `sepBy` try (spaces >> char '|'))
pString = try $ spaces >> between (char '"') (char '"') (satisfy (/= '"'))
pConj = many1 (try (spaces >> pNum))
newtype Gram = Gram (A.Array Int Rule)
deriving (Show)
parseGram :: [String] -> Gram
parseGram l =
let parsed = map parseRule l
ids = map fst parsed
in Gram (A.array (minimum ids, maximum ids) parsed)
matches :: Gram -> [Int] -> String -> Bool
matches _ [] [] = True
matches gram@(Gram arr) (r:rs) (c:cs) =
case arr A.! r of
S c' -> c == c' && matches gram rs cs
D alts -> any (\alt -> matches gram (alt ++ rs) (c:cs)) alts
matches _ _ _ = False
update2 :: Gram -> Gram
update2 (Gram arr) = Gram (arr A.// [(8, D [[42], [42, 8]]), (11, D [[42, 31], [42, 11, 31]])])
main :: IO ()
main = do
[rules, inputs] <- toList . splitOn null <$> getInput 19
let gram = parseGram rules
print (length (filter (matches gram [0]) inputs))
print (length (filter (matches (update2 gram) [0]) inputs))
|
