Day 21

advent-of-code-2023.cabal

@@ -144,3 +144,11 @@ executable day20
     build-depends:    base ^>=4.15.1.0, containers, MissingH
     hs-source-dirs:   day20
     default-language: Haskell2010
+
+executable day21
+    main-is:            Main.hs
+    other-modules:      Commons Part1 Part2
+    build-depends:      base ^>=4.15.1.0, array
+    hs-source-dirs:     day21
+    default-language:   Haskell2010
+    default-extensions: LambdaCase

day21/Commons.hs

@@ -0,0 +1,49 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.Array (Array, listArray, (!), Ix (inRange), bounds, array, indices, assocs)
+
+
+data Tile = Plot { reachable :: Bool } | Rock deriving (Eq, Show)
+type Garden = Array (Int, Int) Tile
+
+
+parseLine :: String -> [Tile]
+parseLine = map (\case
+                  'S' -> Plot {reachable = False}
+                  '.' -> Plot {reachable = False}
+                  '#' -> Rock)
+
+parseGarden :: IO [[Tile]]
+parseGarden = do done <- isEOF
+                 if done
+                    then return []
+                    else do line <- getLine
+                            let gardenLine = parseLine line
+                            garden <- parseGarden
+                            return (gardenLine: garden)
+
+parse :: IO Garden
+parse = do garden <- parseGarden
+           return $ listArray ((1, 1), (length garden, length $ head garden)) $ concat garden
+
+
+move :: [(Int, Int)] -> Garden -> [((Int, Int), Tile)]
+move [] _ = []
+move ((y, x): t) garden = if garden ! (y, x) == Rock then ((y, x), Rock): move t garden
+                          else let r1 = inRange (bounds garden) (y + 1, x) && (garden ! (y + 1, x) == Plot True)
+                                   r2 = inRange (bounds garden) (y - 1, x) && (garden ! (y - 1, x) == Plot True)
+                                   r3 = inRange (bounds garden) (y, x + 1) && (garden ! (y, x + 1) == Plot True)
+                                   r4 = inRange (bounds garden) (y, x - 1) && (garden ! (y, x - 1) == Plot True)
+                               in ((y, x), Plot {reachable = r1 || r2 || r3 || r4}): move t garden
+
+applyMove :: Garden -> Garden
+applyMove garden = array (bounds garden) $ move (indices garden) garden
+
+applyNMove :: Int -> Garden -> Garden
+applyNMove 0 garden = garden
+applyNMove n garden = applyNMove (n - 1) $ applyMove garden
+
+getReachableAfterNMove :: Int -> Garden -> [((Int, Int), Tile)]
+getReachableAfterNMove n garden = let finalGarden = applyNMove n garden
+                                  in filter (\ (_, t) -> t == Plot True) $ assocs finalGarden

day21/Main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do garden <- parse
+          let part1Res = getReachableAfterNMove 64 $ Part1.setStart garden
+          print $ length part1Res
+          let part2Res = Part2.getReachableAfterN 26501365 garden
+          print part2Res

day21/Part1.hs

@@ -0,0 +1,9 @@
+module Part1 where
+
+import Commons
+import Data.Array (Ix(inRange), bounds, (//), indices, array, assocs)
+
+
+setStart :: Garden -> Garden
+setStart garden = let ((yMin, xMin), (yMax, xMax)) = bounds garden
+                  in garden // [((1 + div (yMax - yMin) 2, 1 + div (xMax - xMin) 2), Plot {reachable = True})]

day21/Part2.hs

@@ -0,0 +1,56 @@
+module Part2 where
+
+import Commons
+import Data.Array (assocs, bounds, (//))
+
+
+getReachableOdd :: Garden -> Int
+getReachableOdd garden =
+  let ((yMin, xMin), (yMax, xMax)) = bounds garden
+      n = (yMax - yMin + div (yMax - yMin) 2)
+      newGarden = garden // [((1 + div (yMax - yMin) 2, 1 + div (xMax - xMin) 2), Plot {reachable = True})]
+  in length $ getReachableAfterNMove n newGarden
+
+getReachableEven :: Garden -> Int
+getReachableEven garden =
+  let ((yMin, xMin), (yMax, xMax)) = bounds garden
+      n = (yMax - yMin + 1 + div (yMax - yMin) 2)
+      newGarden = garden // [((1 + div (yMax - yMin) 2, 1 + div (xMax - xMin) 2), Plot {reachable = True})]
+  in length $ getReachableAfterNMove n newGarden
+
+
+getReachableCardinals :: Garden -> [Int]
+getReachableCardinals garden =
+  let ((yMin, xMin), (yMax, xMax)) = bounds garden
+      n = yMax - yMin
+      (yMean, xMean) = (1 + div (yMax - yMin) 2, 1 + div (xMax - xMin) 2)
+  in [length $ getReachableAfterNMove n $ garden // [((yMean, xMin), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMean, xMax), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMin, xMean), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMax, xMean), Plot {reachable = True})]]
+
+getReachableOddCorners :: Garden -> [Int]
+getReachableOddCorners garden =
+  let ((yMin, xMin), (yMax, xMax)) = bounds garden
+      n = yMax - yMin + div (yMax - yMin) 2
+  in [length $ getReachableAfterNMove n $ garden // [((yMin, xMin), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMin, xMax), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMax, xMin), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMax, xMax), Plot {reachable = True})]]
+
+getReachableEvenCorners :: Garden -> [Int]
+getReachableEvenCorners garden =
+  let ((yMin, xMin), (yMax, xMax)) = bounds garden
+      n = div (yMax - yMin) 2 - 1
+  in [length $ getReachableAfterNMove n $ garden // [((yMin, xMin), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMin, xMax), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMax, xMin), Plot {reachable = True})],
+      length $ getReachableAfterNMove n $ garden // [((yMax, xMax), Plot {reachable = True})]]
+
+getReachableAfterN :: Int -> Garden -> Int
+getReachableAfterN n garden =
+  let ((yMin, xMin), (yMax, xMax)) = bounds garden
+      x = div (n - div (yMax - yMin) 2) (yMax - yMin + 1)
+  in x * x * getReachableEven garden + x * sum (getReachableEvenCorners garden)
+     + (x - 1) * (x - 1) * getReachableOdd garden + (x - 1) * sum (getReachableOddCorners garden)
+     + sum (getReachableCardinals garden)