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