Day 7 - Megaparsec

Today my 2 year old helped me to get up at 5.30, so I had about 20 minutes more than I would have normally have for getting settled at my laptop. Except for the loss of sleep that was a good thing, I was way more energetic when starting day 7.

For this assignment, we have a list of rules which describe how color coded bags should contain other color coded bags (and how many). This can be represented as a graph, a weighted Directed Acyclic Graph to be exact, also known as a DAG. In the graph each node (also called a vertex) is a bag and connected to the bags it should contain by an arrow (also called an edge.) In the diagram above the article, you see our example input as a graph. In the acronym DAG, directed means that the edges have a direction, acyclic means that there are no cycles, so if you follow the edges you can never reach a node twice and you will eventually reach a node from which there are no outgoing edges. Weighted means that a weight is associated with each edge.

For part 1 we have to find the amount of bags that can directly or indirectly contain a shiny gold bag. The blue nodes show the bags that match. The bag Light red and Dark orange only contain shiny gold indirectly.

We first have to read our input we use the splitOn function again. The parse function will give us a list of bag rules. A rule has a String for the outer bag color, and an array of a tuple with the amount and color name of the inner bag. We can actually build a graph out of this, but for finding our solution this is not necessary, we can find the other nodes by looking up the inner bags in the list.

parseLine line = (bag, contents) where
  (bag:contents:[]) = splitOn " bags contain " line

parseContents = splitOn ", " . init

parseBag bag = (if amount == "no" then 0 else read amount :: Int, intercalate " " color) where
  (amount:color) = (init . words) bag

parse line = (bag, inner) where
  (bag, contents) = parseLine line
  inner = map parseBag $ parseContents contents

To solve this we map over all the bags and see if it can contain a gold shiny bag. We look at the inner bags to see if it has a gold shiny one, and if it doesn't we recurse for each inner bag until we find a shiny gold bag, or until there are no inner bags anymore.

canContainShinyGold :: [(String, [(Int, String)])] -> String -> Bool
canContainShinyGold allBags bagColor = go (lookup bagColor allBags) where
  go :: Maybe [(Int, String)] -> Bool
  go (Just inner) = if any ((=="shiny gold") . snd) inner
                               then True
                               else any ((canContainShinyGold allBags). snd) inner

solve1 :: [([Char], [(Int, [Char])])] -> Int
solve1 bags = length $ filter ((canContainShinyGold bags) . fst) bags

For part 2 we have to find all the bags we can reach from the shiny gold bag (the purple nodes in the diagram.) We have to count how many bags will be in the shiny gold bag. The weights of the edges show the number of bags that are in each bag. We start the function with the Shiny gold bag, we map over the inner bags. For each inner bag, we call the count function to find how many bags it can contain, add 1 to it, to count the bag itself, and we multiply this by the number we have for this inner bag.

countBags :: String -> [(String, [(Int, String)])] -> Int
countBags bagColor allBags = go (lookup bagColor allBags) where
  go :: Maybe [(Int, String)] -> Int
  go (Just inner) = sum $ map (\(cnt, clr) -> cnt * (1 + countBags clr allBags ) inner)

solve2 :: [([Char], [(Int, [Char])])] -> Int
solve2 bags = (countBags "shiny gold" bags)

We notice that the second part is way faster than part 1, milliseconds vs seconds. In part 2 we know exactly which routes we are going to take. In part 1 we take all routes and see if they might cross Shiny gold. We could have solved this by actually building a graph and then inverting the edges. For part 1 we could have just walked all the reachable nodes (via the inverted edges)

After solving I started looking for cleanup, and the biggest problem for me was the reading of the input. I already had mentioned that I wanted to look into actual parsing. I looked at the Megaparsec module, added some utility functions to my Advent utility class, and changed the reading of input. I also introduced two types to make it more clear what we are working with. The new code looks like this.

type Bag = String
type Rule = (Bag, [(Int, Bag)])

bag :: Parser Bag
bag = some letterChar <> " " <> some letterChar <* " bag" <* optional "s"

bags :: Parser (Int, Bag)
bags = (,) <$> decimal <* " " <*> bag

contents :: Parser [(Int, Bag)]
contents = [] <$ "no other bags" <|> bags `sepBy1` ", "

rule :: Parser Rule
rule = (,) <$> bag <* " contain " <*> contents <* "."

Not much smaller, but a lot cleaner. You can have a look at my github, I changed more days with MegaParsec and the improvement can be even better. Let me know what you think of the improvement of using the parser. See you again tomorrow.