16 December 2019 Tagged in: advent of code | haskell

Advent of Code 2019 day 14

Blackboards and binary search

Advent of Code 2019 day 14

Day 14 took a bit of thought about the best way to tackle it, but I eventually took inspiration from blackboard systems. The key data structure was a Map of required production of each chemical. A positive number of required indicates how many molecules still need to be created; a negative number show how much excess of a molecule is around, produced but unused.

Initially, the required map contains just the one element of fuel required. The reaction rules were also stored in a map, keyed by the chemical that was produced by that reaction. Finally, reagents in a reaction were stored as a chemical name and number of molecules.

data Reagent = Reagent { _quantity :: Int, _chemical :: String } deriving (Ord, Eq, Show)
data Reaction = Reaction {_lhs :: S.Set Reagent, _rhs :: Reagent} deriving (Eq, Show)

type Reactions = M.Map String Rule
type Requirement = M.Map String Int

Parsing

The input structure was more complex than just a comma-separated list of numbers, so it showed off the abilities of the parser rather well, I thought.

The parser started by giving some names for parts of the reaction rules.

type Parser = Parsec Void Text

sc :: Parser ()
sc = L.space (skipSome spaceChar) CA.empty CA.empty

lexeme  = L.lexeme sc
integer = lexeme L.decimal
symb = L.symbol sc
arrowP = symb "=>"
commaP = symb ","
identifierP = some alphaNumChar <* sc

Given those, the parser proper is just these four statements:

reactionsP = mkReactions <$> many reactionP
reactionP = Reaction <$> reagentsP <* arrowP <*> reagentP

reagentP = Reagent <$> integer <*> identifierP
reagentsP = S.fromList <$> reagentP `sepBy` commaP

together with the auxiliary function mkReactions, which folds a list of reactions into a map.

mkReactions :: [Reaction] -> Reactions
mkReactions = foldl' addReaction M.empty
    where addReaction base reaction = M.insert (_chemical $ _rhs reaction) reaction base

Part 1

The production plan started by stating the requirement for one fuel. It then proceeds by picking a required chemical (arbitrarily), finding the reaction that produces it, and running that reaction.

"Running" a reaction decreases the required of the reaction's product, and increases the required of the reaction's reagents.

produce :: Reactions -> Requirement -> Requirement
produce reactions required 
    | M.null outstanding = required 
    | otherwise = produce reactions required''
    where outstanding =  M.filter (> 0) $ nonOre required
          (chem, qty) = M.findMin outstanding
          reaction = reactions!chem
          productQty = _quantity $ _rhs reaction
          applications = max 1 (qty `div` productQty)
          qty' = qty - (applications * productQty)
          required' = M.insert chem qty' required
          required'' = S.foldl (addRequrirement applications) required' (_lhs reaction) 

When there's a lot of a chemical that needs producing, the applications value shows how many times the reaction can be run; a reaction must be run at least once if the product is required. (I didn't need to count applications for part 1; just doing a single run of a reaction at a time was sufficient. But I needed it for part 2!)

The nonOre implements the exception that ORE never needs to be produced.

nonOre :: Requirement -> Requirement
nonOre = M.filterWithKey (\c _ -> c /= "ORE")

addRequirement adds all the reagents to the required map, taking account of any existing requirements for that chemical.

addRequrirement :: Int -> Requirement -> Reagent -> Requirement
addRequrirement n requirements reagent = M.insert chem qty' requirements
    where chem = _chemical reagent
          qty = M.findWithDefault 0 chem requirements
          qty' = qty + (n * _quantity reagent) 

The whole thing is triggered by oreForFuel, which calculates the amount of ore required for a particular amount of fuel.

part1 reactions = oreForFuel reactions 1

oreForFuel :: Reactions -> Int -> Int
oreForFuel reactions n = required!"ORE"
    where required0 = M.singleton "FUEL" n
          required = produce reactions required0 

Part 2

This was a binary search of the fuel amount. I guessed a lower limit on the amount of fuel based on the ore requirement for a single unit of fuel. I guessed an upper limit as powers of two times that, picking the first that required more ore than was available.

part2 reactions = searchFuel reactions (upper `div` 2) upper 
    where upper = findUpper reactions (oreLimit `div` base)
          base = oreForFuel reactions 1

findUpper :: Reactions -> Int -> Int
findUpper reactions n = if ore > oreLimit
                    then n
                    else findUpper reactions (n * 2)
    where ore = oreForFuel reactions n 

Given a sensible upper and lower bound, the binary search of the maximal fuel amount could begin. It's a relatively standard search, but with some fiddling around to ensure that it always returns a valid amount of fuel.

searchFuel :: Reactions -> Int -> Int -> Int
searchFuel reactions lower upper 
    | upper == lower = upper
    | otherwise = if ore > oreLimit
                  then searchFuel reactions lower (mid - 1)
                  else searchFuel reactions mid upper
    where mid = (upper + lower + 1) `div` 2
          ore = oreForFuel reactions mid

Code

The code is available (and on Github).