Advent of Code 2022 day 19

Day 19 was a bit of a beast, with the hard day 16 revealed to be the warm-up! See the day 16 writeup for a description of search.

I have a suspicion that a more planning-inspired approach would work better here, working backwards from the resources needed to build geode-gathering robots. But when all you have is a hammer...

Data and parsing

I defined a bunch of data types to represent the problem description and the search state. I used a Multiset to hold the quantities of resources and robots I had. The TimedBlueprint holds the problem description, with the resources required to build each robot and the maximum numbers of robots it's worth building (see below for how that's used).

data Resource = Ore | Clay | Obsidian | Geode
    deriving (Show, Eq, Ord)

type Collection = MS.MultiSet Resource

type Blueprint = M.Map Resource Collection

data TimedBlueprint = TimedBlueprint { getBlueprint :: Blueprint, getTimeLimit :: Int, getMaxRobots :: Collection}
    deriving (Show, Eq, Ord)

type BlueprintContext = Reader TimedBlueprint

data SingleSearchState = SingleSearchState
    { _resources :: Collection
    , _robots :: Collection
    } deriving (Eq, Show, Ord)
makeLenses ''SingleSearchState

The input was complicated, so parsing was complicated as well. Still, I think the combinator-based approach is easier than using regular expressions or a load of split type instructions.

blueprintsP = blueprintP `sepBy` endOfLine
blueprintP = blueprintify <$> (("Blueprint " *> decimal) <* ": ") <*> (robotP `sepBy` ". ") <* "."
  where blueprintify n robots = 
          (n, M.fromList robots)
robotP = (,) <$> ("Each " *> resourceP) <*> (" robot costs " *> requirementsP)

requirementsP = MS.fromOccurList <$> (requirementP `sepBy` " and ")

requirementP = (flip (,)) <$> (decimal <* " ") <*> resourceP

resourceP = oreP <|> clayP <|> obsidianP <|> geodeP
oreP = Ore <$ "ore"
clayP = Clay <$ "clay"
obsidianP = Obsidian <$ "obsidian"
geodeP = Geode <$ "geode"

successfulParse :: Text -> [(Int, Blueprint)]
successfulParse input = 
  case parseOnly blueprintsP input of
    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
    Right blueprints -> blueprints

Search states

Search follows the standard A* algorithm. There are few successors for each state, but the difficulty lies in that the search has to go through a lot of states before there's any apparent progress towards gathering geodes. I did think about adjusting the reward function to focus search on states with more robots, but just throwing compute at the problem was enough.

The only optimisation I made was one I picked up on Reddit, which is that the "rate-limiting" step is the rate of robot production. That means there is a limit to the number of robots that you need. In the example's blueprint 1, you can consume at most 4 clay each minute so there's no point having more than 4 clay-gathering robots.

successors state = 
do blueprint <- asks getBlueprint
   maxRobots <- asks getMaxRobots
   let buildableRobots = M.keys $ M.filter (\required -> required `MS.isSubsetOf` (state ^. resources)) blueprint
   --- if more bots than needed for making any single bot, don't make more of that bot
   let usefulRobots = MS.foldOccur (\res maxNeeded rs -> 
                                      if (MS.occur res (state ^. robots)) >= maxNeeded 
                                      then Data.List.delete res rs
                                      else rs
                                    ) buildableRobots maxRobots
   let madeRobots = [ state & robots %~ MS.insert robot 
                            & resources %~ ( `MS.difference` (blueprint ! robot) )
                    | robot <- usefulRobots
                    ]
   let afterBuild = [state] ++ madeRobots
   let afterGather = fmap (\s -> s & resources %~ (MS.union (state ^. robots))) afterBuild
   return $ Q.fromList afterGather

This would have worked better and sooner if I hadn't mixed up the order of arguments to MS.difference, meaning that I was throwing away almost all resources every time I built a robot!

Parallelism and strictness

This works, but it takes a long time. It was also clear that processing was limited to a single core. As I was looking at several blueprints independently, it seemed sensible to process them in parallel. This worked for part 2, where there were only three blueprints to examine and I used the parMap function to process them in parallel.

part2 :: [(Int, Blueprint)] -> Int
part2 blueprints = product [MS.occur Geode (r ^. resources) | r <- pResults]
    where results = [ _current $ fromJust $ runReader searchSpace (TimedBlueprint blueprint 32 (robotLimits blueprint))
                    | (_, blueprint) <- (take 3 blueprints) ] :: [SingleSearchState]
          pResults = parMap rdeepseq id results
          robotLimits bp = M.foldl' MS.maxUnion MS.empty bp

I couldn't get this to work for part 1, due to Haskell's laziness. Haskell was keeping the searches as large unevaluated thunks, ready to be resolved once the answer was needed. However, I wanted the parallelism to be strict, and for Haskell to eagerly generate the results of each blueprint's evaluation.

The parallel approach ended up conuming all the RAM on my machine and killing the process. I could have fixed it, but it would have taken too long to dive into what was happening.

Code

You can get the code from my locally-hosted Git repo, or from Gitlab.