diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal index 32143a7..1c84a91 100644 --- a/advent-of-code-2023.cabal +++ b/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 diff --git a/day21/Commons.hs b/day21/Commons.hs new file mode 100644 index 0000000..afa185d --- /dev/null +++ b/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 diff --git a/day21/Main.hs b/day21/Main.hs new file mode 100644 index 0000000..0674270 --- /dev/null +++ b/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 diff --git a/day21/Part1.hs b/day21/Part1.hs new file mode 100644 index 0000000..591f22c --- /dev/null +++ b/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})] diff --git a/day21/Part2.hs b/day21/Part2.hs new file mode 100644 index 0000000..f044588 --- /dev/null +++ b/day21/Part2.hs @@ -0,0 +1,55 @@ +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)