Jump to:
D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25
Part 1
Day 19 gives us another question just begging for a beautiful recursive solution in Haskell! This might be my favorite problem thus far this year. We are given a way to build up a complex string-matching rule, as well as a collection of strings, and are asked to count how many strings match the rule.
In general, rules are composed of "sub-rules", and are expressed as A : B C | D E, which can be interpeted as "rule A is satisfied if the string is composed of a string that satisifes rule B and one that satisfies rule C, or composed of a string that satisfied rule D and one that satisfies rule E. Two leaf node rules simply match the string "a" and the string "b".
At first, I started writing something with the following signature:
-- a list of sequences, a string must satisfy one of the sequences to satisfy the rule
type Rule = [[Int]]
matchesRule :: Rule -> String -> Bool
...which would return whether a given string satisfies the rule. However, it quickly became awkward to use, as we ultimately need to answer the question: does some prefix of the string satisfy the rule? Instead, we answer a slightly different question: given a string and a rule, return all strings that could result from stripping off a prefix that satisfies the rule (we'll call this the list of suffixes). This still enables us to answer the yes/no question. If the empty string is present in the list of suffixes, then the entire string matched the rule; otherwise, the entire string does not match the rule. If the list of suffixes contains a non-empty string, it means that a prefix matches, but not the whole string. If the list of suffixes is empty, then no prefix of the string matches the rule.
At first, this seems like a more difficult function to write, but returning the list of suffixes allows us to write a very nice recursive solution:
import D19input
-- aRule :: Int
-- bRule :: Int
type Rule = [[Int]]
stripRule :: String -> Map.IntMap Rule -> Int -> [String]
stripRule "" _ _ = []
stripRule s m index
| index == aRule = if head s == 'a' then [tail s] else []
| index == bRule = if head s == 'b' then [tail s] else []
| otherwise =
let (Just r) = Map.lookup index m
in concat $ List.map (stripRuleSeq s m) r
stripRuleSeq :: String -> Map.IntMap Rule -> [Int] -> [String]
stripRuleSeq s m [] = [s]
stripRuleSeq s m (i:is) = do
stripped <- stripRule s m i
stripRuleSeq stripped m is
stripRule is the function that returns the list of suffixes. Note that its implementation involves two functions: stripRule calls stripRuleSeq, which answers the same question, except that it performs multiple strips corresponding to a sequence of rules, which is useful since a rule can be defined as a sequence of rules. stripRuleSeq in turn calls stripRule in order to perform the individual strips. The recursion terminates because the input guarantees that we will eventually reach the rules that satisfy "a" and "b". At this point, stripRule does not recurse, but instead performs the strip as a base case.
This can be difficult to wrap your head around, but the recursion actually mirrors the nature of the problem very beautifully. In order to strip the prefix for a single rule, we need to strip prefixes for a sequence of rules. In order to strip off prefixes for a sequence of rules, simply call the individual strip multiple times. If you trust that your base cases are handled correctly, the entire solution should just work. That's the beauty of recursion.
Since we are dealing with lists of suffixes, we need to do some list manipulations as we jump between the functions (i.e., concatenating all of the result lists together into a single list), but other than that, each function itself is very simple. For stripRuleSeq, the concatenation is done by computing within the list monad.
import D19input
-- aRule :: Int
-- bRule :: Int
-- rules :: [(Int, [[Int]])]
-- input :: [String]
import qualified Data.IntMap.Lazy as Map
import qualified Data.List as List
import qualified Data.Maybe as Maybe
type Rule = [[Int]]
matchesRule :: Map.IntMap Rule -> Int -> String -> Bool
matchesRule m i s =
let tails = stripRule s m i
in List.elem "" tails
solve :: Int
solve = let rulesMap = Map.fromList rules
in length $ filter (matchesRule rulesMap 0) input
main :: IO ()
main = print $ solve
With stripRule implemented, we can go back to writing our matchesRule function that returns a Boolean. We perform the strip, getting all possible suffixes that result. If and only if the empty string is one of them, we have a match.
Part 2
Part 2 asks us to modify our rules slightly in a manner that introduces cycles. For example the rule 8 becomes "8: 42 | 42 8" which effectively means that rule 8 matches any string that can be expressed as a sequence of strings satisfying 42. It's not guaranteed by the input, but it turns out from the rules provided that all strings satisfying rule 8 (when it was simply "8: 42") are exactly 8 characters long in part 1. Now, 16-character strings could match rules 8, as could 24-character strings, etc.
Thankfully, our algoraithm from part 1 handles this just fine! It will happily strip of multiple instances of strings satisfying rule 42 when determining whether a string satisfies rule 8. All we need to do is make the prescribed modification to the map of rules.
solve :: Int
solve = let rulesMap = Map.fromList rules
updatedMap = Map.insert 11 [[42,31],[42,11,31]] $
Map.insert 8 [[42], [42,8]] rulesMap
in length $ filter (matchesRule updatedMap 0) input
Jump to:
D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25