A* 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!
A* Search is widely used in pathfinding and graph traversal, which is the process of finding a path between multiple points, called "nodes". A* can be used to find optimal paths for any problem with an appropriate heuristic cost-measure.
Basics
- Use
<|>orasum(anything usingAlternative) to branch into multiple possible choices. - Use
estimate myCostto set the value of your 'heuristic' function for the current branch. Do this 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). - Use
spend myCostto add a cost to the branch's CUMULATIVE cost. Do this when some cost has been incurred, e.g. we've moved the state from one node to another. - Every call to
spendorestimatecreates a branch; Branches with LOWER costs will run before those with higher costs. Note that this branching is expensive, so try to consolidate calls to these functions in your actions when possible. - Call
done mySolutionto short circuit ALL running branches and immediately return your result. -
AStarThas 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.
-- Track which moves we've made, up, down, left or right
data Move = U | D | L | R
deriving (Show, Eq)
-- Track our current position, the goal we're moving towards, and the locations we've crossed along the way.
data Context =
Context { _current :: (Int, Int)
, _goal :: (Int, Int)
, _locations :: [(Int, Int)]
}
deriving (Show, Eq)
makeLenses ''Context
-- The Manhattan distance between two points serves as our heuristic estimate.
-- It's *conservative*; it may cost MORE than this, but it won't cost LESS
distanceTo :: (Int, Int) -> (Int, Int) -> Int
distanceTo (x, y) (x', y') = abs (x - x') + abs (y - y')
-- To make things more interesting we'll say that moving through coordinates
-- where either 'x' or 'y' are divisible by the other is 3X more expensive!
addCost :: MonadAStar (Sum Int) r m => (Int, Int) -> m ()
-- Don't divide by zero!
addCost (0, _) = spend 1
addCost (_, 0) = spend 1
addCost (x, y)
| mod x y == 0 || mod y x == 0 = spend 3
addCost _ = spend 1
-- Move around the space looking for the destination point.
mineField :: AStar Context (Sum Int) (Int, Int) ()
mineField = do
-- Get the current position
(x, y) <- use current
-- Add the current location to our list
locations <>= [(x, y)]
-- If we're at the goal we're done!
gl <- use goal
when ((x, y) == gl)
$ done gl
-- Add the cost of the current position
addCost (x, y)
-- Estimate steps to completion
estimate . Sum $ distanceTo gl (x, y)
asum
[ move L >> mineField
, move R >> mineField
, move U >> mineField
, move D >> mineField
]
-- We only care about the ending state, so we use `execAStar`
-- `runAStarT` is the most powerful and runs a monad-transformer version
-- and returns both the state and result type.
run :: Maybe Context
run = execAStar findPoint
Context { _current = (5, 5)
, _goal = (7, 4)
, _moves = []
}
-- Execute it to see if we found a solution;
-- We only care about the state, so we use 'execAStar' it returns the state of the the 'winning' branch.
--
-- We can see from the results that the optimal path with these costs involves a bit of moving around to avoid coordinates which divide each other!
>>> execAStar mineField (context (1, 1) (3, 4))
Just (Context
{ _current = (3, 4)
, _goal = (3, 4)
, _locations =
[(1, 1), (0, 1), (0, 2), (0, 3), (0, 4), (0, 5), (1, 5), (2, 5), (3, 5), (3, 4)]
})
