Day 11: Cosmic Expansion

ephemient · Dec 11, 2023 · d61c55f · d61c55f
1 parent cdd0b5f
commit d61c55f
Show file tree

Hide file tree

Showing 6 changed files with 66 additions and 2 deletions.
diff --git a/README.md b/README.md
@@ -15,3 +15,4 @@ Development occurs in language-specific directories:
 |[Day8.hs](hs/src/Day8.hs)|[Day8.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day8.kt)|[day8.py](py/aoc2023/day8.py)|[day8.rs](rs/src/day8.rs)|
 |[Day9.hs](hs/src/Day9.hs)|[Day9.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day9.kt)|[day9.py](py/aoc2023/day9.py)|[day9.rs](rs/src/day9.rs)|
 |[Day10.hs](hs/src/Day10.hs)|[Day10.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day10.kt)|[day10.py](py/aoc2023/day10.py)|[day10.rs](rs/src/day10.rs)|
+|[Day11.hs](hs/src/Day11.hs)||||
diff --git a/hs/aoc2023.cabal b/hs/aoc2023.cabal
@@ -30,7 +30,8 @@ library
         Day7,
         Day8,
         Day9,
-        Day10
+        Day10,
+        Day11
 
     -- Modules included in this library but not exported.
     other-modules:
@@ -86,7 +87,8 @@ test-suite aoc2023-test
         Day7Spec,
         Day8Spec,
         Day9Spec,
-        Day10Spec
+        Day10Spec,
+        Day11Spec
     build-depends:
         aoc2023,
         base ^>=4.17.2.0,

diff --git a/hs/app/Main.hs b/hs/app/Main.hs
@@ -11,6 +11,7 @@ import qualified Day7 (part1, part2)
 import qualified Day8 (part1, part2)
 import qualified Day9 (part1, part2)
 import qualified Day10 (solve)
+import qualified Day11 (solve)
 
 import Control.Monad (ap, when)
 import Data.Foldable (find)
@@ -51,3 +52,4 @@ main = do
     run 8 (either (fail . errorBundlePretty) print) [Day8.part1, Day8.part2]
     run 9 (either fail print) [Day9.part1, Day9.part2]
     run 10 (maybe (fail "error") $ uncurry ((>>) `on` print)) [Day10.solve]
+    run 11 print [Day11.solve 2, Day11.solve 1000000]
diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs
@@ -16,6 +16,7 @@ import qualified Day7 (part1, part2)
 import qualified Day8 (part1, part2)
 import qualified Day9 (part1, part2)
 import qualified Day10 (solve)
+import qualified Day11 (solve)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -73,4 +74,8 @@ main = defaultMain
           [ bench "part 1" $ nf (fmap fst . Day10.solve) input
           , bench "part 2" $ nf (fmap snd . Day10.solve) input
       ]
+  , env (getDayInput 11) $ \input -> bgroup "Day 11"
+      [ bench "part 1" $ nf (Day11.solve 2) input
+      , bench "part 2" $ nf (Day11.solve 1000000) input
+      ]
   ]
diff --git a/hs/src/Day11.hs b/hs/src/Day11.hs
@@ -0,0 +1,23 @@
+{-|
+Module:         Day11
+Description:    <https://adventofcode.com/2023/day/11 Day 11: Cosmic Expansion>
+-}
+module Day11 (solve) where
+
+import qualified Data.IntSet as IntSet (dropWhileAntitone, fromDistinctAscList, size, takeWhileAntitone)
+import Data.List (tails, transpose)
+import Data.Text (Text)
+import qualified Data.Text as T (unpack)
+
+solve :: Int -> Text -> Int
+solve n input = sum
+  [ y1 - y0 + abs (x1 - x0) + (n - 1) * (IntSet.size ys + IntSet.size xs)
+  | (i, (y0, x0):points') <- zip [1..] $ tails points
+  , (j, (y1, x1)) <- zip [i + 1..] points'
+  , let ys = IntSet.takeWhileAntitone (< y1) $ IntSet.dropWhileAntitone (< y0) rows
+        xs = IntSet.takeWhileAntitone (< max x0 x1) $ IntSet.dropWhileAntitone (< min x0 x1) cols
+  ] where
+    image = lines $ T.unpack input
+    rows = IntSet.fromDistinctAscList [y | (y, row) <- zip [0..] image, '#' `notElem` row]
+    cols = IntSet.fromDistinctAscList [x | (x, col) <- zip [0..] $ transpose image, '#' `notElem` col]
+    points = [(y, x) | (y, row) <- zip [0..] image, (x, '#') <- zip [0..] row]
diff --git a/hs/test/Day11Spec.hs b/hs/test/Day11Spec.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day11Spec (spec) where
+
+import Data.Text (Text)
+import qualified Data.Text as T (unlines)
+import Day11 (solve)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example = T.unlines
+  [ "...#......"
+  , ".......#.."
+  , "#........."
+  , ".........."
+  , "......#..."
+  , ".#........"
+  , ".........#"
+  , ".........."
+  , ".......#.."
+  , "#...#....."
+  ]
+
+spec :: Spec
+spec = do
+    describe "part 1" $ do
+        it "examples" $ do
+            solve 2 example `shouldBe` 374
+    describe "part 2" $ do
+        it "examples" $ do
+            solve 10 example `shouldBe` 1030
+            solve 100 example `shouldBe` 8410