Now uses a Reader monad

[advent-of-code-19.git] / advent14 / src / advent14.hs

diff --git a/advent14/src/advent14.hs b/advent14/src/advent14.hs
index c8a14566859529426c3014953b63d630e3aa70a9..4e35ee25605fa687e24bf65f88f219f912862f42 100644 (file)
--- a/advent14/src/advent14.hs
+++ b/advent14/src/advent14.hs
@@ -10,8 +10,6 @@ import Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer as L
 import qualified Control.Applicative as CA
 
-
-import Data.Ratio
 import Data.List
 import qualified Data.Map.Strict as M
 import Data.Map.Strict ((!))
@@ -19,78 +17,77 @@ import qualified Data.Set as S
 
 
 data Reagent = Reagent { _quantity :: Int, _chemical :: String } deriving (Ord, Eq, Show)
-data Rule = Rule {_lhs :: S.Set Reagent, _rhs :: Reagent} deriving (Eq, Show)
+data Reaction = Reaction {_lhs :: S.Set Reagent, _rhs :: Reagent} deriving (Eq, Show)
 
-type RuleBase = M.Map String Rule
+type Reactions = M.Map String Reaction
 type Requirement = M.Map String Int
 
 
 main :: IO ()
 main = do 
         text <- TIO.readFile "data/advent14.txt"
-        let rules = successfulParse text
-        let ruleBase = mkRuleBase rules
-        -- print rules 
-        -- print ruleBase
-        print $ part1 ruleBase
-        print $ part2 ruleBase
+        let reactions = successfulParse text
+        print $ part1 reactions
+        print $ part2 reactions
 
+oreLimit :: Int
 oreLimit = 10^12
 
-mkRuleBase = foldl' addRule M.empty
-    where addRule base rule = M.insert (_chemical $ _rhs rule) rule base
-
--- part1 rules = required!"ORE"
+-- part1 reactions = required!"ORE"
 --     where required0 = M.singleton "FUEL" 1
---           required = produce rules required0
-part1 rules = oreForFuel rules 1
-
-part2 rules = searchFuel rules 1 upper 
-    where upper = findUpper rules (oreLimit `div` base)
-          base = oreForFuel rules 1
+--           required = produce reactions required
+part1 reactions = oreForFuel reactions 1
 
+part2 reactions = searchFuel reactions (upper `div` 2) upper 
+    where upper = findUpper reactions (oreLimit `div` base)
+          base = oreForFuel reactions 1
 
-oreForFuel rules n = required!"ORE"
+oreForFuel :: Reactions -> Int -> Int
+oreForFuel reactions n = required!"ORE"
     where required0 = M.singleton "FUEL" n
-          required = produce rules required0 
+          required = produce reactions required0 
 
-findUpper _ n | trace ("Upper " ++ show n) False = undefined
-findUpper rules n = if ore > oreLimit
+findUpper :: Reactions -> Int -> Int
+-- findUpper _ n | trace ("Upper " ++ show n) False = undefined
+findUpper reactions n = if ore > oreLimit
                     then n
-                    else findUpper rules (n * 2)
-    where ore = oreForFuel rules n 
+                    else findUpper reactions (n * 2)
+    where ore = oreForFuel reactions n 
 
-searchFuel _ lower upper | trace ("Search " ++ show lower ++ " - " ++ show upper) False = undefined
-searchFuel rules lower upper 
+searchFuel :: Reactions -> Int -> Int -> Int
+-- searchFuel _ lower upper | trace ("Search " ++ show lower ++ " - " ++ show upper) False = undefined
+searchFuel reactions lower upper 
     | upper == lower = upper
     | otherwise = if ore > oreLimit
-                  then searchFuel rules lower mid
-                  else searchFuel rules mid upper
-    where mid = (upper + lower) `div` 2
-          ore = oreForFuel rules mid
+                  then searchFuel reactions lower (mid - 1)
+                  else searchFuel reactions mid upper
+    where mid = (upper + lower + 1) `div` 2
+          ore = oreForFuel reactions mid
 
 
-produce :: RuleBase -> Requirement -> Requirement
-produce rules required 
+produce :: Reactions -> Requirement -> Requirement
+produce reactions required 
     | M.null outstanding = required 
-    | otherwise = produce rules required''
+    | otherwise = produce reactions required''
     where outstanding =  M.filter (> 0) $ nonOre required
           (chem, qty) = M.findMin outstanding
-          rule = rules!chem
-          qty' = qty - (_quantity $ _rhs rule)
+          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 required' (_lhs rule)
+          required'' = S.foldl (addRequrirement applications) required' (_lhs reaction) 
 
 
 nonOre :: Requirement -> Requirement
 nonOre = M.filterWithKey (\c _ -> c /= "ORE")
 
 
-addRequrirement :: Requirement -> Reagent -> Requirement
-addRequrirement requirements reagent = M.insert chem qty' requirements
+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 + (_quantity reagent) 
+          qty' = qty + (n * _quantity reagent) 
 
 
 -- Parse the input file
@@ -108,17 +105,20 @@ arrowP = symb "=>"
 commaP = symb ","
 identifierP = some alphaNumChar <* sc
 
+reactionsP = mkReactions <$> many reactionP
 
-rulesP = many ruleP
-
-ruleP = Rule <$> reagentsP <* arrowP <*> reagentP
+reactionP = Reaction <$> reagentsP <* arrowP <*> reagentP
 
 reagentP = Reagent <$> integer <*> identifierP
 reagentsP = S.fromList <$> reagentP `sepBy` commaP
 
+mkReactions :: [Reaction] -> Reactions
+mkReactions = foldl' addReaction M.empty
+    where addReaction base reaction = M.insert (_chemical $ _rhs reaction) reaction base
+
 -- successfulParse :: Text -> [Vec]
-successfulParse :: Text -> [Rule]
+successfulParse :: Text -> Reactions
 successfulParse input = 
-        case parse rulesP "input" input of
-                Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
-                Right rules -> rules
+        case parse reactionsP "input" input of
+                Left  _err -> M.empty -- TIO.putStr $ T.pack $ parseErrorPretty err
+                Right reactions -> reactions