Day 21

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