Day 18

src/Days/D18.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Days.D18 where
+
+import Common
+import Data.Set (Set)
+import Data.Set qualified as Set
+import Data.Tuple.Extra (uncurry3)
+import Parse
+import Text.Megaparsec.Char (char)
+
+parser :: Parser [(Int, Int, Int)]
+parser = someLines point
+  where
+    point = (,,) <$> int <* char ',' <*> int <* char ',' <*> int
+
+mins :: [(Int, Int, Int)] -> (Int, Int, Int)
+mins =
+  foldr1
+    (\(a', b', c') (a, b, c) -> (min a' a, min b' b, min c' c))
+
+maxs :: [(Int, Int, Int)] -> (Int, Int, Int)
+maxs =
+  foldr1
+    (\(a', b', c') (a, b, c) -> (max a' a, max b' b, max c' c))
+
+adjacent :: (Int, Int, Int) -> [(Int, Int, Int)]
+adjacent (x, y, z) =
+  [ (x - 1, y, z),
+    (x + 1, y, z),
+    (x, y - 1, z),
+    (x, y + 1, z),
+    (x, y, z - 1),
+    (x, y, z + 1)
+  ]
+
+part1 :: [(Int, Int, Int)] -> Int
+part1 l =
+  let s = Set.fromList l
+   in length
+        . filter (\v -> not $ Set.member v s)
+        . concatMap adjacent
+        $ l
+
+part2 :: [(Int, Int, Int)] -> Int
+part2 points =
+  let (x_max, y_max, z_max) = maxs points
+      (x_min, y_min, z_min) = mins points
+      insideSearchSpace (x, y, z) =
+        x_min - 1 <= x
+          && x <= x_max + 1
+          && y_min - 1 <= y
+          && y <= y_max + 1
+          && z_min - 1 <= z
+          && z <= z_max + 1
+
+      start = (x_min - 1, y_min - 1, z_min - 1)
+   in go insideSearchSpace [start] (Set.singleton start) 0
+  where
+    pointSet :: Set (Int, Int, Int)
+    pointSet = Set.fromList points
+
+    go _ [] _ result = result
+    go inside active_ seen_ result_ =
+      uncurry3 (go inside)
+        . foldr
+          ( \p (active, seen, result) ->
+              if Set.member p seen
+                then (active, seen, result)
+                else
+                  if Set.member p pointSet
+                    then (active, seen, result + 1)
+                    else (p : active, Set.insert p seen, result)
+          )
+          ([], seen_, result_)
+        . filter inside
+        . concatMap adjacent
+        $ active_
+
+day :: Day
+day = parsecDay parser (definitive . part1, definitive . part2)