Done day 11

diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal
index d24a7355d30301947d6248c8956387d2d070f133..7b07a89b5c642d02661d7e8db116c6d848e98bc7 100644 (file)
--- a/advent-of-code23.cabal
+++ b/advent-of-code23.cabal
@@ -159,3 +159,8 @@ executable advent10
   import: common-extensions, build-directives
   main-is: advent10/Main.hs
   build-depends: linear, array, split, containers
+
+executable advent11
+  import: common-extensions, build-directives
+  main-is: advent11/Main.hs
+  build-depends: linear, containers

diff --git a/advent11/Main.hs b/advent11/Main.hs
new file mode 100644 (file)
index 0000000..03d3e69
--- /dev/null
+++ b/advent11/Main.hs
@@ -0,0 +1,91 @@
+-- Writeup at https://work.njae.me.uk/2023/12/10/advent-of-code-2023-day-10/
+
+import AoC
+
+import Data.List
+import Data.Maybe
+import Linear (V2(..), (^+^), (^-^))
+import qualified Data.Set as S
+
+type Position = V2 Int -- r, c
+
+type Gals = S.Set Position
+data Galaxies = Galaxies Gals (Position, Position) 
+  deriving (Show)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let galaxies = mkGalaxies text
+      -- print galaxies
+      -- print $ expandGalaxies galaxies 10
+      print $ part1 galaxies
+      print $ part2 galaxies
+
+part1, part2 :: Galaxies -> Int
+part1 galaxies = allDistances gs
+  where (Galaxies gs _) = expandGalaxies galaxies 2
+
+part2 galaxies = allDistances gs
+  where (Galaxies gs _) = expandGalaxies galaxies (10^6)
+
+allDistances :: Gals -> Int
+allDistances gs = case S.minView gs of
+  Nothing -> 0
+  Just (g, gs') -> (S.foldl' (addDist g) 0 gs) + allDistances gs'
+  where addDist g1 acc g2 = acc + distance g1 g2
+
+distance :: Position -> Position -> Int
+distance g1 g2 = abs dr + abs dc
+  where (V2 dr dc) = g1 ^-^ g2
+
+
+expandGalaxies :: Galaxies -> Int -> Galaxies
+expandGalaxies galaxies scale = galaxies''
+  where er = emptyRows galaxies
+        galaxies' = expandRows galaxies er (scale - 1)
+        ec = emptyCols galaxies'
+        galaxies'' = expandCols galaxies' ec (scale - 1)
+
+emptyRows, emptyCols :: Galaxies -> [Int]
+emptyRows (Galaxies gs (V2 r0 _, V2 r1 _)) =
+  [ r | r <- [0..r1] , S.null $ onRow gs r ]
+  where r1 = S.findMax $ S.map (\(V2 r _) -> r) gs
+emptyCols (Galaxies gs (V2 _ c0, V2 _ c1)) =
+  [ c | c <- [0..c1] , S.null $ onCol gs c ]
+  where c1 = S.findMax $ S.map (\(V2 _ c) -> c) gs
+
+onRow, onCol :: Gals -> Int -> Gals
+onRow gs r = S.filter (\(V2 r' _) -> r == r') gs
+onCol gs c = S.filter (\(V2 _ c') -> c == c') gs
+
+expandRows, expandCols :: Galaxies -> [Int] -> Int -> Galaxies
+expandRows (Galaxies gs (V2 r0 c0, V2 r1 c1)) expansions scale =
+  Galaxies gs' (V2 r0 c0, V2 (r1 + nExp) c1)
+  where nExp = length expansions * scale
+        gs' = foldr (shiftRows scale) gs expansions
+expandCols (Galaxies gs (V2 r0 c0, V2 r1 c1)) expansions scale =
+  Galaxies gs' (V2 r0 c0, V2 r1 (c1 + nExp))
+  where nExp = length expansions * scale
+        gs' = foldr (shiftCols scale) gs expansions
+
+shiftRows, shiftCols :: Int -> Int -> Gals -> Gals
+shiftRows scale n gs = S.union small large'
+  where (small, large) = S.partition (\(V2 r _) -> r < n) gs
+        large' = S.map (^+^ (V2 scale 0)) large
+shiftCols scale n gs = S.union small large'
+  where (small, large) = S.partition (\(V2 _ c) -> c < n) gs
+        large' = S.map (^+^ (V2 0 scale)) large
+
+-- reading the map
+
+mkGalaxies :: String -> Galaxies
+mkGalaxies text = 
+  Galaxies (S.fromList [ V2 r c | r <- [0..maxR], c <- [0..maxC]
+                                      , rows !! r !! c == '#'
+                       ])
+           (V2 0 0, V2 maxR maxC)
+  where rows = lines text
+        maxR = length rows - 1
+        maxC = (length $ head rows) - 1