search-algorithms 0.3.3 → 0.3.4

raw patch · 4 files changed

+145/−71 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• search-algorithms.cabal +1/−1
• src/Algorithm/Search.hs +82/−70
• test/Algorithm/SearchSpec.hs +51/−0

@@ -4,6 +4,15 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/) and this project adheres to [Semantic Versioning](http://semver.org/). +## [0.3.4] - 2025-06-28+- Add `dijkstraAssocCost` and `dijstraAssocCostM`, which make it easier to+  handle path-dependent costs.+- Fix bug in `dijkstraAssocM`, where the prior cost was not propagated to new states.++## [0.3.3] - 2024-11-08+- Add `pruningAssoc` and `pruningAssocM`, which allow for easy pruning of states based on cost.+- Add monadic versions of `dijkstraAssoc` and `astarAssoc`+ ## [0.3.2] - 2021-12-27 - Add two new functions, `dijkstraAssoc` and `aStarAssoc`. These allow for the simultaneous   computation of neighboring states and their costs. (Thank you to@@ -29,6 +38,8 @@ ## 0.1.0 - 2017-03-07 - Initial release +[0.3.4]: https://github.com/devonhollowood/search-algorithms/compare/v0.3.3...v0.3.4+[0.3.3]: https://github.com/devonhollowood/search-algorithms/compare/v0.3.2...v0.3.3 [0.3.2]: https://github.com/devonhollowood/search-algorithms/compare/v0.3.1...v0.3.2 [0.3.1]: https://github.com/devonhollowood/search-algorithms/compare/v0.3.0...v0.3.1 [0.3.0]: https://github.com/devonhollowood/search-algorithms/compare/v0.2.0...v0.3.0

@@ -1,5 +1,5 @@ name:                search-algorithms-version:             0.3.3+version:             0.3.4 synopsis:            Common graph search algorithms description:         Library containing common graph search algorithms,                      including depth-first and breadth-first searches,

@@ -14,6 +14,7 @@   dfs,   dijkstra,   dijkstraAssoc,+  dijkstraAssocCost,   aStar,   aStarAssoc,   -- * Monadic Searches@@ -22,6 +23,7 @@   dfsM,   dijkstraM,   dijkstraAssocM,+  dijkstraAssocCostM,   aStarM,   aStarAssocM,   -- * Utility@@ -40,6 +42,7 @@ import qualified Data.Foldable as Foldable import Data.Functor.Identity (Identity(..)) import Control.Monad (filterM, zipWithM)+import Data.Tuple (swap)  -- | @bfs next found initial@ performs a breadth-first search over a set of -- states, starting with @initial@, and generating neighboring states with@@ -68,10 +71,10 @@   -> Maybe [state]   -- ^ First path found to a state matching the predicate, or 'Nothing' if no   -- such path exists.-bfs =+bfs next found  =   -- BFS is a generalized search using a queue, which directly compares states,   -- and which always uses the first path found to a state-  generalizedSearch Seq.empty id (\_ _ -> False)+  runIdentity . bfsM (Identity . next) (Identity . found)   -- | @dfs next found initial@ performs a depth-first search over a set@@ -100,10 +103,10 @@   -> Maybe [state]   -- ^ First path found to a state matching the predicate, or 'Nothing' if no   -- such path exists.-dfs =+dfs next found =   -- DFS is a generalized search using a stack, which directly compares states,   -- and which always uses the most recent path found to a state-  generalizedSearch [] id (\_ _ -> True)+  runIdentity . dfsM (Identity . next) (Identity . found)   -- | @dijkstra next cost found initial@ performs a shortest-path search over@@ -146,15 +149,12 @@   -> Maybe (cost, [state])   -- ^ (Total cost, list of steps) for the first path found which   -- satisfies the given predicate-dijkstra next cost found initial =+dijkstra next cost found =   -- This API to Dijkstra's algorithm is useful when the state transition   -- function and the cost function are logically separate.   -- It is implemented by using @dijkstraAssoc@ with appropriate mapping of   -- arguments.-  dijkstraAssoc next' found initial-  where-    next' st = map (\new_st -> (new_st, cost st new_st)) $-               Foldable.toList (next st)+  runIdentity . dijkstraM (Identity . next) (identity2 cost) (Identity . found)  -- | @dijkstraAssoc next found initial@ performs a shortest-path search over -- a set of states using Dijkstra's algorithm, starting with @initial@,@@ -174,7 +174,7 @@   -> Maybe (cost, [state])   -- ^ (Total cost, list of steps) for the first path found which   -- satisfies the given predicate-dijkstraAssoc next found initial =+dijkstraAssoc next found =   -- This API to Dijkstra's algoritm is useful in the common case when next   -- states and their associated transition costs are generated together.   --@@ -184,17 +184,41 @@   -- the stored state being (cost so far, state).   -- This implementation makes that transformation, then transforms that result   -- back into the desired result from @dijkstraAssoc@-  unpack <$>-    generalizedSearch emptyLIFOHeap snd leastCostly next' (found . snd)-      (0, initial)-  where-    next' (old_cost, st) =-      (\(new_st, new_cost) -> (new_cost + old_cost, new_st))-        <$> (next st)-    unpack [] = (0, [])-    unpack packed_states = (fst . last $ packed_states, map snd packed_states)+  runIdentity . dijkstraAssocM (Identity . next) (Identity . found) +-- | @dijkstraAssocCost next found initial@ performs a shortest-path search over+-- a set of states using Dijkstra's algorithm, starting with @initial@,+-- generating neighboring states with associated path costs with @next@ (this+-- means that the path of a cost is not the sum of the previous cost and the+-- cost of the current transition, @next@ can do arbitrary computations using+-- those two costs, like a weighted sum or a probability combination). This will+-- find the least-costly path from an initial state to a state for which @found@+-- returns 'True'. Returns 'Nothing' if no path to a solved state is possible.+dijkstraAssocCost :: (Num cost, Ord cost, Ord state)+  => ((state, cost) -> [(state, cost)])+  -- ^ function to generate list of neighboring states with associated+  -- transition costs given the current state+  -> (state -> Bool)+  -- ^ Predicate to determine if solution found. 'dijkstraAssoc' returns the+  -- shortest path to the first state for which this predicate returns 'True'.+  -> state+  -- ^ Initial state+  -> Maybe (cost, [state])+  -- ^ (Total cost, list of steps) for the first path found which+  -- satisfies the given predicate+dijkstraAssocCost next found =+  -- This API to Dijkstra's algoritm is useful in the common case when next+  -- states and their associated transition costs are generated together.+  --+  -- Dijkstra's algorithm can be viewed as a generalized search, with the search+  -- container being a heap, with the states being compared without regard to+  -- cost, with the shorter paths taking precedence over longer ones, and with+  -- the stored state being (cost so far, state).+  -- This implementation makes that transformation, then transforms that result+  -- back into the desired result from @dijkstraAssoc@+  runIdentity . dijkstraAssocCostM (Identity . next) (Identity . found) + -- | @aStar next cost remaining found initial@ performs a best-first search -- using the A* search algorithm, starting with the state @initial@, generating -- neighboring states with @next@, their cost with @cost@, and an estimate of@@ -232,16 +256,14 @@   -> Maybe (cost, [state])   -- ^ (Total cost, list of steps) for the first path found which satisfies the   -- given predicate-aStar next cost remaining found initial =+aStar next cost remaining found =   -- This API to A* search is useful when the state transition   -- function and the cost function are logically separate.   -- It is implemented by using @aStarAssoc@ with appropriate mapping of   -- arguments.-  aStarAssoc next' remaining found initial-  where-    next' st = map (\new_st -> (new_st, cost st new_st)) $-               Foldable.toList (next st)+  runIdentity . aStarM (Identity . next) (identity2 cost) (Identity . remaining) (Identity . found) + -- | @aStarAssoc next remaining found initial@ performs a best-first search -- using the A* search algorithm, starting with the state @initial@, generating -- neighboring states and their associated costs with @next@, and an estimate of@@ -263,7 +285,7 @@   -> Maybe (cost, [state])   -- ^ (Total cost, list of steps) for the first path found which satisfies the   -- given predicate-aStarAssoc next remaining found initial =+aStarAssoc next remaining found =   -- This API to A* search is useful in the common case when next   -- states and their associated transition costs are generated together.   --@@ -273,20 +295,7 @@   -- the stored state being (total cost estimate, (cost so far, state)).   -- This implementation makes that transformation, then transforms that result   -- back into the desired result from @aStarAssoc@-  unpack <$> generalizedSearch emptyLIFOHeap snd2 leastCostly next'-    (found . snd2) (remaining initial, (0, initial))-  where-    next' (_, (old_cost, old_st)) =-      update_state <$> (next old_st)-      where-        update_state (new_st, cost) =-          let new_cost = old_cost + cost-              new_est = new_cost + remaining new_st-          in (new_est, (new_cost, new_st))-    unpack [] = (0, [])-    unpack packed_states =-      (fst . snd . last $ packed_states, map snd2 packed_states)-    snd2 = snd . snd+  runIdentity . aStarAssocM (Identity . next) (Identity . remaining) (Identity . found)  -- $monadic -- Note that for all monadic searches, it is up to the user to ensure that@@ -376,11 +385,35 @@   where     nextM' (old_cost, old_st) = do       new_states <- nextM old_st-      return $ map (\(x, y) -> (y, x)) new_states+      return $ map (update_st old_cost) new_states+    update_st old_cost (new_st, new_cost) = (old_cost + new_cost, new_st)     unpack [] = (0, [])     unpack packed_states = (fst . last $ packed_states, map snd packed_states)  +-- | @dijkstraAssocCostM@ is a monadic version of 'dijkstraAssocCost': it has+-- support for monadic @next@ and @found@ parameters.+dijkstraAssocCostM :: (Monad m, Num cost, Ord cost, Ord state)+  => ((state, cost) -> m [(state, cost)])+  -- ^ Function to generate list of neighboring states with associated+  -- path costs given the current state+  -> (state -> m Bool)+  -- ^ Predicate to determine if solution found. 'dijkstraM' returns the+  -- shortest path to the first state for which this predicate returns 'True'.+  -> state+  -- ^ Initial state+  -> m (Maybe (cost, [state]))+  -- ^ (Total cost, list of steps) for the first path found which+  -- satisfies the given predicate+dijkstraAssocCostM nextM foundM initial =+  fmap2 unpack $ generalizedSearchM emptyLIFOHeap snd leastCostly nextM'+    (foundM . snd) (0, initial)+  where+    nextM' = fmap2 swap . nextM . swap+    unpack [] = (0, [])+    unpack packed_states = (fst . last $ packed_states, map snd packed_states)++ -- | @aStarM@ is a monadic version of 'aStar': it has support for monadic -- @next@, @cost@, @remaining@, and @found@ parameters. aStarM :: (Monad m, Foldable f, Num cost, Ord cost, Ord state)@@ -604,35 +637,6 @@   paths :: Map.Map stateKey [state]   } --- | Workhorse simple search algorithm, generalized over search container--- and path-choosing function. The idea here is that many search algorithms are--- at their core the same, with these details substituted. By writing these--- searches in terms of this function, we reduce the chances of errors sneaking--- into each separate implementation.-generalizedSearch ::-  (Foldable f, SearchContainer container, Ord stateKey, Elem container ~ state)-  => container-  -- ^ Empty @SearchContainer@-  -> (state -> stateKey)-  -- ^ Function to turn a @state@ into a key by which states will be compared-  -- when determining whether a state has be enqueued and / or visited-  -> ([state] -> [state] -> Bool)-  -- ^ Function @better old new@, which when given a choice between an @old@ and-  -- a @new@ path to a state, returns True when @new@ is a "better" path than-  -- old and should thus be inserted-  -> (state -> f state)-  -- ^ Function to generate "next" states given a current state-  -> (state -> Bool)-  -- ^ Predicate to determine if solution found. @generalizedSearch@ returns a-  -- path to the first state for which this predicate returns 'True'.-  -> state-  -- ^ Initial state-  -> Maybe [state]-  -- ^ First path found to a state matching the predicate, or 'Nothing' if no-  -- such path exists.-generalizedSearch empty mk_key better next found initial = runIdentity $-  generalizedSearchM empty mk_key better (Identity . next) (Identity . found) initial- -- | @nextSearchState@ moves from one @searchState@ to the next in the -- generalized search algorithm nextSearchStateM ::@@ -678,7 +682,11 @@           ps' = Map.insert (mk_key st) (st : steps_so_far) old_paths  --- | @generalizedSearchM@ is a monadic version of generalizedSearch+-- | Workhorse simple search algorithm, generalized over search container+-- and path-choosing function. The idea here is that many search algorithms are+-- at their core the same, with these details substituted. By writing these+-- searches in terms of this function, we reduce the chances of errors sneaking+-- into each separate implementation. generalizedSearchM ::   (Monad m, Foldable f, SearchContainer container, Ord stateKey,    Elem container ~ state)@@ -781,3 +789,7 @@ -- | This is just a convenience function which @fmap@s two deep fmap2 :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b) fmap2 = fmap . fmap++-- | This applies Identity to the result of a function of two arguments+identity2 :: (a -> b ->c) -> a -> b -> Identity c+identity2 f a b = Identity $ f a b

@@ -105,6 +105,21 @@         `shouldBe` Nothing     it "handles zero-length solutions" $       dijkstra next cost (== 'd') 'd' `shouldBe` Just (0, [])+  describe "dijkstra with cost" $ do+    let new_cost old_cost (char, step_cost) = (char, old_cost * 10 + step_cost)+        next (char, cost) = map (new_cost cost) (cyclicWeightedGraph Map.! char)+        isChar char1 (char2, _cost) = char1 == char2+    it "performs dijkstra's algorithm" $+      dijkstraAssocCost next (== 'd') 'a'+        `shouldBe` Just (15, ['b', 'd'])+    it "handles pruning" $+      dijkstraAssocCost (next `pruning` isChar 'b') (== 'd') 'a'+        `shouldBe` Just (22, ['c', 'd'])+    it "returns Nothing when no path is possible" $+      dijkstraAssocCost (next `pruning` isChar 'b' `pruning` isChar 'c') (== 'd') 'a'+        `shouldBe` Nothing+    it "handles zero-length solutions" $+      dijkstraAssocCost next (== 'd') 'd' `shouldBe` Just (0, [])   describe "aStar" $ do     let start = (0, 0)         end = (2, 0)@@ -210,6 +225,42 @@       dijkstraM         (taxicabNeighborsBounded `pruningM` (return . isBigWall))         taxicabDistanceBounded+        (const Nothing)+        start+        `shouldBe` Nothing+  describe "dijkstraAssocCostM" $ do+    let start = (0, 0)+        end = (2, 0)+        taxicabNeighborsBounded' (from, cost1) = do+          tos <- taxicabNeighborsBounded from+          cost2s <- mapM (taxicabDistanceBounded from) tos+          pure $ zip tos $ (cost1 +) <$> cost2s+    it "performs monadic dijkstra's algorithm" $+      dijkstraAssocCostM+        taxicabNeighborsBounded'+        (return . (== end))+        start+        `shouldBe` Just (Just (2, [(1, 0), (2, 0)]))+    it "handles cyclic graphs" $ do+      let nextM (char, cost) = return $ fmap (cost +) <$> (cyclicWeightedGraph Map.! char)+          isChar char1 (char2, _cost) = char1 == char2+      dijkstraAssocCostM nextM (return . (== 'd')) 'a'+        `shouldBe` Just (Just (4, ['c', 'd']))+      dijkstraAssocCostM (nextM `pruningM` (return . isChar 'c'))+        (return . (== 'd')) 'a'+        `shouldBe` Just (Just (6, ['b', 'd']))+    it "handles zero-length solutions" $ do+      let nextM (char, cost) = return $ fmap (cost +) <$> (cyclicWeightedGraph Map.! char)+      dijkstraAssocCostM nextM  (return . (== 'd')) 'd'+        `shouldBe` Just (Just (0, []))+    it "correctly handles monadic behavior" $ do+      dijkstraAssocCostM+        (taxicabNeighborsBounded' `pruningM` (return . isBigWall . fst))+        (return . (== end))+        start+        `shouldBe` Nothing+      dijkstraAssocCostM+        (taxicabNeighborsBounded' `pruningM` (return . isBigWall . fst))         (const Nothing)         start         `shouldBe` Nothing