Day 23: Unstable Diffusion

README.md

@@ -28,3 +28,4 @@ Development occurs in language-specific directories:
 |[Day20.hs](hs/src/Day20.hs)|[Day20.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day20.kt)|[day20.py](py/aoc2022/day20.py)|[day20.rs](rs/src/day20.rs)|
 |[Day21.hs](hs/src/Day21.hs)|[Day21.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day21.kt)|[day21.py](py/aoc2022/day21.py)|[day21.rs](rs/src/day21.rs)|
 |[Day22.hs](hs/src/Day22.hs)|[Day22.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day22.kt)|[day22.py](py/aoc2022/day22.py)|[day22.rs](rs/src/day22.rs)|
+|[Day23.hs](hs/src/Day23.hs)|

hs/aoc2022.cabal

@@ -33,6 +33,7 @@ data-files:
   , day20.txt
   , day21.txt
   , day22.txt
+  , day23.txt
 
 extra-source-files:
     README.md
@@ -62,6 +63,7 @@ library
       , Day20
       , Day21
       , Day22
+      , Day23
     build-depends:
         array ^>=0.5.4.0
       , base ^>=4.16.0.0
@@ -126,6 +128,7 @@ test-suite aoc2022-test
       , Day20Spec
       , Day21Spec
       , Day22Spec
+      , Day23Spec
     hs-source-dirs:   test
     default-language: GHC2021
     build-tool-depends:

hs/app/Main.hs

@@ -24,6 +24,7 @@ import Day19 (day19a, day19b)
 import Day20 (day20a, day20b)
 import Day21 (day21a, day21b)
 import Day22 (day22a, day22b)
+import Day23 (day23a, day23b)
 
 import Control.Monad ((<=<), ap, when)
 import Data.Function (on)
@@ -75,3 +76,4 @@ main = do
     run 20 (either fail print) [day20a, day20b]
     run 21 (either (fail . errorBundlePretty) print) [day21a, day21b]
     run 22 print [day22a, day22b]
+    run 23 print [day23a, day23b]

hs/bench/Main.hs

@@ -27,6 +27,7 @@ import Day19 (day19a, day19b)
 import Day20 (day20a, day20b)
 import Day21 (day21a, day21b)
 import Day22 (day22a, day22b)
+import Day23 (day23a, day23b)
 import Paths_aoc2022 (getDataFileName)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 
@@ -131,4 +132,8 @@ main = defaultMain
       [ bench "part 1" $ nf day22a input
       , bench "part 2" $ nf day22b input
       ]
+  , env (getDayInput 23) $ \input -> bgroup "Day 23"
+      [ bench "part 1" $ nf day23a input
+      , bench "part 2" $ nf day23b input
+      ]
   ]

hs/src/Day23.hs

@@ -0,0 +1,58 @@
+{-|
+Module:         Day23
+Description:    <https://adventofcode.com/2022/day/23 Day 23: Unstable Diffusion>
+-}
+module Day23 (day23a, day23b) where
+
+import Data.List (findIndex, scanl', tails)
+import qualified Data.Map as Map (elems, filter, fromListWith, keysSet)
+import Data.Maybe (fromJust)
+import Data.Semigroup (Max(Max), Min(Min))
+import Data.Set (Set)
+import qualified Data.Set as Set (difference, fromList, member, size, toList, union)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, unpack)
+
+data Direction = N | S | W | E deriving (Bounded, Enum)
+
+dirs :: [[Direction]]
+dirs = take 4 <$> tails (cycle [minBound..maxBound])
+
+sides :: (Enum a, Num a) => Direction -> (a, a) -> [(a, a)]
+sides N (x, y) = [(x', y - 1) | x' <- [x - 1..x + 1]]
+sides S (x, y) = [(x', y + 1) | x' <- [x - 1..x + 1]]
+sides W (x, y) = [(x - 1, y') | y' <- [y - 1..y + 1]]
+sides E (x, y) = [(x + 1, y') | y' <- [y - 1..y + 1]]
+
+move :: (Num a) => Direction -> (a, a) -> (a, a)
+move N (x, y) = (x, y - 1)
+move S (x, y) = (x, y + 1)
+move W (x, y) = (x - 1, y)
+move E (x, y) = (x + 1, y)
+
+neighbors :: (Enum a, Eq a, Num a) => (a, a) -> [(a, a)]
+neighbors (x, y) = [(x', y') | x' <- [x - 1..x + 1] , y' <- [y - 1..y + 1] , x /= x' || y /= y']
+
+step :: (Enum a, Num a, Ord a) => Set (a, a) -> [Direction] -> Set (a, a)
+step state dirs = state `Set.difference`
+    Set.fromList (concat $ Map.elems proposals) `Set.union` Map.keysSet proposals where
+    proposals = Map.filter ((== 1) . length) $ Map.fromListWith (<>)
+      [ (move dir pos, [pos])
+      | pos <- Set.toList state
+      , any (`Set.member` state) $ neighbors pos
+      , dir <- take 1 $ filter (not . any (`Set.member` state) . (`sides` pos)) dirs
+      ]
+
+parse :: Text -> Set (Int, Int)
+parse input = Set.fromList
+    [(x, y) | (y, line) <- zip [0..] $ T.lines input , (x, '#') <- zip [0..] $ T.unpack line]
+
+day23a :: Text -> Int
+day23a input = (maxX - minX + 1) * (maxY - minY + 1) - Set.size state where
+    state = scanl' step (parse input) dirs !! 10
+    (Min minX, Max maxX, Min minY, Max maxY) = mconcat
+        [(Min x, Max x, Min y, Max y) | (x, y) <- Set.toList state]
+
+day23b :: Text -> Int
+day23b input = fromJust (findIndex id . zipWith (==) states $ drop 1 states) + 1 where
+    states = scanl' step (parse input) dirs

hs/test/Day23Spec.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day23Spec (spec) where
+
+import Data.Text (Text)
+import qualified Data.Text as T (unlines)
+import Day23 (day23a, day23b)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example = T.unlines
+  [ "....#.."
+  , "..###.#"
+  , "#...#.#"
+  , ".#...##"
+  , "#.###.."
+  , "##.#.##"
+  , ".#..#.."
+  ]
+
+spec :: Spec
+spec = do
+    describe "part 1" $ do
+        it "examples" $ do
+            day23a example `shouldBe` 110
+    describe "part 2" $ do
+        it "examples" $ do
+            day23b example `shouldBe` 20