search-algorithms 0.3.1 → 0.3.2

raw patch · 4 files changed

+168/−69 lines, 4 filesdep +criteriondep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: criterion

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +35/−0
• bench/bench.hs +41/−0
• search-algorithms.cabal +12/−1
• src/Algorithm/Search.hs +80/−68

@@ -0,0 +1,35 @@+# Changelog+All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](http://keepachangelog.com/)+and this project adheres to [Semantic Versioning](http://semver.org/).++## [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+  [nagydani](https://github.com/nagydani))++## [0.3.1] - 2010-08-19+- Dependencies version bump++## [0.3.0] - 2017-11-29+### Added+- Monadic versions of search algorithms and helper functions++## [0.2.0] - 2017-05-13+### Changed+- BREAKING CHANGE: Simplified return type of `dijkstra` and `aStar`.+  - This should make these functions more ergonomic.+  - Introduced new `incrementalCosts` function to compensate.+- BREAKING CHANGE: Replaced searches' `prunes` arguments with `pruning` combinator.+- BREAKING CHANGE: Split searches' `next` arguments into multiple arguments for `dijkstra` and `aStar`.+  - This should make these functions more ergonomic.+- `next` arguments now only require a way of generating `Foldable`s, instead of lists specifically.++## 0.1.0 - 2017-03-07+- Initial release++[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+[0.2.0]: https://github.com/devonhollowood/search-algorithms/compare/v0.1.0...v0.2.0

@@ -0,0 +1,41 @@+import Criterion.Main+import Algorithm.Search++type Position = (Int, Int)++wall :: Int -> Position -> Bool+wall height (x, y) = x == 0 && abs y <= height++neighbors :: Position -> [Position]+neighbors (x, y) = [+    (x - 1, y),+    (x, y - 1),+    (x + 1, y),+    (x, y + 1)+  ]++dist :: Position -> Position -> Int+dist (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)++aStarWall :: Int -> Maybe (Int, [Position])+aStarWall height = aStar+    (neighbors `pruning` wall height) -- next+    (\_ _ -> 1) -- cost+    (dist end) -- remaining+    (== end) -- at end+    start -- initial+  where+    start = (-3, 0)+    end = (3, 0)++main :: IO ()+main = defaultMain [+    bgroup "aStar Wall Benchmark" [+      bench "Size 2 wall" $ nf aStarWall 2,+      bench "Size 4 wall" $ nf aStarWall 4,+      bench "Size 8 wall" $ nf aStarWall 8,+      bench "Size 16 wall" $ nf aStarWall 16,+      bench "Size 32 wall" $ nf aStarWall 32,+      bench "Size 64 wall" $ nf aStarWall 64+    ]+  ]

@@ -1,5 +1,5 @@ name:                search-algorithms-version:             0.3.1+version:             0.3.2 synopsis:            Common graph search algorithms description:         Library containing common graph search algorithms,                      including depth-first and breadth-first searches,@@ -13,6 +13,7 @@ category:            Algorithm build-type:          Simple extra-source-files:  README.md+                   , CHANGELOG.md cabal-version:       >=1.10  library@@ -43,6 +44,16 @@                      , search-algorithms                      , containers >= 0.5                      , doctest >= 0.8+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++benchmark search-algorithms-benchmark+  type:                exitcode-stdio-1.0+  hs-source-dirs:      bench+  main-is:             bench.hs+  build-depends:       base+                     , search-algorithms+                     , criterion   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010 

@@ -12,7 +12,9 @@   bfs,   dfs,   dijkstra,+  dijkstraAssoc,   aStar,+  aStarAssoc,   -- * Monadic Searches   -- $monadic   bfsM,@@ -31,6 +33,7 @@ import qualified Data.Set as Set import qualified Data.List as List import qualified Data.Foldable as Foldable+import Data.Functor.Identity (Identity(..)) import Control.Monad (filterM, zipWithM)  -- | @bfs next found initial@ performs a breadth-first search over a set of@@ -127,7 +130,7 @@   => (state -> f state)   -- ^ Function to generate list of neighboring states given the current state   -> (state -> state -> cost)-  -- ^ Function to generate list of costs between neighboring states. This is+  -- ^ Function to generate transition costs between neighboring states. This is   -- only called for adjacent states, so it is safe to have this function be   -- partial for non-neighboring states.   -> (state -> Bool)@@ -139,19 +142,50 @@   -- ^ (Total cost, list of steps) for the first path found which   -- satisfies the given predicate dijkstra next cost found initial =+  -- 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)++-- | @dijkstraAssoc 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 incremenal costs with+-- @next@. 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.+dijkstraAssoc :: (Num cost, Ord cost, Ord state)+  => (state -> [(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+dijkstraAssoc next found initial =+  -- 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 @dijkstra@+  -- back into the desired result from @dijkstraAssoc@   unpack <$>     generalizedSearch emptyLIFOHeap snd leastCostly next' (found . snd)       (0, initial)   where     next' (old_cost, st) =-      (\new_st -> (cost st new_st + old_cost, new_st))-        <$> Foldable.toList (next 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) @@ -178,11 +212,9 @@ -- Just (4,[(1,0),(1,1),(1,2),(0,2)]) aStar :: (Foldable f, Num cost, Ord cost, Ord state)   => (state -> f state)-  -- ^ Function which, when given the current state, produces a list whose-  -- elements are (incremental cost to reach neighboring state,-  -- estimate on remaining cost from said state, said state).+  -- ^ Function to generate list of neighboring states given the current state   -> (state -> state -> cost)-  -- ^ Function to generate list of costs between neighboring states. This is+  -- ^ Function to generate transition costs between neighboring states. This is   -- only called for adjacent states, so it is safe to have this function be   -- partial for non-neighboring states.   -> (state -> cost)@@ -196,20 +228,54 @@   -- ^ (Total cost, list of steps) for the first path found which satisfies the   -- given predicate aStar next cost remaining found initial =+  -- 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)++-- | @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+-- the remaining cost with @remaining@. This returns a path to a state for which+-- @found@ returns 'True'. If @remaining@ is strictly a lower bound on the+-- remaining cost to reach a solved state, then the returned path is the+-- shortest path. Returns 'Nothing' if no path to a solved state is possible.+aStarAssoc :: (Num cost, Ord cost, Ord state)+  => (state -> [(state, cost)])+  -- ^ function to generate list of neighboring states with associated+  -- transition costs given the current state+  -> (state -> cost)+  -- ^ Estimate on remaining cost given a state+  -> (state -> Bool)+  -- ^ Predicate to determine if solution found. 'aStar' 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+aStarAssoc next remaining found initial =+  -- This API to A* search is useful in the common case when next+  -- states and their associated transition costs are generated together.+  --   -- A* 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 (total cost estimate, (cost so far, state)).   -- This implementation makes that transformation, then transforms that result-  -- back into the desired result from @aStar@+  -- 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 <$> Foldable.toList (next old_st)+      update_state <$> (next old_st)       where-        update_state new_st =-          let new_cost = old_cost + cost old_st new_st+        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, [])@@ -447,47 +513,6 @@   paths :: Map.Map stateKey [state]   } ---- | @nextSearchState@ moves from one @searchState@ to the next in the--- generalized search algorithm-nextSearchState ::-  (Foldable f, SearchContainer container, Ord stateKey, Elem container ~ state)-  => ([state] -> [state] -> Bool)-  -> (state -> stateKey)-  -> (state -> f state)-  -> SearchState container stateKey state-  -> Maybe (SearchState container stateKey state)-nextSearchState better mk_key next old = do-  new_state <- mk_search_state <$> pop new_queue-  if mk_key (current new_state) `Set.member` visited old-    then nextSearchState better mk_key next new_state-    else Just new_state-  where-    mk_search_state (new_current, remaining_queue) = SearchState {-      current = new_current,-      queue = remaining_queue,-      visited = Set.insert (mk_key new_current) (visited old),-      paths = new_paths-      }-    new_states = next (current old)-    (new_queue, new_paths) =-      List.foldl' update_queue_paths (queue old, paths old) new_states-    update_queue_paths (old_queue, old_paths) st =-      if mk_key st `Set.member` visited old-      then (old_queue, old_paths)-      else-        case Map.lookup (mk_key st) old_paths of-          Just old_path ->-            if better old_path (st : steps_so_far)-            then (q', ps')-            else (old_queue, old_paths)-          Nothing -> (q', ps')-        where-          steps_so_far = paths old Map.! mk_key (current old)-          q' = push old_queue st-          ps' = Map.insert (mk_key st) (st : steps_so_far) old_paths-- -- | 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@@ -514,13 +539,8 @@   -> 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 =-  let get_steps search_st = paths search_st Map.! mk_key (current search_st)-  in fmap (reverse . get_steps)-     . findIterate (nextSearchState better mk_key next) (found . current)-     $ SearchState initial empty (Set.singleton $ mk_key initial)-       (Map.singleton (mk_key initial) [])-+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@@ -641,14 +661,6 @@       (_, []) -> pop (LIFOHeap $ Map.deleteMin inner)                  -- Logically, this should never happen   push (LIFOHeap inner) (k, a) = LIFOHeap $ Map.insertWith (++) k [a] inner----- | @findIterate found next initial@ takes an initial seed value and applies--- @next@ to it until either @found@ returns True or @next@ returns @Nothing@-findIterate :: (a -> Maybe a) -> (a -> Bool) -> a -> Maybe a-findIterate next found initial-  | found initial = Just initial-  | otherwise = next initial >>= findIterate next found   -- | @findIterateM@ is a monadic version of @findIterate@