module AOC.Challenge.Day14 (
day14a
, day14b
) where
import AOC.Common (clearOut, loopEither)
import AOC.Common.Search (exponentialMinSearch)
import AOC.Solver ((:~>)(..))
import Control.DeepSeq (NFData)
import Data.List.NonEmpty (NonEmpty(..))
import Data.List.Split (chunksOf)
import Data.Map (Map)
import Data.Map.NonEmpty (NEMap)
import GHC.Generics (Generic)
import Text.Read (readMaybe)
import qualified Data.Map as M
import qualified Data.Map.NonEmpty as NEM
type Recipes = Map String (Int, NEMap String Int)
parseRecipeLine :: String -> Maybe Recipes
parseRecipeLine = (agg . reverse =<<)
. traverse parseChunk
. chunksOf 2
. words
. clearOut (`elem` (",=>" :: String))
where
parseChunk [readMaybe->Just x, y] = Just (y, x)
parseChunk _ = Nothing
agg ((x,c):k:ks) = Just $ M.singleton x (c, NEM.fromList (k :| ks))
agg _ = Nothing
data Basket = B { bOre :: Int
, bNeed :: NEMap String Int
, bExcess :: Map String Int
}
deriving (Show, Eq, Ord, Generic)
instance NFData Basket
splitCosts :: NEMap String Int -> (Int, Map String Int)
splitCosts = NEM.alterF (\x -> (sum x,Nothing)) "ORE"
splitBasket :: Recipes -> Basket -> Either (Int, Map String Int) Basket
splitBasket rs B{..} = case need' of
NEM.IsEmpty -> Left (bOre + newOre, newExc)
NEM.IsNonEmpty needNE -> Right $ B
{ bOre = bOre + newOre
, bNeed = needNE
, bExcess = newExc
}
where
((ingr, amt), rest) = NEM.deleteFindMin bNeed
(amt', excess') = case M.lookup ingr bExcess of
Nothing -> (Just amt, bExcess)
Just exc -> case compare amt exc of
GT -> (Just $ amt - exc, M.delete ingr bExcess)
EQ -> (Nothing , M.delete ingr bExcess)
LT -> (Nothing , M.insert ingr (exc - amt) bExcess)
(newOre, need', newExc) = case amt' of
Nothing -> (0, rest, excess')
Just a ->
let (quant, costs) = rs M.! ingr
buyAmt = (a + quant - 1) `div` quant
leftover = (buyAmt * quant) - a
(o, c')
| buyAmt == 0 = (0, M.empty)
| otherwise = splitCosts $ fmap (* buyAmt) costs
exc | leftover == 0 = excess'
| otherwise = M.insertWith (+) ingr leftover excess'
in (o, M.unionWith (+) c' rest, exc)
oreForFuel :: Recipes -> Int -> Int
oreForFuel rs i = fst . loopEither (splitBasket rs) $ B
{ bOre = 0
, bNeed = NEM.singleton "FUEL" i
, bExcess = M.empty
}
day14a :: Recipes :~> Int
day14a = MkSol
{ sParse = foldMap parseRecipeLine . lines
, sShow = show
, sSolve = Just . (`oreForFuel` 1)
}
day14b :: Recipes :~> Int
day14b = MkSol
{ sParse = foldMap parseRecipeLine . lines
, sShow = show
, sSolve = \rs -> subtract 1 <$>
exponentialMinSearch (\fuel -> oreForFuel rs fuel > 1e12) 1
}