{-# Language QuasiQuotes, ImportQualifiedPost #-}
{-|
Module      : Main
Description : Day 14 solution
Copyright   : (c) Eric Mertens, 2019
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2019/day/14>

-}
module Main (main) where

import Advent (format, binSearchLargest)
import Data.List (foldl', sortOn)
import Data.Map (Map)
import Data.Map qualified as Map

data Recipes = Recipes
  { Recipes -> [String]
order :: [String]
  , Recipes -> Map String (Int, [(Int, String)])
parts :: Map String (Int, [(Int, String)])
  }

type Reaction = ([Component], Int, String)
type Component = (Int, String)

-- | >>> :main
-- 751038
-- 2074843
main :: IO ()
IO ()
main =
  do [([(Int, String)], Int, String)]
inp <- [format|2019 14 ((%u %s)&(, ) => %u %s%n)*|]
     let recipes :: Recipes
recipes = [([(Int, String)], Int, String)] -> Recipes
mkRecipes [([(Int, String)], Int, String)]
inp

     Int -> IO ()
forall a. Show a => a -> IO ()
print (Recipes -> Int -> Int
oreNeeded Recipes
recipes Int
1)

     let p :: Int -> Bool
p Int
i = Recipes -> Int -> Int
oreNeeded Recipes
recipes Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1000000000000
     Int -> IO ()
forall a. Show a => a -> IO ()
print ((Int -> Bool) -> Int -> Int
expSearch Int -> Bool
p Int
1)

oreNeeded :: Recipes -> Int {- ^ fuel amount -} -> Int {- ^ ore amount -}
oreNeeded :: Recipes -> Int -> Int
oreNeeded Recipes
recipes Int
n =
  (Map String Int -> String -> Map String Int)
-> Map String Int -> [String] -> Map String Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map String (Int, [(Int, String)])
-> Map String Int -> String -> Map String Int
react (Recipes -> Map String (Int, [(Int, String)])
parts Recipes
recipes)) (String -> Int -> Map String Int
forall k a. k -> a -> Map k a
Map.singleton String
"FUEL" Int
n) (Recipes -> [String]
order Recipes
recipes) Map String Int -> String -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! String
"ORE"

react ::
  Map String (Int, [(Int, String)])    ->
  Map String Int {- ^ items needed  -} ->
  String         {- ^ item to react -} ->
  Map String Int {- ^ items needed  -}
react :: Map String (Int, [(Int, String)])
-> Map String Int -> String -> Map String Int
react Map String (Int, [(Int, String)])
recipes Map String Int
need String
item = (Int -> Int -> Int)
-> Map String Int -> Map String Int -> Map String Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Map String Int
need1 Map String Int
need2
  where
    needed :: Int
needed = Int -> String -> Map String Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 String
item Map String Int
need

    (Int
makes, [(Int, String)]
needs) = Map String (Int, [(Int, String)])
recipes Map String (Int, [(Int, String)])
-> String -> (Int, [(Int, String)])
forall k a. Ord k => Map k a -> k -> a
Map.! String
item
    n :: Int
n = Int
needed Int -> Int -> Int
forall a. Integral a => a -> a -> a
`divUp` Int
makes

    need1 :: Map String Int
need1 = String -> Map String Int -> Map String Int
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete String
item Map String Int
need
    need2 :: Map String Int
need2 = (Int -> Int -> Int) -> [(String, Int)] -> Map String Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [ (String
k,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
v) | (Int
v,String
k) <- [(Int, String)]
needs ]

-- | Integer division that rounds up instead of down.
divUp :: Integral a => a -> a -> a
a
x divUp :: forall a. Integral a => a -> a -> a
`divUp` a
y = (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
y

mkRecipes :: [Reaction] -> Recipes
mkRecipes :: [([(Int, String)], Int, String)] -> Recipes
mkRecipes [([(Int, String)], Int, String)]
xs = Recipes
  { order :: [String]
order = (String -> Int) -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn String -> Int
depth [String
n | ([(Int, String)]
_, Int
_, String
n) <- [([(Int, String)], Int, String)]
xs ]
  , parts :: Map String (Int, [(Int, String)])
parts = Map String (Int, [(Int, String)])
partsMap
  }
  where
    partsMap :: Map String (Int, [(Int, String)])
partsMap       = [(String, (Int, [(Int, String)]))]
-> Map String (Int, [(Int, String)])
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (String
dst, (Int
n, [(Int, String)]
src))  | ([(Int, String)]
src, Int
n, String
dst) <- [([(Int, String)], Int, String)]
xs ]
    toDepth :: (Int, [(Int, String)]) -> Int
toDepth (Int
_,[(Int, String)]
ys) = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
0 [ String -> Int
depth String
y | (Int
_,String
y) <- [(Int, String)]
ys ] Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    depthMap :: Map String Int
depthMap       = ((Int, [(Int, String)]) -> Int)
-> Map String (Int, [(Int, String)]) -> Map String Int
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, [(Int, String)]) -> Int
toDepth Map String (Int, [(Int, String)])
partsMap
    depth :: String -> Int
depth String
x        = Int -> String -> Map String Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Int
0::Int) String
x Map String Int
depthMap

------------------------------------------------------------------------

expSearch ::
  (Int -> Bool) {- ^ predicate        -} ->
  Int           {- ^ small enough     -} ->
  Int           {- ^ largest possible -}
expSearch :: (Int -> Bool) -> Int -> Int
expSearch Int -> Bool
p Int
lo = Int -> Int
go (Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  where
    go :: Int -> Int
go Int
hi
      | Int -> Bool
p Int
hi      = Int -> Int
go (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hi)
      | Bool
otherwise = (Int -> Bool) -> Int -> Int -> Int
binSearchLargest Int -> Bool
p Int
lo Int
hi