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
  14 import Data.Ratio
  15 import Data.List
  16 import qualified Data.Map.Strict as M
  17 import Data.Map.Strict ((!))
  18 import qualified Data.Set as S
  19
  20
  21 data Reagent = Reagent { _quantity :: Int, _chemical :: String } deriving (Ord, Eq, Show)
  22 data Rule = Rule {_lhs :: S.Set Reagent, _rhs :: Reagent} deriving (Eq, Show)
  23
  24 type RuleBase = M.Map String Rule
  25 type Requirement = M.Map String Int
  26
  27
  28 main :: IO ()
  29 main = do
  30         text <- TIO.readFile "data/advent14.txt"
  31         let rules = successfulParse text
  32         let ruleBase = mkRuleBase rules
  33         -- print rules
  34         -- print ruleBase
  35         print $ part1 ruleBase
  36         print $ part2 ruleBase
  37
  38 oreLimit = 10^12
  39
  40 mkRuleBase = foldl' addRule M.empty
  41     where addRule base rule = M.insert (_chemical $ _rhs rule) rule base
  42
  43 -- part1 rules = required!"ORE"
  44 --     where required0 = M.singleton "FUEL" 1
  45 --           required = produce rules required0
  46 part1 rules = oreForFuel rules 1
  47
  48 part2 rules = searchFuel rules 1 upper
  49     where upper = findUpper rules (oreLimit `div` base)
  50           base = oreForFuel rules 1
  51
  52
  53 oreForFuel rules n = required!"ORE"
  54     where required0 = M.singleton "FUEL" n
  55           required = produce rules required0
  56
  57 findUpper _ n | trace ("Upper " ++ show n) False = undefined
  58 findUpper rules n = if ore > oreLimit
  59                     then n
  60                     else findUpper rules (n * 2)
  61     where ore = oreForFuel rules n
  62
  63 searchFuel _ lower upper | trace ("Search " ++ show lower ++ " - " ++ show upper) False = undefined
  64 searchFuel rules lower upper
  65     | upper == lower = upper
  66     | otherwise = if ore > oreLimit
  67                   then searchFuel rules lower mid
  68                   else searchFuel rules mid upper
  69     where mid = (upper + lower) `div` 2
  70           ore = oreForFuel rules mid
  71
  72
  73 produce :: RuleBase -> Requirement -> Requirement
  74 produce rules required
  75     | M.null outstanding = required
  76     | otherwise = produce rules required''
  77     where outstanding =  M.filter (> 0) $ nonOre required
  78           (chem, qty) = M.findMin outstanding
  79           rule = rules!chem
  80           qty' = qty - (_quantity $ _rhs rule)
  81           required' = M.insert chem qty' required
  82           required'' = S.foldl addRequrirement required' (_lhs rule)
  83
  84
  85 nonOre :: Requirement -> Requirement
  86 nonOre = M.filterWithKey (\c _ -> c /= "ORE")
  87
  88
  89 addRequrirement :: Requirement -> Reagent -> Requirement
  90 addRequrirement requirements reagent = M.insert chem qty' requirements
  91     where chem = _chemical reagent
  92           qty = M.findWithDefault 0 chem requirements
  93           qty' = qty + (_quantity reagent)
  94
  95
  96 -- Parse the input file
  97 type Parser = Parsec Void Text
  98
  99 sc :: Parser ()
 100 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 101 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
 102
 103 lexeme  = L.lexeme sc
 104 integer = lexeme L.decimal
 105 -- signedInteger = L.signed sc integer
 106 symb = L.symbol sc
 107 arrowP = symb "=>"
 108 commaP = symb ","
 109 identifierP = some alphaNumChar <* sc
 110
 111
 112 rulesP = many ruleP
 113
 114 ruleP = Rule <$> reagentsP <* arrowP <*> reagentP
 115
 116 reagentP = Reagent <$> integer <*> identifierP
 117 reagentsP = S.fromList <$> reagentP `sepBy` commaP
 118
 119 -- successfulParse :: Text -> [Vec]
 120 successfulParse :: Text -> [Rule]
 121 successfulParse input =
 122         case parse rulesP "input" input of
 123                 Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 124                 Right rules -> rules