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
Parsing the Input
Things are getting exciting! Day 7 asks us to perform some graph traversals. I had never dealt with graphs in Haskell before, so I learned in implementing this solution.
Unfortunately, there's a relatively heavy input parsing component for this Day. Let's get that out of the way first.
import D7input
-- input :: [String]
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
parseChildren :: [String] -> [(Int, String)]
parseChildren [] = []
parseChildren s =
let number = read (head s)
color = unwords (take 2 $ tail s)
in (number, color) : parseChildren (drop 4 s)
parse :: String -> (String, [(Int, String)])
parse s =
let tokens = words s
key = unwords (take 2 tokens)
children = parseChildren (drop 4 tokens)
in if length tokens == 7
then (key, [])
else (key, children)
mapify :: [String] -> Map.Map String [(Int, String)]
mapify ss = Map.fromList (List.map parse ss)
As usual, I make an uncomfortable number of assumptions about the input, but it does have a reliable structure, so we might as well exploit that. The goal here is to implement the mapify function, which takes the input and converts it into a map from bag to list of contained bags. The data structure we want to use here is Map String [(Int, String)]. When viewed this way, each line of the input is describing one key-value pair, which makes the overall mapify function very easy to write: convert each line into a (String, [(Int, String)]), and then use fromList to construct the map.
parseChildren takes a subset of the line that describes the contained bags. Note that the substring after the word "contain" is always of the form of repeated {number, color word 1, color word 2, (bag|bags)}. parseChilden can therefore take the first group of 4 words, extract the number and color, save it into the list, and then recursively parse the remainder of the string. The resulting [(Int, String)] will ultimately become the value associated with each key in the map.
parse is the function that parses each line into the entire key-value pair. Thankfully, the input always presents the containing bag color as the first two words of each line, which makes this relatively easy. We also assume that lines with exactly 7 words are for the "leaf nodes" (i.e., the bags that do not contain any other bags), which is apparent from inspection of the input.
Part 1
All right - let's actually do some graph stuff. Part 1 asks us to answer the question of how many different kinds of bags eventually contain a target bag color? This is interesting, as the problem input gives information about which bags a given bag contains, but it does not directly give information about which bags contain a given bag. This problem will be much easier if we do have that information, so our first step is to construct a new graph that does directly contain that information. This essentially comes down to reversing all of the edges in our graph (and in this case, we can drop the number associated with each edge).
insertParents :: String -> [(Int, String)] -> Map.Map String [String] -> Map.Map String [String]
insertParents _ [] m = m
insertParents p ((n,c):ncs) m =
Map.insertWith (++) c [p] (insertParents p ncs m)
parentMap :: Map.Map String [(Int, String)] -> Map.Map String [String]
parentMap containMap = Map.foldrWithKey insertParents Map.empty containMap
getAncestors :: Map.Map String [String] -> String -> Set.Set String
getAncestors m color =
case Map.lookup color m of
Nothing -> Set.empty
Just colors ->
let parents = Set.fromList colors
ancestors = foldr Set.union Set.empty (List.map (getAncestors m) colors)
in Set.union parents ancestors
solve :: Int
solve = Set.size $ (getAncestors $ parentMap $ mapify input) "shiny gold"
main :: IO ()
main = print $ solve
This edge reversal is accomplished with the very nice function foldrWithKey. This function takes each key-value pair stored in the map and performs a fold over it, effectively accumulating child-parent relationships into the reversed map (called parentMap above).
The fold operation, however, was not obvious to me at first. In plain English, we need the operation to be something like "add the parent to the parent list of all children in this key-value pair." This is accomplished by insertWith, which allows us to combine a value to be "inserted" with the existing value in some way. Since our parentMap is a map from child to list-of-parents, we want to use insertWith (++) to append the parent to the list-of-parents that already exists in the map. The nice thing about insertWith is that we don't need to care if the key already exists in the map - if we haven't seen this child yet, insertWith will create a new singleton list for the parents of the child; if we have seen it already, the parent will be appended instead.
Now that we have this map, we can implement the actual traversal. Any bag that can be reached by following edges from a given bag in the parentMap is a bag that will contain it. Of course, our function, getAncestors, is implemented recursively.
In order to get the ancestors of a bag, we first look up the parents, which is exactly what is stored in our parentMap. We then get all ancestors of our parents, and take the set union of everything. Simple as that! Taking the size of the resulting set gives us our answer.
It's worth noting here that, because our graph is not a tree, conceptually, the implementation here is slightly inefficient. If a certain bag is the parent of many different types of bags, it is possible that this traversal will get the ancestors of this bag multiple times. Of course, we can safely do so since we can fold in this set of ancestors multiple times without affecting the accuracy of our result. Perhaps we want to only recurse if the parent has not yet been seen. I'm not sure if the Haskell compiler will emit code that effectively memoizes the calls here, so that it makes no real difference in the end.
One last dose of graph theory before we move on to part 2. Although the parent graph is not a tree, it is a directed acyclic graph (DAG). This is important, because the lack of cycles guarantees that our traversal algorithm will terminate, and we do not need to track which nodes have been visited. Of course, given the flavor of the problem, cycles in this graph would make no sense, as it would result in infinite bags.
Part 2
The problem in part 2 is similar, and it asks us to perform another traversal, this time while using the information regarding the number of bags contained as well. Other than using the numbers, though, this problem is actually easier, as it does not require us to reverse the graph as we did in part 1.
countBags :: Map.Map String [(Int, String)] -> (Int, String) -> Int
countBags m (number,color) =
let Just childCounts = Map.lookup color m
descendantBags = sum (List.map (countBags m) childCounts)
in number * (1 + descendantBags)
solve :: Int
solve = countBags (mapify input) (1, "shiny gold") - 1
main :: IO ()
main = print $ solve
We write another quick recursive traversal in order to count bags. countBags takes the graph and a query of the form (Int,String), returning how many bags are present if you have some number of a given bag color (including the input bag(s)). Again, we can state the recursion quite simply: the total number of bags is equal to the number of bags in this step plus the number of bags contained by all children.
Using countBags to query how many bags are contained in 1 shiny gold bag almost gives us our answer. This includes the shiny gold bag itself, but the problem asks for how many bags are strictly contained, so we subtract off the shiny gold bag to obtain our final answer.
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