advent14/src/advent14.hs

   1 import Debug.Trace
   2
   3 import Data.Text (Text)
   4 import qualified Data.Text.IO as TIO
   5
   6 import Data.Void (Void)
   7
   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
  12
  13 import Data.List
  14 import qualified Data.Map.Strict as M
  15 import Data.Map.Strict ((!))
  16 import qualified Data.Set as S
  17
  18
  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)
  21
  22 type RuleBase = M.Map String Rule
  23 type Requirement = M.Map String Int
  24
  25
  26 main :: IO ()
  27 main = do
  28         text <- TIO.readFile "data/advent14.txt"
  29         -- let rules = successfulParse text
  30         -- let ruleBase = mkRuleBase rules
  31         let ruleBase = successfulParse text
  32         -- print rules
  33         -- print ruleBase
  34         print $ part1 ruleBase
  35         print $ part2 ruleBase
  36
  37 oreLimit :: Int
  38 oreLimit = 10^12
  39
  40 mkRuleBase :: [Rule] -> RuleBase
  41 mkRuleBase = foldl' addRule M.empty
  42     where addRule base rule = M.insert (_chemical $ _rhs rule) rule base
  43
  44
  45 -- part1 rules = required!"ORE"
  46 --     where required0 = M.singleton "FUEL" 1
  47 --           required = produce rules required
  48 part1 rules = oreForFuel rules 1
  49
  50 part2 rules = searchFuel rules (upper `div` 2) upper
  51     where upper = findUpper rules (oreLimit `div` base)
  52           base = oreForFuel rules 1
  53
  54 oreForFuel :: RuleBase -> Int -> Int
  55 oreForFuel rules n = required!"ORE"
  56     where required0 = M.singleton "FUEL" n
  57           required = produce rules required0
  58
  59 findUpper :: RuleBase -> Int -> Int
  60 -- findUpper _ n | trace ("Upper " ++ show n) False = undefined
  61 findUpper rules n = if ore > oreLimit
  62                     then n
  63                     else findUpper rules (n * 2)
  64     where ore = oreForFuel rules n
  65
  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
  75
  76
  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
  83           rule = rules!chem
  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)
  89
  90
  91 nonOre :: Requirement -> Requirement
  92 nonOre = M.filterWithKey (\c _ -> c /= "ORE")
  93
  94
  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)
 100
 101
 102 -- Parse the input file
 103 type Parser = Parsec Void Text
 104
 105 sc :: Parser ()
 106 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 107 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
 108
 109 lexeme  = L.lexeme sc
 110 integer = lexeme L.decimal
 111 -- signedInteger = L.signed sc integer
 112 symb = L.symbol sc
 113 arrowP = symb "=>"
 114 commaP = symb ","
 115 identifierP = some alphaNumChar <* sc
 116
 117 rulesP = mkRuleBase <$> many ruleP
 118
 119 ruleP = Rule <$> reagentsP <* arrowP <*> reagentP
 120
 121 reagentP = Reagent <$> integer <*> identifierP
 122 reagentsP = S.fromList <$> reagentP `sepBy` commaP
 123
 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
 129                 Right rules -> rules