day19.md

Day 19

all / 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

Available as an RSS Feed

Prompt / Code / Rendered

I had originally solved this puzzle using recursive knot tying and a funky custom Monad --- the writeup for that is available online here. But after some thought and reflection, I saw that things might be a little cleaner as a hylomorphism from recursion-schemes, so I did a rewrite based on it! It also ended up being about 25% faster to run, which was a nice bonus. Note that I do have a blog post on hylomorphisms and recurion schemes (https://blog.jle.im/entry/tries-with-recursion-schemes.html), if you'd like to investigate more about the topic :)

The central type ("base functor") is Rule:

data Rule a = Simple Char
            | Compound [[a]]
  deriving (Show, Eq, Ord, Generic, Functor)

A Rule a is either a "base" Char match, or it is a list of options of sequences (a list of "or"'s of "and then"'s) of a. The choice of a gives us our interesting behavior.

For example, our initial ruleset from the input file is a list of Rule Ints: either they are a simple Char, or they contain a list of options of sequences of rule id's (Int). We can load it all as an IntMap (Rule Int), where each Rule Int is stored under its rule ID.

Just to help us get an intuition for this type, let's look at what happens if we want to "expand" out a rule all the way to only leaves at the end of a bunch of nested choices and sequences. This isn't required for the solve, but could be pretty fun.

For that, we can use the Fix data type:

newtype Fix f = Fix (f (Fix f))

type ExpandedRule = Fix Rule

A Fix Rule is infinite nested Rules: it's essentially Rule (Rule (Rule (Rule ...))) forever, meaning underneath each Compound are new rules, and at the end of it all we only have Leaf Chars, and no more Ints. For example, we could represent rule 0 of

0: 1 2 | 3
1: 3
2: 3 3
3: "a"

as

Fix $ Compound [
    [Fix $ Compoud [[Fix (Leaf 'a')]], Fix $ Compound [[Fix (Leaf 'a'), Fix (Leaf 'a')]]]
  , [Fix (Leaf 'a')]
  ]

But, given an IntMap (Rule Int) (the "unexpanded" raw rules as they are in the input file), how do we get our Fix Rule?

We can use the handy ana function, which, given an expansion function a -> Rule a, returns a a -> Fix Rule: It runs the a -> Rule a expansion function on the "seed" a, and then runs it again on all the as in the result, and again, and again, etc., until there are no more as to expand.

Well, in our case, our "expansion" function is Int -> Rule Int: "To expand an Int, look it up in the IntMap Int (RuleInt)". And that gives us a function to fully expand any rule number:

expandRule :: IntMap (Rule Int) -> Int -> Fix Rule
expandRule rs = ana (rs IM.!)

Neat, huh? That will fully expand the rule at any index by repeatedly re-expanding it with (rs IM.!) until we are out of things to expand.

Another fun thing we can write that we could actually use for part 1 is to turn an Fix Rule into a list of all possible strings to match. We want to write a Fix Rule -> [String] function by tearing down our recursive data type, and this could be nicely expressed with a catamorphism (cata :: (Rule a -> a) -> Fix Rule -> a), where we specify how to tear down a "single layer" of our Rule type, and cata will generalize that to tear down the entire structure. I talk about this a bit in my recursion schemes blog post, and the explanation I give is "The a values in the Rule become the very things we swore to create." --- in this case, the [String]

So let's write our Rule [String] -> [String]:

generateAlg :: Rule [String] -> [String]
generateAlg = \case
    Simple c   -> [[c]]                                   -- the single single-char string is created
    Compoud xs -> concatMap (fmap concat . sequence) xs   -- concat/sequence all options

And now cata generateAlg will generate all possible matches from a ruleset

ghci> cata generateAlg
    (Fix $ Compound [[Fix (Leaf 'h'), Fix (Leaf 'e')], [Fix (Leaf 'h')], [Fix (Leaf 'q')]])
["he","h","q"]

Okay, that's enough playing around for now...time to find our real solution :)

Note that we can "interpret" a rule to match it on a string by turning it into a String -> [String]: it'll take a string and return a list of the leftovers of every possible match. For example, running the rules (he)|h|q on "hello" should give us ["llo","ello"]. Then we can just see if we have any matches that return empty leftovers.

For aid in thinking, let's imagine turning a Fix Rule into a String -> [String]. We can do that with the help of cata :: (Rule a -> a) -> Fix Rule -> a. Because we want to write a Fix Rule -> (String -> [String]), our catamorphism function ("algebra") is Rule (String -> [String]) -> (String -> [String]):

matchAlg :: Rule (String -> [String]) -> String -> [String]
matchAlg = \case
    Simple c -> \case
      []   -> []
      d:ds -> if c == d then [ds] else []
    Compound xs -> \str ->
      concatMap (sequenceAll str) xs
  where
    -- run the String -> [String]s on an input String one after the other
    sequenceAll :: String -> [String -> [String]] -> [String]
    sequenceAll s0 fs = foldr (>=>) pure fs s0

match :: Fix Rule -> String -> [String]
match = cata matchAlg

We want to fail on our input string (return no matches) if we see a Simple c with either an empty input string or one that doesn't match the c. Then for the Compound case with our xs :: [[String -> [String]]], we take a choice (concatMap) of all of the possible full sequences of the inner [String -> [String]] sequences.

ghci> match (Fix $ Compound [[Fix (Leaf 'h'), Fix (Leaf 'e')], [Fix (Leaf 'h')], [Fix (Leaf 'q')]])
                "hello"
["llo", "ello"]

Alright, so now how do we solve the final puzzle?

It looks like we need to "generate" a Fix Rule, and immediately tear it down into a String -> [String] to use it to match a string. "Generate recursively and immediately tear down recursively"...that's a hylomorphism!

hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b

-- which we use as...
hylo :: (Rule b -> b) -> (a -> Rule a) -> a -> b

-- which we use as...
hylo  :: (Rule (String -> [String]) -> (String -> [String]))
      -> (Int -> Rule Int)
      -> Int
      -> (String -> [String])

If we give hylo a way to "break down nested Rules" and a way to "build up nested Rules", then it can actually iteratively expand up Rules while immediately tearing them down. The nice thing about this is that it's very lazy: it'll only call the generator function if you ever need the thing during your teardown function. Since our teardown function (the String -> [String]) will terminate whenever we encounter an empty string or no matches, hylo will only run the build-up function until the point that we hit one of those conditions. You can also think of it as running it on a Rule Int where each Int is dynamically looked up as you need it from the rules map.

The neat thing about this is that we don't ever need Fix at all: it's all built up and torn down "in-place", and we never built up any intermediate value. That's why I mentioned that the Fix part earlier was more of a side-tangent! But it definitely helps us understand the big picture, I feel.

Our final code (the whole of it, minus the parser) ends up being:

data Rule a = Simple Char
            | Compound [[a]]
  deriving (Show, Eq, Ord, Generic, Functor)

matchAlg :: Rule (String -> [String]) -> String -> [String]
matchAlg = \case
    Simple c -> \case
      []   -> []
      d:ds -> if c == d then [ds] else []
    Compound xs -> \str ->
      concatMap (sequenceAll str) xs
  where
    sequenceAll s0 fs = foldr (>=>) pure fs s0

matcher :: IntMap (Rule Int) -> String -> [String]
matcher rules = hylo matchAlg (rules IM.!) 0

solver :: IntMap (Rule Int) -> [String] -> Int
solver rules = length . filter (any null . matcher rules)

part1 :: IntMap Rule -> [String] -> Int
part1 = solver

part2 :: IntMap Rule -> [String] -> Int
part2 rs = solver (extraRules <> rs)

extraRules :: IntMap (Rule Int)
extraRules = IM.fromList [
    (8 , Compound [[42],[42,8]])
  , (11, Compound [[42,31],[42,11,31]])
  ]

As a nice little bonus, we can also use generateAlg with a hylomorphism to also turn an IntMap (Rule Int) into a list of all possible strings, which works for part 1 but would return an infinite list for part 2.

generateAll :: IntMap (Rule Int) -> Int -> [String]
generateAll rules = hylo generateAlg (rules IM.!) 0

Back to all reflections for 2020

Day 19 Benchmarks

>> Day 19a
benchmarking...
time                 4.273 ms   (4.202 ms .. 4.507 ms)
                     0.990 R²   (0.965 R² .. 1.000 R²)
mean                 4.244 ms   (4.200 ms .. 4.390 ms)
std dev              220.8 μs   (54.67 μs .. 480.5 μs)
variance introduced by outliers: 30% (moderately inflated)

* parsing and formatting times excluded

>> Day 19b
benchmarking...
time                 27.13 ms   (26.34 ms .. 28.22 ms)
                     0.994 R²   (0.987 R² .. 1.000 R²)
mean                 26.20 ms   (25.94 ms .. 26.80 ms)
std dev              908.6 μs   (525.5 μs .. 1.450 ms)
variance introduced by outliers: 10% (moderately inflated)

* parsing and formatting times excluded