From a03c0ce5608b23a351886efbbeaa30cef19c284f Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Fri, 25 Dec 2020 10:04:49 +0100
Subject: Day 19

The second part was supposed to be more difficult than the first part;
the problem statement hinted that you might need to memoise the set of
sentences matched by non-recursive rules, "especially rules 42 and 31".
Why the hell then did my utterly naive matcher from part 1 work without
changes in ~60ms total?
---
 2020/19.hs | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100644 2020/19.hs

(limited to '2020/19.hs')

diff --git a/2020/19.hs b/2020/19.hs
new file mode 100644
index 0000000..3ae886f
--- /dev/null
+++ b/2020/19.hs
@@ -0,0 +1,50 @@
+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
+           | otherwise -> False
+      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))
-- 
cgit v1.2.3-54-g00ecf