3 import Data.Text (Text)
4 import qualified Data.Text.IO as TIO
6 import Data.Void (Void)
8 import Text.Megaparsec hiding (State)
9 import Text.Megaparsec.Char
10 import qualified Text.Megaparsec.Char.Lexer as L
11 import qualified Control.Applicative as CA
14 import qualified Data.Map.Strict as M
15 import Data.Map.Strict ((!))
16 import qualified Data.Set as S
19 data Reagent = Reagent { _quantity :: Int, _chemical :: String } deriving (Ord, Eq, Show)
20 data Rule = Rule {_lhs :: S.Set Reagent, _rhs :: Reagent} deriving (Eq, Show)
22 type RuleBase = M.Map String Rule
23 type Requirement = M.Map String Int
28 text <- TIO.readFile "data/advent14.txt"
29 -- let rules = successfulParse text
30 -- let ruleBase = mkRuleBase rules
31 let ruleBase = successfulParse text
34 print $ part1 ruleBase
35 print $ part2 ruleBase
40 mkRuleBase :: [Rule] -> RuleBase
41 mkRuleBase = foldl' addRule M.empty
42 where addRule base rule = M.insert (_chemical $ _rhs rule) rule base
45 -- part1 rules = required!"ORE"
46 -- where required0 = M.singleton "FUEL" 1
47 -- required = produce rules required
48 part1 rules = oreForFuel rules 1
50 part2 rules = searchFuel rules (upper `div` 2) upper
51 where upper = findUpper rules (oreLimit `div` base)
52 base = oreForFuel rules 1
54 oreForFuel :: RuleBase -> Int -> Int
55 oreForFuel rules n = required!"ORE"
56 where required0 = M.singleton "FUEL" n
57 required = produce rules required0
59 findUpper :: RuleBase -> Int -> Int
60 -- findUpper _ n | trace ("Upper " ++ show n) False = undefined
61 findUpper rules n = if ore > oreLimit
63 else findUpper rules (n * 2)
64 where ore = oreForFuel rules n
66 searchFuel :: RuleBase -> Int -> Int -> Int
67 -- searchFuel _ lower upper | trace ("Search " ++ show lower ++ " - " ++ show upper) False = undefined
68 searchFuel rules lower upper
69 | upper == lower = upper
70 | otherwise = if ore > oreLimit
71 then searchFuel rules lower (mid - 1)
72 else searchFuel rules mid upper
73 where mid = (upper + lower + 1) `div` 2
74 ore = oreForFuel rules mid
77 produce :: RuleBase -> Requirement -> Requirement
78 produce rules required
79 | M.null outstanding = required
80 | otherwise = produce rules required''
81 where outstanding = M.filter (> 0) $ nonOre required
82 (chem, qty) = M.findMin outstanding
84 productQty = _quantity $ _rhs rule
85 applications = max 1 (qty `div` productQty)
86 qty' = qty - (applications * productQty)
87 required' = M.insert chem qty' required
88 required'' = S.foldl (addRequrirement applications) required' (_lhs rule)
91 nonOre :: Requirement -> Requirement
92 nonOre = M.filterWithKey (\c _ -> c /= "ORE")
95 addRequrirement :: Int -> Requirement -> Reagent -> Requirement
96 addRequrirement n requirements reagent = M.insert chem qty' requirements
97 where chem = _chemical reagent
98 qty = M.findWithDefault 0 chem requirements
99 qty' = qty + (n * _quantity reagent)
102 -- Parse the input file
103 type Parser = Parsec Void Text
106 sc = L.space (skipSome spaceChar) CA.empty CA.empty
107 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
110 integer = lexeme L.decimal
111 -- signedInteger = L.signed sc integer
115 identifierP = some alphaNumChar <* sc
117 rulesP = mkRuleBase <$> many ruleP
119 ruleP = Rule <$> reagentsP <* arrowP <*> reagentP
121 reagentP = Reagent <$> integer <*> identifierP
122 reagentsP = S.fromList <$> reagentP `sepBy` commaP
124 -- successfulParse :: Text -> [Vec]
125 successfulParse :: Text -> RuleBase
126 successfulParse input =
127 case parse rulesP "input" input of
128 Left _err -> M.empty -- TIO.putStr $ T.pack $ parseErrorPretty err