Moving machines again
authorNeil Smith <neil.git@njae.me.uk>
Mon, 16 Dec 2019 15:10:48 +0000 (15:10 +0000)
committerNeil Smith <neil.git@njae.me.uk>
Mon, 16 Dec 2019 15:10:48 +0000 (15:10 +0000)
advent14/package.yaml [new file with mode: 0644]
advent14/src/advent14.hs [new file with mode: 0644]
data/advent14.txt [new file with mode: 0644]
data/advent14b.txt [new file with mode: 0644]
stack.yaml

diff --git a/advent14/package.yaml b/advent14/package.yaml
new file mode 100644 (file)
index 0000000..f6d6c9d
--- /dev/null
@@ -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: <https://github.com/sol/hpack>.
+
+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 (file)
index 0000000..c8a1456
--- /dev/null
@@ -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 (file)
index 0000000..2db01d3
--- /dev/null
@@ -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 (file)
index 0000000..85c4b1e
--- /dev/null
@@ -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
index c95f32e640b92d1307c5b03270424e221b46ed19..9bb13d121192fc92e71c82dbe449aedccd68468f 100644 (file)
@@ -51,6 +51,7 @@ packages:
 - advent11
 - advent12
 - advent13
+- advent14
 
 
 # Dependency packages to be pulled from upstream that are not in the resolver.