From b66feb593f8623d6ddefb59fc8327d392c3b2bda Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Mon, 16 Dec 2019 15:10:48 +0000 Subject: [PATCH] Moving machines again --- advent14/package.yaml | 60 +++++++++++++++++++ advent14/src/advent14.hs | 124 +++++++++++++++++++++++++++++++++++++++ data/advent14.txt | 58 ++++++++++++++++++ data/advent14b.txt | 7 +++ stack.yaml | 1 + 5 files changed, 250 insertions(+) create mode 100644 advent14/package.yaml create mode 100644 advent14/src/advent14.hs create mode 100644 data/advent14.txt create mode 100644 data/advent14b.txt diff --git a/advent14/package.yaml b/advent14/package.yaml new file mode 100644 index 0000000..f6d6c9d --- /dev/null +++ b/advent14/package.yaml @@ -0,0 +1,60 @@ +# This YAML file describes your package. Stack will automatically generate a +# Cabal file when you run `stack build`. See the hpack website for help with +# this file: . + +name: advent14 +synopsis: Advent of Code +version: '0.0.1' + +default-extensions: +- AllowAmbiguousTypes +- ApplicativeDo +- BangPatterns +- BlockArguments +- DataKinds +- DeriveFoldable +- DeriveFunctor +- DeriveGeneric +- DeriveTraversable +- EmptyCase +- FlexibleContexts +- FlexibleInstances +- FunctionalDependencies +- GADTs +- GeneralizedNewtypeDeriving +- ImplicitParams +- KindSignatures +- LambdaCase +- MonadComprehensions +- MonoLocalBinds +- MultiParamTypeClasses +- MultiWayIf +- NegativeLiterals +- NumDecimals +- OverloadedLists +- OverloadedStrings +- PartialTypeSignatures +- PatternGuards +- PatternSynonyms +- PolyKinds +- RankNTypes +- RecordWildCards +- ScopedTypeVariables +- TemplateHaskell +- TransformListComp +- TupleSections +- TypeApplications +- TypeInType +- TypeOperators +- ViewPatterns + + +executables: + advent14: + main: advent14.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - text + - megaparsec + - containers diff --git a/advent14/src/advent14.hs b/advent14/src/advent14.hs new file mode 100644 index 0000000..c8a1456 --- /dev/null +++ b/advent14/src/advent14.hs @@ -0,0 +1,124 @@ +import Debug.Trace + +import Data.Text (Text) +import qualified Data.Text.IO as TIO + +import Data.Void (Void) + +import Text.Megaparsec hiding (State) +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 ((!)) +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) + +type RuleBase = M.Map String Rule +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 + +oreLimit = 10^12 + +mkRuleBase = foldl' addRule M.empty + where addRule base rule = M.insert (_chemical $ _rhs rule) rule base + +-- part1 rules = 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 + + +oreForFuel rules n = required!"ORE" + where required0 = M.singleton "FUEL" n + required = produce rules required0 + +findUpper _ n | trace ("Upper " ++ show n) False = undefined +findUpper rules n = if ore > oreLimit + then n + else findUpper rules (n * 2) + where ore = oreForFuel rules n + +searchFuel _ lower upper | trace ("Search " ++ show lower ++ " - " ++ show upper) False = undefined +searchFuel rules 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 + + +produce :: RuleBase -> Requirement -> Requirement +produce rules required + | M.null outstanding = required + | otherwise = produce rules required'' + where outstanding = M.filter (> 0) $ nonOre required + (chem, qty) = M.findMin outstanding + rule = rules!chem + qty' = qty - (_quantity $ _rhs rule) + required' = M.insert chem qty' required + required'' = S.foldl addRequrirement required' (_lhs rule) + + +nonOre :: Requirement -> Requirement +nonOre = M.filterWithKey (\c _ -> c /= "ORE") + + +addRequrirement :: Requirement -> Reagent -> Requirement +addRequrirement requirements reagent = M.insert chem qty' requirements + where chem = _chemical reagent + qty = M.findWithDefault 0 chem requirements + qty' = qty + (_quantity reagent) + + +-- Parse the input file +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty +-- sc = L.space (skipSome (char ' ')) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.decimal +-- signedInteger = L.signed sc integer +symb = L.symbol sc +arrowP = symb "=>" +commaP = symb "," +identifierP = some alphaNumChar <* sc + + +rulesP = many ruleP + +ruleP = Rule <$> reagentsP <* arrowP <*> reagentP + +reagentP = Reagent <$> integer <*> identifierP +reagentsP = S.fromList <$> reagentP `sepBy` commaP + +-- successfulParse :: Text -> [Vec] +successfulParse :: Text -> [Rule] +successfulParse input = + case parse rulesP "input" input of + Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right rules -> rules diff --git a/data/advent14.txt b/data/advent14.txt new file mode 100644 index 0000000..2db01d3 --- /dev/null +++ b/data/advent14.txt @@ -0,0 +1,58 @@ +4 JWXL => 8 SNBF +23 MPZQF, 10 TXVW, 8 JWXL => 6 DXLB +1 SNZDR, 5 XMWHC, 1 NJSC => 7 MHSB +2 TDHD, 11 TXVW => 4 RFNZ +2 VRCD, 1 FGZG, 3 JWXL, 1 HQTL, 2 MPZQF, 1 GTPJ, 5 HQNMK, 10 CQZQ => 9 QMTZB +3 SRDB, 2 ZMVLP => 3 DHFD +1 DFQGF => 1 CVXJR +193 ORE => 3 TRWXF +23 MFJMS, 4 HJXJH => 1 WVDF +5 TRWXF => 5 RXFJ +4 GZQH => 7 SNZDR +160 ORE => 4 PLPF +1 PLPF => 5 NJSC +2 QKPZ, 2 JBWFL => 7 HBSC +15 DXLB, 1 TDHD, 9 RFNZ => 5 DBRPW +7 PLPF, 4 GMZH => 7 PVNX +3 JWXL, 1 XWDNT, 4 CQZQ => 2 TPBXV +2 SNZDR => 9 WQWT +1 WMCF => 2 XWDNT +1 DFQGF, 8 FGZG => 5 LMHJQ +168 ORE => 9 GMZH +18 PVNX, 3 RXFJ => 4 JBWFL +5 WQWT => 1 CQZQ +6 QMTZB, 28 NVWM, 8 LMHJQ, 1 SNBF, 15 PLPF, 3 KMXPQ, 43 WVDF, 52 SVNS => 1 FUEL +164 ORE => 9 RXRMQ +2 MFJMS, 1 HJXJH, 7 WVDF => 7 NXWC +8 QDGBV, 1 WMCF, 2 MHSB => 6 HQTL +1 XMWHC => 8 MLSK +2 GMZH, 1 RXRMQ => 2 GZQH +4 MPZQF, 7 WVDF => 9 KHJMV +4 ZMVLP, 19 MLSK, 1 GZQH => 8 MFJMS +1 HQTL, 1 SXKQ => 2 PWBKR +3 SXKQ, 16 TXVW, 4 SVNS => 5 PSRF +4 MPZQF, 3 SVNS => 9 QDGBV +7 NXWC => 8 FGZG +7 TDHD, 1 WQWT, 1 HBSC => 9 TXVW +14 JBWFL => 5 LMXB +1 VRCD, 3 KHJMV => 3 RTBL +16 DHFD, 2 LBNK => 9 SXKQ +1 QDGBV, 1 NJSC => 6 JWXL +4 KHJMV => 3 HQNMK +5 GZQH => 6 LBNK +12 KHJMV, 19 FGZG, 3 XWDNT => 4 VRCD +5 DHFD, 3 MLSK => 8 QKPZ +4 KHJMV, 1 CQDR, 3 DBRPW, 2 CQZQ, 1 TPBXV, 15 TXVW, 2 TKSLM => 5 NVWM +2 KHJMV => 5 CQDR +1 CVXJR => 8 SVNS +35 RXFJ, 5 NJSC, 22 PVNX => 9 HJXJH +5 LMXB => 3 DFQGF +1 RXFJ => 2 SRDB +20 TPBXV, 1 RTBL, 13 PWBKR, 6 RFNZ, 1 LMXB, 2 CVXJR, 3 PSRF, 25 MPZQF => 9 KMXPQ +1 MHSB, 8 MPZQF => 3 TDHD +6 DHFD, 3 LBNK => 7 WMCF +1 SRDB => 7 ZMVLP +3 RXFJ => 8 XMWHC +1 MPZQF => 8 TKSLM +9 JBWFL, 22 WQWT => 8 MPZQF +12 HBSC, 15 TKSLM => 1 GTPJ diff --git a/data/advent14b.txt b/data/advent14b.txt new file mode 100644 index 0000000..85c4b1e --- /dev/null +++ b/data/advent14b.txt @@ -0,0 +1,7 @@ +9 ORE => 2 A +8 ORE => 3 B +7 ORE => 5 C +3 A, 4 B => 1 AB +5 B, 7 C => 1 BC +4 C, 1 A => 1 CA +2 AB, 3 BC, 4 CA => 1 FUEL diff --git a/stack.yaml b/stack.yaml index c95f32e..9bb13d1 100644 --- a/stack.yaml +++ b/stack.yaml @@ -51,6 +51,7 @@ packages: - advent11 - advent12 - advent13 +- advent14 # Dependency packages to be pulled from upstream that are not in the resolver. -- 2.34.1