Solve Day 07 (#12)

* Setup Day 07

* Build parser for part 1

* wip

* Solve part 1

* Fix lint warnings

* Get readme part 2

* Unfold tree in specs

* Solve part 2

* remove unused expandPaths functions

* Move fromRightOrError' to Advent.Utils

* Remove evidence I didn't get this answer right perfectly in one shot :)

AdventOfCode2020.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 3bbb82bd071c7f973c1e32f8180fdaa94c1d1c3dfc81685d4758fecdac132065
+-- hash: 911fb313632a85441d2a53c457eac23f567c9dd6fb277c68ddfe60e7f48a166c
 
 name:           AdventOfCode2020
 version:        2.0.2.0
@@ -36,6 +36,7 @@ library
       Day04.Solution
       Day05.Solution
       Day06.Solution
+      Day07.Solution
       Day08.Solution
       Day08.Utils
       Day09.Solution
@@ -68,6 +69,7 @@ test-suite AdventOfCode2020-test
       Day04.SolutionSpec
       Day05.SolutionSpec
       Day06.SolutionSpec
+      Day07.SolutionSpec
       Day08.SolutionSpec
       Day08.UtilsSpec
       Day09.SolutionSpec

src/Advent/Utils.hs

@@ -21,3 +21,7 @@ combinations n xs =
     | y : xs' <- tails xs,
       ys <- combinations (pred n) xs'
   ]
+
+fromRightOrError' :: Show a => Either a b -> b
+fromRightOrError' (Left x) = error (show x)
+fromRightOrError' (Right x) = x

src/Day07/README.md

@@ -0,0 +1,71 @@
+## Day 7: Handy Haversacks
+
+You land at the regional airport in time for your next flight. In fact, it looks like you'll even have time to grab some food: all flights are currently delayed due to _issues in luggage processing_ .
+
+Due to recent aviation regulations, many rules (your puzzle input) are being enforced about bags and their contents; bags must be color-coded and must contain specific quantities of other color-coded bags. Apparently, nobody responsible for these regulations considered how long they would take to enforce!
+
+For example, consider the following rules:
+
+```
+light red bags contain 1 bright white bag, 2 muted yellow bags.
+dark orange bags contain 3 bright white bags, 4 muted yellow bags.
+bright white bags contain 1 shiny gold bag.
+muted yellow bags contain 2 shiny gold bags, 9 faded blue bags.
+shiny gold bags contain 1 dark olive bag, 2 vibrant plum bags.
+dark olive bags contain 3 faded blue bags, 4 dotted black bags.
+vibrant plum bags contain 5 faded blue bags, 6 dotted black bags.
+faded blue bags contain no other bags.
+dotted black bags contain no other bags.
+```
+
+These rules specify the required contents for 9 bag types. In this example, every `faded blue` bag is empty, every `vibrant plum` bag contains 11 bags (5 `faded blue` and 6 `dotted black` ), and so on.
+
+You have a `_shiny gold_` bag. If you wanted to carry it in at least one other bag, how many different bag colors would be valid for the outermost bag? (In other words: how many colors can, eventually, contain at least one `shiny gold` bag?)
+
+In the above rules, the following options would be available to you:
+
+- A `bright white` bag, which can hold your `shiny gold` bag directly.
+- A `muted yellow` bag, which can hold your `shiny gold` bag directly, plus some other bags.
+- A `dark orange` bag, which can hold `bright white` and `muted yellow` bags, either of which could then hold your `shiny gold` bag.
+- A `light red` bag, which can hold `bright white` and `muted yellow` bags, either of which could then hold your `shiny gold` bag.
+
+So, in this example, the number of bag colors that can eventually contain at least one `shiny gold` bag is `_4_` .
+
+_How many bag colors can eventually contain at least one `shiny gold` bag?_ (The list of rules is quite long; make sure you get all of it.)
+
+## Part Two
+
+It's getting pretty expensive to fly these days - not because of ticket prices, but because of the ridiculous number of bags you need to buy!
+
+Consider again your `shiny gold` bag and the rules from the above example:
+
+- `faded blue` bags contain `0` other bags.
+- `dotted black` bags contain `0` other bags.
+- `vibrant plum` bags contain `11` other bags: 5 `faded blue` bags and 6 `dotted black` bags.
+- `dark olive` bags contain `7` other bags: 3 `faded blue` bags and 4 `dotted black` bags.
+
+So, a single `shiny gold` bag must contain 1 `dark olive` bag (and the 7 bags within it) plus 2 `vibrant plum` bags (and the 11 bags within _each_ of those): `1 + 1*7 + 2 + 2*11` \= `_32_` bags!
+
+Of course, the actual rules have a small chance of going several levels deeper than this example; be sure to count all of the bags, even if the nesting becomes topologically impractical!
+
+Here's another example:
+
+```
+shiny gold bags contain 2 dark red bags.
+dark red bags contain 2 dark orange bags.
+dark orange bags contain 2 dark yellow bags.
+dark yellow bags contain 2 dark green bags.
+dark green bags contain 2 dark blue bags.
+dark blue bags contain 2 dark violet bags.
+dark violet bags contain no other bags.
+```
+
+In this example, a single `shiny gold` bag must contain `_126_` other bags.
+
+_How many individual bags are required inside your single `shiny gold` bag?_
+
+## Link
+
+[https://adventofcode.com/2020/day/7][1]
+
+[1]: https://adventofcode.com/2020/day/7

src/Day07/Solution.hs

@@ -0,0 +1,93 @@
+module Day07.Solution
+  ( Rules,
+    Tree (..),
+    asPath,
+    asTree,
+    countBags,
+    flattenPaths,
+    parseRules,
+    part1,
+    part2,
+    pathsToTarget,
+  )
+where
+
+import Advent.Utils (fromRightOrError', readInt)
+import qualified Data.Map.Strict as Map
+import Text.Parsec
+
+part1 :: String -> String
+part1 = show . pathsToTarget "shiny gold" . fromRightOrError' . parseRules
+
+part2 :: String -> String
+part2 = show . countBags "shiny gold" . asTree . fromRightOrError' . parseRules
+
+type Bag = String
+
+type Rules = Map.Map Bag [(Int, Bag)]
+
+newtype Tree a = Tree [(a, Tree a)] deriving (Show, Eq)
+
+parseRules :: String -> Either ParseError Rules
+parseRules = parse (Map.fromList <$> try ruleParser `sepEndBy1` newline) ""
+
+ruleParser :: Parsec String () (Bag, [(Int, Bag)])
+ruleParser =
+  ((,) <$> (bagParser <* string " bags contain") <*> choice [try containsNoBagsParser, containsBagsParser]) <* char '.'
+
+containsNoBagsParser :: Parsec String () [(Int, Bag)]
+containsNoBagsParser = do
+  _ <- string " no other bags"
+  pure []
+
+containsBagsParser :: Parsec String () [(Int, Bag)]
+containsBagsParser = bagCountParser `sepBy1` char ','
+
+bagCountParser :: Parsec String () (Int, Bag)
+bagCountParser = (,) <$> countParser <*> bagParser'
+  where
+    countParser = space *> (readInt <$> many digit) <* space
+    bagParser' = bagParser <* space <* skipMany1 letter
+
+bagParser :: Parsec String () Bag
+bagParser =
+  manyTill anyChar $
+    try $
+      lookAhead $
+        string " bag"
+
+pathsToTarget :: Bag -> Rules -> Int
+pathsToTarget target = Map.size . Map.filter containsTarget . flattenPaths
+  where
+    containsTarget :: [[(Int, Bag)]] -> Bool
+    containsTarget = any (any (\(_, bag) -> bag == target))
+
+flattenPaths :: Rules -> Map.Map Bag [[(Int, Bag)]]
+flattenPaths = Map.map asPath . asTree
+
+asTree :: Rules -> Map.Map Bag (Tree (Int, Bag))
+asTree rules = Map.mapWithKey (\key _ -> fn key (Tree [])) rules
+  where
+    fn :: Bag -> Tree (Int, Bag) -> Tree (Int, Bag)
+    fn key history = Tree $ map (\kid@(_, nextKey) -> (kid, fn nextKey history)) kids
+      where
+        kids = rules Map.! key
+
+asPath :: Tree a -> [[a]]
+asPath (Tree nodes) = concatMap walkNode nodes
+  where
+    walkNode :: (a, Tree a) -> [[a]]
+    walkNode (a, tree) = go [a] tree
+    go :: [a] -> Tree a -> [[a]]
+    go history (Tree []) = [history]
+    go history (Tree nodes') = concatMap (\(a, tree) -> go (a : history) tree) nodes'
+
+countBags :: Bag -> Map.Map Bag (Tree (Int, Bag)) -> Int
+countBags target = go . (Map.! target)
+  where
+    go :: Tree (Int, Bag) -> Int
+    go (Tree []) = 1
+    go (Tree nodes) = sum $ map (uncurry go') nodes
+    go' :: (Int, b) -> Tree (Int, Bag) -> Int
+    go' node (Tree []) = fst node
+    go' node tree = fst node + fst node * go tree

src/Day08/Solution.hs

@@ -13,11 +13,11 @@ module Day08.Solution
   )
 where
 
-import Advent.Utils (readInt)
+import Advent.Utils (fromRightOrError', readInt)
 import Data.Either (isRight)
 import qualified Data.IntMap.Strict as IntMap
 import qualified Data.IntSet as IntSet
-import Day08.Utils (asIntMap, fromLeftOrError, fromRightOrError')
+import Day08.Utils (asIntMap, fromLeftOrError)
 import Text.Parsec
 
 part1 :: String -> String

src/Day08/Utils.hs

@@ -16,7 +16,3 @@ fromLeftOrError (Left x) = x
 fromRightOrError :: Either a b -> b
 fromRightOrError (Left _) = error "fromRightOrError: Argument takes form 'Left _'"
 fromRightOrError (Right x) = x
-
-fromRightOrError' :: Show a => Either a b -> b
-fromRightOrError' (Left x) = error (show x)
-fromRightOrError' (Right x) = x

test/Advent/UtilsSpec.hs

@@ -1,9 +1,19 @@
 module Advent.UtilsSpec (spec) where
 
-import Advent.Utils (combinations, isBetween, occurrences, readInt, rightToMaybe)
+import Advent.Utils
+  ( combinations,
+    fromRightOrError',
+    isBetween,
+    occurrences,
+    readInt,
+    rightToMaybe,
+  )
+import Control.Exception (evaluate)
 import Data.Foldable (for_)
 import Test.Hspec
 
+type TestType = Either Int Int
+
 spec :: Spec
 spec = parallel $ do
   describe "occurrences" $ do
@@ -41,3 +51,11 @@ spec = parallel $ do
   describe "combinations" $
     it "is the combinations of a list" $ do
       combinations 2 "abcd" `shouldBe` ["ab", "ac", "ad", "bc", "bd", "cd"]
+
+  describe "fromRightOrError'" $ do
+    context "given a Right Value" $ do
+      it "is the Right value" $ do
+        fromRightOrError' (Right 92 :: TestType) `shouldBe` 92
+    context "given a Left Value" $ do
+      it "is throws an exceptions" $ do
+        evaluate (fromRightOrError' (Left 14 :: TestType)) `shouldThrow` anyException