Solve Day 19

AdventOfCode2020.cabal

@@ -51,6 +51,7 @@ library
       Day17.Solution
       Day18.Internal
       Day18.Solution
+      Day19.Solution
       Day20.Solution
       Day21.Solution
       Day24.Solution
@@ -100,6 +101,7 @@ test-suite AdventOfCode2020-test
       Day16.UtilsSpec
       Day17.SolutionSpec
       Day18.SolutionSpec
+      Day19.SolutionSpec
       Day20.SolutionSpec
       Day21.SolutionSpec
       Day24.SolutionSpec

README.md

@@ -27,7 +27,7 @@ Solutions to adventofcode.com/2020
 | [PR #26](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/26) | Day 16: Ticket Translation      | [src/Day16/Solution.hs](src/Day16/Solution.hs) | [test/Day16/SolutionSpec.hs](test/Day16/SolutionSpec.hs) |
 | [PR #30](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/30) | Day 17: Conway Cubes            | [src/Day17/Solution.hs](src/Day17/Solution.hs) | [test/Day17/SolutionSpec.hs](test/Day17/SolutionSpec.hs) |
 | [PR #31](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/31) | Day 18: Operation Order         | [src/Day18/Solution.hs](src/Day18/Solution.hs) | [test/Day18/SolutionSpec.hs](test/Day18/SolutionSpec.hs) |
-| [PR #32](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/32) | Day 19: Monster Messages        | `[in progress, 1 star ]`                       | `[in progress]`                                          |
+| [PR #32](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/32) | Day 19: Monster Messages        | [src/Day19/Solution.hs](src/Day19/Solution.hs) | [test/Day19/SolutionSpec.hs](test/Day19/SolutionSpec.hs) |
 | [PR #34](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/34) | Day 20: Jurassic Jigsaw         | [src/Day20/Solution.hs](src/Day20/Solution.hs) | [test/Day20/SolutionSpec.hs](test/Day20/SolutionSpec.hs) |
 | [PR #35](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/35) | Day 21: Allergen Assessment     | [src/Day21/Solution.hs](src/Day21/Solution.hs) | [test/Day21/SolutionSpec.hs](test/Day21/SolutionSpec.hs) |
 | [PR #38](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/38) | Day 22: Crab Combat             | `[in progress, 1 star ]`                       | `[in progress]`                                          |
@@ -36,7 +36,6 @@ Solutions to adventofcode.com/2020
 | [PR #45](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/45) | Day 25: Combo Breaker           | `[in progress, 1 star ]`                       | `[in progress]`                                          |
 
 <!-- | [PR #25](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/25) | Day 15: Rambunctious Recitation | [src/Day15/Solution.hs](src/Day15/Solution.hs) | [test/Day15/SolutionSpec.hs](test/Day15/SolutionSpec.hs) | -->
-<!-- | [PR #32](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/32) | Day 19: Monster Messages        | [src/Day19/Solution.hs](src/Day19/Solution.hs) | [test/Day19/SolutionSpec.hs](test/Day19/SolutionSpec.hs) | -->
 <!-- | [PR #38](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/38) | Day 22: Crab Combat             | [src/Day22/Solution.hs](src/Day22/Solution.hs) | [test/Day22/SolutionSpec.hs](test/Day22/SolutionSpec.hs) | -->
 <!-- | [PR #40](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/40) | Day 23: Crab Cups               | [src/Day23/Solution.hs](src/Day23/Solution.hs) | [test/Day23/SolutionSpec.hs](test/Day23/SolutionSpec.hs) | -->
 <!-- | [PR #45](https://github.com/manuphatak/HaskellAdventOfCode2020/pull/45) | Day 25: Combo Breaker           | [src/Day25/Solution.hs](src/Day25/Solution.hs) | [test/Day25/SolutionSpec.hs](test/Day25/SolutionSpec.hs) | -->

src/Day19/NOTES.md

@@ -0,0 +1,16 @@
+# Notes
+
+Definitely borrowed from this solution:
+https://github.com/mstksg/advent-of-code-2020/blob/5065aad720f6996386e9c94fbd7904a6fa9f2d9d/reflections-out/day19.md
+
+I struggled with the scenario where a string ends before the rules do. For the
+life of me, I could not figure out how to get this working.
+
+For example
+
+```
+Rules: H E L L O W O R L D
+String: "HELLO"
+```
+
+I could get one or the other working, but never both.

src/Day19/README.md

@@ -0,0 +1,153 @@
+## Day 19: Monster Messages
+
+You land in an airport surrounded by dense forest. As you walk to your high-speed train, the Elves at the Mythical Information Bureau contact you again. They think their satellite has collected an image of a _sea monster_ ! Unfortunately, the connection to the satellite is having problems, and many of the messages sent back from the satellite have been corrupted.
+
+They sent you a list of _the rules valid messages should obey_ and a list of _received messages_ they've collected so far (your puzzle input).
+
+The _rules for valid messages_ (the top part of your puzzle input) are numbered and build upon each other. For example:
+
+```
+0: 1 2
+1: "a"
+2: 1 3 | 3 1
+3: "b"
+```
+
+Some rules, like `3: "b"` , simply match a single character (in this case, `b` ).
+
+The remaining rules list the sub-rules that must be followed; for example, the rule `0: 1 2` means that to match rule `0` , the text being checked must match rule `1` , and the text after the part that matched rule `1` must then match rule `2` .
+
+Some of the rules have multiple lists of sub-rules separated by a pipe ( `|` ). This means that _at least one_ list of sub-rules must match. (The ones that match might be different each time the rule is encountered.) For example, the rule `2: 1 3 | 3 1` means that to match rule `2` , the text being checked must match rule `1` followed by rule `3` _or_ it must match rule `3` followed by rule `1` .
+
+Fortunately, there are no loops in the rules, so the list of possible matches will be finite. Since rule `1` matches `a` and rule `3` matches `b` , rule `2` matches either `ab` or `ba` . Therefore, rule `0` matches `aab` or `aba` .
+
+Here's a more interesting example:
+
+```
+0: 4 1 5
+1: 2 3 | 3 2
+2: 4 4 | 5 5
+3: 4 5 | 5 4
+4: "a"
+5: "b"
+```
+
+Here, because rule `4` matches `a` and rule `5` matches `b` , rule `2` matches two letters that are the same ( `aa` or `bb` ), and rule `3` matches two letters that are different ( `ab` or `ba` ).
+
+Since rule `1` matches rules `2` and `3` once each in either order, it must match two pairs of letters, one pair with matching letters and one pair with different letters. This leaves eight possibilities: `aaab` , `aaba` , `bbab` , `bbba` , `abaa` , `abbb` , `baaa` , or `babb` .
+
+Rule `0` , therefore, matches `a` (rule `4` ), then any of the eight options from rule `1` , then `b` (rule `5` ): `aaaabb` , `aaabab` , `abbabb` , `abbbab` , `aabaab` , `aabbbb` , `abaaab` , or `ababbb` .
+
+The _received messages_ (the bottom part of your puzzle input) need to be checked against the rules so you can determine which are valid and which are corrupted. Including the rules and the messages together, this might look like:
+
+```
+0: 4 1 5
+1: 2 3 | 3 2
+2: 4 4 | 5 5
+3: 4 5 | 5 4
+4: "a"
+5: "b"
+
+ababbb
+bababa
+abbbab
+aaabbb
+aaaabbb
+```
+
+Your goal is to determine _the number of messages that completely match rule `0`_ . In the above example, `ababbb` and `abbbab` match, but `bababa` , `aaabbb` , and `aaaabbb` do not, producing the answer _`2`_ . The whole message must match all of rule `0` ; there can't be extra unmatched characters in the message. (For example, `aaaabbb` might appear to match rule `0` above, but it has an extra unmatched `b` on the end.)
+
+_How many messages completely match rule `0` ?_
+
+## Part Two
+
+As you look over the list of messages, you realize your matching rules aren't quite right. To fix them, completely replace rules `8: 42` and `11: 42 31` with the following:
+
+```
+8: 42 | 42 8
+11: 42 31 | 42 11 31
+```
+
+This small change has a big impact: now, the rules _do_ contain loops, and the list of messages they could hypothetically match is infinite. You'll need to determine how these changes affect which messages are valid.
+
+Fortunately, many of the rules are unaffected by this change; it might help to start by looking at which rules always match the same set of values and how _those_ rules (especially rules `42` and `31` ) are used by the new versions of rules `8` and `11` .
+
+(Remember, _you only need to handle the rules you have_ ; building a solution that could handle any hypothetical combination of rules would be [significantly more difficult][1] .)
+
+For example:
+
+```
+42: 9 14 | 10 1
+9: 14 27 | 1 26
+10: 23 14 | 28 1
+1: "a"
+11: 42 31
+5: 1 14 | 15 1
+19: 14 1 | 14 14
+12: 24 14 | 19 1
+16: 15 1 | 14 14
+31: 14 17 | 1 13
+6: 14 14 | 1 14
+2: 1 24 | 14 4
+0: 8 11
+13: 14 3 | 1 12
+15: 1 | 14
+17: 14 2 | 1 7
+23: 25 1 | 22 14
+28: 16 1
+4: 1 1
+20: 14 14 | 1 15
+3: 5 14 | 16 1
+27: 1 6 | 14 18
+14: "b"
+21: 14 1 | 1 14
+25: 1 1 | 1 14
+22: 14 14
+8: 42
+26: 14 22 | 1 20
+18: 15 15
+7: 14 5 | 1 21
+24: 14 1
+
+abbbbbabbbaaaababbaabbbbabababbbabbbbbbabaaaa
+bbabbbbaabaabba
+babbbbaabbbbbabbbbbbaabaaabaaa
+aaabbbbbbaaaabaababaabababbabaaabbababababaaa
+bbbbbbbaaaabbbbaaabbabaaa
+bbbababbbbaaaaaaaabbababaaababaabab
+ababaaaaaabaaab
+ababaaaaabbbaba
+baabbaaaabbaaaababbaababb
+abbbbabbbbaaaababbbbbbaaaababb
+aaaaabbaabaaaaababaa
+aaaabbaaaabbaaa
+aaaabbaabbaaaaaaabbbabbbaaabbaabaaa
+babaaabbbaaabaababbaabababaaab
+aabbbbbaabbbaaaaaabbbbbababaaaaabbaaabba
+```
+
+Without updating rules `8` and `11` , these rules only match three messages: `bbabbbbaabaabba` , `ababaaaaaabaaab` , and `ababaaaaabbbaba` .
+
+However, after updating rules `8` and `11` , a total of _`12`_ messages match:
+
+- `bbabbbbaabaabba`
+- `babbbbaabbbbbabbbbbbaabaaabaaa`
+- `aaabbbbbbaaaabaababaabababbabaaabbababababaaa`
+- `bbbbbbbaaaabbbbaaabbabaaa`
+- `bbbababbbbaaaaaaaabbababaaababaabab`
+- `ababaaaaaabaaab`
+- `ababaaaaabbbaba`
+- `baabbaaaabbaaaababbaababb`
+- `abbbbabbbbaaaababbbbbbaaaababb`
+- `aaaaabbaabaaaaababaa`
+- `aaaabbaabbaaaaaaabbbabbbaaabbaabaaa`
+- `aabbbbbaabbbaaaaaabbbbbababaaaaabbaaabba`
+
+_After updating rules `8` and `11` , how many messages completely match rule `0` ?_
+
+## Link
+
+[https://adventofcode.com/2020/day/19][2]
+
+[1]: https://en.wikipedia.org/wiki/Formal_grammar
+[2]: https://adventofcode.com/2020/day/19

src/Day19/Solution.hs

@@ -0,0 +1,113 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Day19.Solution where
+
+import Advent.Parser
+import Advent.Utils
+import Control.Monad
+import Data.Functor
+import Data.IntMap.Lazy (IntMap)
+import qualified Data.IntMap.Lazy as IntMap
+import Text.Parsec hiding ((<|>))
+
+part1 :: String -> String
+part1 = show . length . validMessages . fromRightOrShowError . parseDocument
+
+part2 :: String -> String
+part2 = show . length . validMessages . withNewRules . fromRightOrShowError . parseDocument
+
+data Rule = Ref (AndOr Int) | Val Char deriving (Show, Eq)
+
+data AndOr a
+  = Leaf a
+  | And [AndOr a]
+  | Or [AndOr a]
+  deriving (Show, Eq)
+
+instance Functor AndOr where
+  fmap f = \case
+    Leaf a -> Leaf (f a)
+    And xs -> And (map (fmap f) xs)
+    Or xs -> Or (map (fmap f) xs)
+
+instance Applicative AndOr where
+  pure = return
+  (<*>) = ap
+
+instance Monad AndOr where
+  m >>= f = case m of
+    Leaf x -> f x
+    And xs -> And $ map (>>= f) xs
+    Or xs -> Or $ map (>>= f) xs
+
+data Document = Document {dRules :: IntMap Rule, dMessages :: [String]} deriving (Show, Eq)
+
+parseDocument :: String -> Either ParseError Document
+parseDocument = parse documentParser ""
+  where
+    documentParser :: Parsec String () Document
+    documentParser = Document <$> rulesParser <*> (spaces *> messagesParser <* eof)
+
+    messagesParser :: Parsec String () [String]
+    messagesParser = many1 letter `sepEndBy` newline
+
+    rulesParser :: Parsec String () (IntMap Rule)
+    rulesParser = IntMap.fromList <$> (rulePairParser `endBy1` newline)
+
+    rulePairParser :: Parsec String () (Int, Rule)
+    rulePairParser = (,) <$> (intParser <* char ':' <* char ' ') <*> ruleParser
+
+    ruleParser :: Parsec String () Rule
+    ruleParser = choice [valParser, refParser]
+
+    refParser :: Parsec String () Rule
+    refParser = Ref <$> orParser
+
+    orParser :: Parsec String () (AndOr Int)
+    orParser = Or <$> andParser `sepBy1` (char '|' <* char ' ')
+
+    andParser :: Parsec String () (AndOr Int)
+    andParser = And <$> leafParser `sepEndBy1` char ' '
+
+    leafParser :: Parsec String () (AndOr Int)
+    leafParser = Leaf <$> intParser
+
+    valParser :: Parsec String () Rule
+    valParser = Val <$> betweenDblQuotes letter
+
+    betweenDblQuotes :: Parsec String () a -> Parsec String () a
+    betweenDblQuotes = between (char '"') (char '"')
+
+isValidMessage :: IntMap Rule -> String -> Bool
+isValidMessage rules = any null . match rule
+  where
+    rule = expandRules rules IntMap.! 0
+
+expandRules :: IntMap Rule -> IntMap (AndOr Char)
+expandRules rules = result
+  where
+    result =
+      rules <&> \case
+        Val x -> Leaf x
+        Ref xs -> xs >>= (result IntMap.!)
+
+match :: AndOr Char -> String -> [String]
+match = \case
+  Leaf c -> \case
+    [] -> []
+    x : xs -> xs <$ guard (x == c)
+  And xs -> foldr (>=>) pure (match <$> xs)
+  Or xs -> \str -> concatMap (`match` str) xs
+
+withNewRules :: Document -> Document
+withNewRules document@Document {dRules = rules} = document {dRules = newRules <> rules}
+  where
+    newRules :: IntMap Rule
+    newRules =
+      IntMap.fromList
+        [ (8, Ref $ Or [And [Leaf 42], And [Leaf 42, Leaf 8]]),
+          (11, Ref $ Or [And [Leaf 42, Leaf 31], And [Leaf 42, Leaf 11, Leaf 31]])
+        ]
+
+validMessages :: Document -> [String]
+validMessages (Document rules messages) = filter (isValidMessage rules) messages