astar-monad 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+73/−9 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +10/−1
• astar-monad.cabal +2/−2
• src/Control/Monad/AStar.hs +14/−2
• src/Control/Monad/AStar/Class.hs +29/−4
• test/Spec.hs +18/−0

@@ -1,6 +1,10 @@ A\* Monad ========= +[Hackage](http://hackage.haskell.org/package/astar-monad)++**Caveat Emptor**; this hasn't been *battle-tested* yet; it should work, but make sure to test it out if you're doing anything serious.+ Easily do A\* searches with use of arbitrary monadic effects!  ## Basics@@ -9,7 +13,7 @@ * Use `updateCost myCost` to set the value of your 'heuristic' function whenever you've done enough work to change your estimate.  Remember that A\* heuristics should always be pessimistic (e.g. can over-estimate cost, but shouldn't UNDER estimate).  * Every call to `updateCost` creates a branch; Branches with LOWER costs will run before those with higher costs. * Call `done mySolution` to short circuit ALL running branches and immediately return your result.-* `AStarT` has a built-in State monad  which **automatically keeps state contiguous in spite of branching**. This means that your state monad will properly switch states when switching branches. Just use state normally, it should work as expected. You can store your current branch's solution-space for instance, or the path you've followed to get to the current solution; or both!+* `AStarT` has a built-in State monad which can store branch-local states for you. You can store your current branch's solution-space for instance, or the path you've followed to get to the current solution; or both!  Here's an example of using A\* to find a path to a location in a 2 dimensional grid. @@ -71,3 +75,8 @@               , _moves   = [U, R, R]               }) ```+++## Known Issues++Currently, computation will **hang** if the end of a branch "finishes" without calling `done` or `failure`; so don't do that.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9b0da561d4a2aab07a5b16f423b1a711563fb04085433460b4f91879142f5f9b+-- hash: dd7ab531bbfc60dd1505d0488c11c684b9259708a61f021be586d938d7d5d5a8  name:           astar-monad-version:        0.1.0.0+version:        0.2.0.0 description:    Please see the README on GitHub at <https://github.com/ChrisPenner/astar-monad#readme> homepage:       https://github.com/ChrisPenner/astar-monad#readme bug-reports:    https://github.com/ChrisPenner/astar-monad/issues

@@ -22,6 +22,8 @@      -- * Methods     , MonadAStar(..)+    , branch+    , failure      -- * Executing Search     , runAStarT@@ -110,6 +112,13 @@         Just (Weighted c, continue) -> do             reflect $ Just (Weighted c, unAStarT $ AStarT continue >>= f) +-- instance (Ord c, Monad m) => MonadLogic (AStarT s c r m) where+--   msplit (AStarT (StateT m)) = AStarT . StateT $ \s -> do+--       msplit (m s) >>= \case+--         (Just ((Weighted w, s), continue)) -> return (Weighted w, s)+--         (Just ((stp, s), continue)) -> return (_, s)+--         Nothing -> return $ (Pure Nothing, s)+ instance (Ord c, Monad m) => Alternative (AStarT s c r m) where   empty = AStarT empty   (<|>) = weightedInterleave@@ -135,7 +144,10 @@           | otherwise ->               (put rState >> pure (Weighted rw))                <|> ((put rState >> rm) `weightedInterleave'` (put lState >> reflect l))-        (l, r) -> (put lState >> reflect l) `weightedInterleave'` (put rState >> reflect r)+        ((Just (Pure la, lm)), r) ->+            (put lState >> pure (Pure la)) `interleave` ((put lState >> lm) `weightedInterleave'` (put rState >> reflect r))+        (l, (Just (Pure ra, rm))) ->+            (put rState >> pure (Pure ra)) `interleave` ((put rState >> rm) `weightedInterleave'` (put lState >> reflect l))  -- | Run an A* computation effect returning the solution and branch state if one was found. runAStarT :: (Monad m) => AStarT s c r m a -> s -> m (Maybe (r, s))@@ -181,12 +193,12 @@                  else return Nothing       Just ((Solved r, s), _) -> return (Just (r, s)) +-- NOTE probably doesn't handle state properly in returned continuation... stepAStar :: (Monad m) => AStarT s c r m a -> s -> m (Maybe ((Step c r a, s), AStarT s c r m a)) stepAStar (AStarT m) s = fmap (fmap go) . observeT . (fmap . fmap . fmap . fmap) fst $ msplit (runStateT m s)   where     go (v, x) = (v, AStarT (lift x))  instance (Ord w, Monad m) => MonadAStar w r (AStarT s w r m) where-  branch = (<|>)   updateCost c = AStarT $ pure (Weighted c) <|> return (Pure ())   done = AStarT . pure . Solved

@@ -1,15 +1,40 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}-module Control.Monad.AStar.Class (MonadAStar(..)) where+module Control.Monad.AStar.Class (MonadAStar(..), branch, failure) where+import Control.Monad+import Control.Applicative  -- | A class which represents the ability to do A* search.-class MonadAStar w r m | m -> r, m -> w where-  -- | Branch the search-  branch :: m a -> m a -> m a+--+-- The laws aren't completely pinned down yet, but these should probably hold:+--+-- > It should short-circuit on 'done'+-- > done a >> mx == done a+-- > done a <|> mx == done a+-- >+-- > It should fail a branch using `empty`.+-- > empty >> mx == empty+-- > empty <|> mx == mx+-- >+-- > It should branch respecting costs using `<|>` from its 'Alternative' instance.+-- > (updateCost 2 >> mx) <|> (updateCost 1 >> my) == mx <|> my +class (MonadPlus m) => MonadAStar w r m | m -> r, m -> w where   -- | Update the cost estimate of the current branch and re-evaluate available branches,   -- switching to a cheaper one when appropriate.   updateCost :: w -> m ()    -- | Return a solution and short-circuit any remaining branches.   done :: r -> m a++-- | Branch the search.+--+-- > branch == (<|>)+branch :: MonadAStar w r m => m a -> m a -> m a+branch = (<|>)++-- | Fail the current branch.+--+-- > branch == empty+failure :: MonadAStar w r m => m a+failure = empty

@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TypeApplications #-} import Control.Monad.AStar import Test.Hspec hiding (Arg) import Data.Foldable@@ -35,6 +36,23 @@         it "should take the shortest path in long situations" $ do             (length . view moves . snd <$> runAStar findPoint (Context (4, 6) (20, 20) []))               `shouldBe` Just 30+        -- it "should properly rewind state" $ do+        --       do flip execAStar [] $ do+        --             asum [ updateCost (1 :: Int) >> modify (++ [1]) >> updateCost 10 >> modify (++ [10])+        --                  , updateCost (2 :: Int) >> modify (++ [2]) >> done ()+        --                  ]+        it "should resolve with Nothing if branches return after updating cost" $ do+              do flip evalAStar () $ (updateCost @Int 1 >> return ()) <|> return ()+            `shouldBe`+              (Nothing :: Maybe ())+        it "should resolve with solution if some branches simply return" $ do+              do flip evalAStar () $ (return () <|> (updateCost @Int 1 >> done ()))+            `shouldBe`+              Just ()+        it "should resolve with solution if all branches simply return" $ do+              do flip evalAStar () $ (return () <|> return () :: AStar () () () ())+            `shouldBe`+              Nothing     describe "tryWhile" $ do         it "should stop if weight gets too high" $ do               -- Use tuple monad to see how far we get