Day 19

Y2022.cabal

@@ -52,6 +52,7 @@ library
         Days.D16
         Days.D17
         Days.D18
+        Days.D19
     build-depends:
         bytestring
       , either
@@ -63,6 +64,7 @@ library
       , monad-loops             ^>=0.4.3
       , mtl
       , parser-combinators
+      , scanf                    ^>=0.1.0.0
       , text
       , vector                  ^>=0.13.0.0
 

app/Main.hs

@@ -26,6 +26,7 @@ paths =
     , "./data/16.in"
     , "./data/17.in"
     , "./data/18.in"
+    , "./data/19.in"
     ]
 
 solutions :: [(Int, Day, FilePath)]

bench/Bench.hs

@@ -25,6 +25,7 @@ paths =
     , "./data/16.in"
     , "./data/17.in"
     , "./data/18.in"
+    , "./data/19.in"
     ]
 
 solutions :: [(Integer, [Day], FilePath)]

data/19.in

@@ -0,0 +1,30 @@
+Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 12 clay. Each geode robot costs 3 ore and 8 obsidian.
+Blueprint 2: Each ore robot costs 2 ore. Each clay robot costs 2 ore. Each obsidian robot costs 2 ore and 15 clay. Each geode robot costs 2 ore and 7 obsidian.
+Blueprint 3: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 18 clay. Each geode robot costs 4 ore and 11 obsidian.
+Blueprint 4: Each ore robot costs 2 ore. Each clay robot costs 2 ore. Each obsidian robot costs 2 ore and 10 clay. Each geode robot costs 2 ore and 11 obsidian.
+Blueprint 5: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 9 clay. Each geode robot costs 2 ore and 9 obsidian.
+Blueprint 6: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 12 clay. Each geode robot costs 2 ore and 10 obsidian.
+Blueprint 7: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 10 clay. Each geode robot costs 2 ore and 7 obsidian.
+Blueprint 8: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 10 clay. Each geode robot costs 3 ore and 14 obsidian.
+Blueprint 9: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 17 clay. Each geode robot costs 3 ore and 8 obsidian.
+Blueprint 10: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 11 clay. Each geode robot costs 2 ore and 8 obsidian.
+Blueprint 11: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 20 clay. Each geode robot costs 2 ore and 19 obsidian.
+Blueprint 12: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 20 clay. Each geode robot costs 2 ore and 12 obsidian.
+Blueprint 13: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 6 clay. Each geode robot costs 2 ore and 20 obsidian.
+Blueprint 14: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 5 clay. Each geode robot costs 3 ore and 18 obsidian.
+Blueprint 15: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 19 clay. Each geode robot costs 4 ore and 7 obsidian.
+Blueprint 16: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 19 clay. Each geode robot costs 4 ore and 11 obsidian.
+Blueprint 17: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 20 clay. Each geode robot costs 2 ore and 16 obsidian.
+Blueprint 18: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 18 clay. Each geode robot costs 3 ore and 8 obsidian.
+Blueprint 19: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 14 clay. Each geode robot costs 3 ore and 17 obsidian.
+Blueprint 20: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 11 clay. Each geode robot costs 3 ore and 14 obsidian.
+Blueprint 21: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 6 clay. Each geode robot costs 2 ore and 16 obsidian.
+Blueprint 22: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 20 clay. Each geode robot costs 3 ore and 14 obsidian.
+Blueprint 23: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 10 clay. Each geode robot costs 2 ore and 14 obsidian.
+Blueprint 24: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 7 clay. Each geode robot costs 4 ore and 13 obsidian.
+Blueprint 25: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 18 clay. Each geode robot costs 4 ore and 12 obsidian.
+Blueprint 26: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 11 clay. Each geode robot costs 4 ore and 12 obsidian.
+Blueprint 27: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 9 clay. Each geode robot costs 4 ore and 16 obsidian.
+Blueprint 28: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 7 clay. Each geode robot costs 2 ore and 7 obsidian.
+Blueprint 29: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 14 clay. Each geode robot costs 4 ore and 19 obsidian.
+Blueprint 30: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 20 clay. Each geode robot costs 2 ore and 15 obsidian.

src/Days/D19.hs

@@ -0,0 +1,203 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Days.D19 where
+
+import Common
+import Data.Char (isDigit)
+import Data.Functor ((<&>))
+import Data.Heap (MaxPrioHeap)
+import Data.Heap qualified as Heap
+import Data.Vector (Vector)
+import Data.Vector qualified as Vector
+import Data.Vector.Unboxed (Unbox)
+import Data.Vector.Unboxed qualified as UnVector
+import Parse
+import Text.Megaparsec (sepEndBy1, takeWhileP)
+
+data Material = Ore | Clay | Obsidian | Geode
+  deriving (Enum, Ord, Eq)
+
+materials :: [Material]
+materials = [Ore, Clay, Obsidian, Geode]
+
+newtype Blueprint = Bp
+  { costs :: Vector (UnVector.Vector Int)
+  }
+  deriving (Show, Eq)
+
+-- e.g. Blueprint 2: Each ore robot costs 2 ore. Each clay robot costs 2 ore. Each obsidian robot costs 2 ore and 15 clay. Each geode robot costs 2 ore and 7 obsidian.
+parser :: Parser [Blueprint]
+parser = someLines blueprint
+  where
+    numbersInLine :: Parser [Int]
+    numbersInLine =
+      takeWhileP (Just "numbersInLine") (not . isDigit)
+        *> sepEndBy1
+          number
+          ( takeWhileP
+              (Just "numbersInLine")
+              (\c -> c /= '\n' && not (isDigit c))
+          )
+    blueprint =
+      numbersInLine
+        <&> ( \case
+                [_, a, b, c, d, e, f] ->
+                  Bp
+                    { costs =
+                        Vector.fromList
+                          [ UnVector.fromList [a, 0, 0, 0],
+                            UnVector.fromList [b, 0, 0, 0],
+                            UnVector.fromList [c, d, 0, 0],
+                            UnVector.fromList [e, 0, f, 0]
+                          ]
+                    }
+                _ -> error "Malformed blueprint specification."
+            )
+
+cost :: Blueprint -> Material -> UnVector.Vector Int
+cost bp material = costs bp Vector.! fromEnum material
+
+data SearchState = SS
+  { resources :: UnVector.Vector Int,
+    robots :: UnVector.Vector Int,
+    time :: Int
+  }
+  deriving (Show)
+
+(@) :: (Unbox a, Enum b) => UnVector.Vector a -> b -> a
+(@) = (. fromEnum) . (UnVector.!)
+
+(<=@) :: (Ord a, Unbox a) => UnVector.Vector a -> UnVector.Vector a -> Bool
+v1 <=@ v2 = UnVector.and $ UnVector.zipWith (<=) v1 v2
+
+(+@) :: (Num a, Unbox a) => UnVector.Vector a -> UnVector.Vector a -> UnVector.Vector a
+(+@) = UnVector.zipWith (+)
+
+simulate :: Int -> Blueprint -> Int
+simulate deadline bp =
+    go 0 $ Heap.singleton (upper initial, initial)
+
+  where
+    initial :: SearchState
+    initial =
+      SS
+        { resources = UnVector.fromList [0, 0, 0, 0],
+          robots = UnVector.fromList [1, 0, 0, 0],
+          time = deadline
+        }
+
+    limits :: UnVector.Vector Int
+    limits =
+      UnVector.fromList
+        [ maximum
+            [ cost bp other @ m
+              | other <- filter (/= m) materials
+            ]
+          | m <- materials
+        ]
+
+    prereq Geode = [Ore, Obsidian]
+    prereq Obsidian = [Ore, Clay]
+    prereq Clay = [Ore]
+    prereq Ore = [Ore]
+
+    purchase :: Material -> UnVector.Vector Int -> UnVector.Vector Int
+    purchase = UnVector.zipWith subtract . cost bp
+
+    addRobot :: Material -> UnVector.Vector Int -> UnVector.Vector Int
+    addRobot m r = r UnVector.// [(fromEnum m, r @ m + 1)]
+
+    build :: SearchState -> Material -> SearchState
+    build SS {..} kind =
+      let materialsNeeded = cost bp kind
+          timeNeededFor material =
+            if (robots @ material == 0)
+              || (resources @ material >= materialsNeeded @ material)
+              then 0
+              else
+                1
+                  + ( (materialsNeeded @ material - resources @ material - 1)
+                        `div` (robots @ material)
+                    )
+          stepsNeeded = 1 + maximum (map timeNeededFor materials)
+          resources' =
+            (+@ resources)
+              . UnVector.map (stepsNeeded *)
+              $ robots
+       in SS
+            { resources = purchase kind resources',
+              robots = addRobot kind robots,
+              time = time - stepsNeeded
+            }
+
+    nexts :: SearchState -> [SearchState]
+    nexts ss@SS {robots} =
+      [ next
+        | m <- materials,
+          m == Geode || robots @ m < limits @ m,
+          and [robots @ p > 0 | p <- prereq m],
+          let next = build ss m,
+          time next > 0
+      ]
+
+    -- upper SS{..} = resources @ Geode + time * robots @ Geode + time * (time - 1)
+    upper :: SearchState -> Int
+    upper ss =
+      ((@ Geode) . resources)
+        . head
+        . dropWhile ((> 0) . time)
+        $ iterate
+          ( \SS {..} ->
+              let newRobots =
+                    UnVector.fromList $
+                      map
+                        ( \m ->
+                            if cost bp m <=@ resources
+                              then 1
+                              else 0
+                        )
+                        materials
+               in SS
+                    { resources = resources +@ robots,
+                      robots = robots +@ newRobots,
+                      time = time - 1
+                    }
+          )
+          ss
+
+    go :: Int -> MaxPrioHeap Int SearchState -> Int
+    go maxFound_ heap_ =
+      case Heap.view heap_ of
+        Nothing -> maxFound_
+        Just ((bestUpper, bestState), heap) ->
+          let maxFound =
+                max
+                  maxFound_
+                  ( (resources bestState @ Geode)
+                      + (time bestState * robots bestState @ Geode)
+                  )
+           in if bestUpper <= maxFound_
+                then maxFound_
+                else
+                  foldl
+                    ( \best next ->
+                        let nextUpper = upper next
+                         in if nextUpper <= best
+                              then best
+                              else go best (Heap.insert (nextUpper, next) heap)
+                    )
+                    maxFound
+                    (nexts bestState)
+
+part1 :: [Blueprint] -> Int
+part1 = sum . zipWith (*) [1 ..] . map (simulate 24)
+
+part2 :: [Blueprint] -> Int
+part2 = product . map (simulate 32) . take 3
+
+day :: Day
+day = parsecDay parser (definitive . part1, definitive . part2)

src/Lib.hs

@@ -30,6 +30,7 @@ import Days.D15 qualified as D15
 import Days.D16 qualified as D16
 import Days.D17 qualified as D17
 import Days.D18 qualified as D18
+import Days.D19 qualified as D19
 
 import Data.ByteString.Char8 qualified as BS
 import Data.Text.IO qualified as T
@@ -60,4 +61,5 @@ days =
     , [D16.day]
     , [D17.day]
     , [D18.day]
+    , [D19.day]
     ]

src/Print.hs

@@ -4,14 +4,14 @@ import Common
 import Text.Printf (printf)
 
 printHeader :: IO ()
-printHeader = putStrLn "[ Day ]------(1)-----+------(2)-----"
+printHeader = putStrLn "[ Day ]------(1)-----+-------(2)------"
 
 printFooter :: IO ()
-printFooter = putStrLn "[-----]--------------+--------------"
+printFooter = putStrLn "[-----]--------------+----------------"
 
 printDR :: Int -> DayResult -> IO ()
 printDR day (Left errorString) = printf "[  %2d ] ====== PARSER ERROR =======\n%s" day errorString
 printDR day (Right (sol1, sol2)) =
     let r1 = maybe "unsolved" show sol1
         r2 = maybe "unsolved" show sol2
-     in printf "[  %2d ] %12s | %12s\n" day r1 r2
+     in printf "[  %2d ] %12s | %14s\n" day r1 r2