diff --git a/common/src/Advent/Search.hs b/common/src/Advent/Search.hs index 94eb2fe..0792bb0 100644 --- a/common/src/Advent/Search.hs +++ b/common/src/Advent/Search.hs @@ -19,7 +19,10 @@ module Advent.Search ( -- * A* search AStep(..), - astar, astarN, astarOn, astarOnN + astar, astarN, astarOn, astarOnN, + + -- * Reachable exploration + fill, fillN, fillInt, fillNInt, ) where @@ -198,3 +201,37 @@ data AStep a = AStep { astepCost :: !Int, -- ^ cost of edge astepHeuristic :: !Int -- ^ heuristic cost to goal from this new node } deriving Show + +-- | Generate a set of all the values reachable from a starting +-- state and a step function. +fill :: Ord a => (a -> [a]) -> a -> Set.Set a +fill step x = fillN step [x] +{-# INLINE fill #-} + +-- | Generate a set of all the values reachable from a list +-- of starting states and a step function. +fillN :: Ord a => (a -> [a]) -> [a] -> Set.Set a +fillN step = foldl' go Set.empty + where + go seen x + | x `Set.member` seen = seen + | otherwise = foldl' go (Set.insert x seen) (step x) +{-# INLINE fillN #-} + +-- | Generate a set of all the values reachable from a starting +-- state and a step function. Specialized version of 'fill' when +-- working with 'Int'. +fillInt :: (Int -> [Int]) -> Int -> IntSet.IntSet +fillInt step x = fillNInt step [x] +{-# INLINE fillInt #-} + +-- | Generate a set of all the values reachable from a list +-- of starting states and a step function. Specialized version +-- of 'fillN' when working with 'Int'. +fillNInt :: (Int -> [Int]) -> [Int] -> IntSet.IntSet +fillNInt step = foldl' go IntSet.empty + where + go seen x + | x `IntSet.member` seen = seen + | otherwise = foldl' go (IntSet.insert x seen) (step x) +{-# INLINE fillNInt #-} diff --git a/solutions/src/2018/06.hs b/solutions/src/2018/06.hs index 851b7ef..a6eb89e 100644 --- a/solutions/src/2018/06.hs +++ b/solutions/src/2018/06.hs @@ -15,7 +15,7 @@ module Main (main) where import Advent (format, counts) import Advent.Coord (Coord(C), cardinal, coordCol, coordRow, above, below, right, left, manhattan, boundingBox) -import Advent.Search (dfs) +import Advent.Search (fill) import Data.List (groupBy, sort, sortBy) import Data.Function (on) import Data.Ix (range) @@ -78,7 +78,7 @@ part1 input -- is in bounds. Once we're unable to grow the region any further we return its -- size. part2 :: [Coord] -> Int -part2 input = length (dfs step startingPoint) +part2 input = length (fill step startingPoint) where distances :: Coord -> Int distances c = sum (map (manhattan c) input) diff --git a/solutions/src/2022/17.hs b/solutions/src/2022/17.hs index 5c58f4c..142f885 100644 --- a/solutions/src/2022/17.hs +++ b/solutions/src/2022/17.hs @@ -26,7 +26,7 @@ import Data.Set qualified as Set import Advent (format) import Advent.Coord (Coord(C), coordRow, east, west, cardinal, coordCol, south) -import Advent.Search (bfsN) +import Advent.Search (fillN) -- | The set of five blocks -- @@ -123,8 +123,8 @@ clean stuff = Set.filter alive stuff where ymin = coordRow (minimum stuff) step c = [n | n <- cardinal c, 0 <= coordCol n, coordCol n <= 6, coordRow c >= ymin, Set.notMember n stuff] - air = bfsN step [C ymin x | x <- [0..6], Set.notMember (C ymin x) stuff] - alive x = any (`elem` air) (cardinal x) || coordRow x == ymin + air = fillN step [C ymin x | x <- [0..6], Set.notMember (C ymin x) stuff] + alive x = any (`Set.member` air) (cardinal x) || coordRow x == ymin -- | Piece the next piece on the top of the tower returning the updated -- piece index, jet index, and tower contents. The tower is pruned to diff --git a/solutions/src/2022/18.hs b/solutions/src/2022/18.hs index 2bf8712..9489cf4 100644 --- a/solutions/src/2022/18.hs +++ b/solutions/src/2022/18.hs @@ -36,7 +36,7 @@ import Data.Set (Set) import Data.Set qualified as Set import Advent (format) -import Advent.Search (bfs) +import Advent.Search (fill) import Advent.Coord3 (Coord3(..), boundingBox) -- | @@ -53,7 +53,7 @@ main = -- | Given the the location of the lava cubes, find a bounding box of air surrounding them. findAir :: Set Coord3 -> Set Coord3 -findAir cubes = Set.fromList (bfs step (hi + 1)) +findAir cubes = fill step (hi + 1) where (lo, hi) = fromJust (boundingBox cubes) box = (lo - 1, hi + 1) diff --git a/solutions/src/2024/12.hs b/solutions/src/2024/12.hs index 6cb7ec9..3325030 100644 --- a/solutions/src/2024/12.hs +++ b/solutions/src/2024/12.hs @@ -50,7 +50,7 @@ module Main (main) where import Advent (getInputMap, countBy) import Advent.Coord (Coord, cardinal, above, right, below, left) -import Advent.Search (dfs) +import Advent.Search (fill) import Data.List (unfoldr) import Data.Map (Map) import Data.Map qualified as Map @@ -72,7 +72,7 @@ regions :: Map Coord Char -> [Set Coord] regions = unfoldr \input -> [ (region, Map.withoutKeys input region) | (start, label) <- Map.lookupMin input - , let region = Set.fromList (dfs step start) + , let region = fill step start step i = [j | j <- cardinal i, Map.lookup j input == Just label] ]