[Haskell-cafe] lazy A-star search
Anton Kholomiov
anton.kholomiov at gmail.com
Sat Oct 22 14:28:44 CEST 2011
Recently I was looking for an A-star search algorithm. I've found a package
but I couldn't understand the code. Then I saw some blogposts but they
were difficult to understand too. I thought about some easier solution that
relies on laziness. And I've come to this:
Heuristic search is like depth-first search but solutions in sub-trees
are concatenated with mergeBy function, that concatenates two
list by specific order:
module Search where
import Control.Applicative
import Data.Function(on)
import Control.Arrow(second)
import Data.Tree
-- | Heuristic search. Nodes are visited from smaller to greater.
searchBy :: (a -> a -> Ordering) -> Tree a -> [a]
searchBy heur (Node v ts) =
v : foldr (mergeBy heur) [] (searchBy heur <$> ts)
-- | Merge two lists. Elements concatenated in specified order.
mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy _ a [] = a
mergeBy _ [] b = b
mergeBy p (a:as) (b:bs)
| a `p` b == LT = a : mergeBy p as (b:bs)
| otherwise = b : mergeBy p bs (a:as)
Now we can define specific heuristic search in terms of searchBy:
-- | Heuristic is distance to goal.
bestFirst :: Ord h => (a -> h) -> (a -> [a]) -> a -> [a]
bestFirst dist alts =
searchBy (compare `on` dist) . unfoldTree (\a -> (a, alts a))
-- | A-star search.
-- Heuristic is estimated length of whole path.
astar :: (Ord h, Num h) => (a -> h) -> (a -> [(a, h)]) -> a -> [a]
astar dist alts s0 = fmap fst $
searchBy (compare `on` astarDist) $ unfoldTree gen (s0, 0)
where astarDist (a, d) = dist a + d
gen (a, d) = d `seq` ((a, d), second (+d) <$> alts a)
I'm wondering is it effective enough?
Anton
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20111022/79dd1bbe/attachment.htm>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Search.hs
Type: application/octet-stream
Size: 1217 bytes
Desc: not available
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20111022/79dd1bbe/attachment.obj>
More information about the Haskell-Cafe
mailing list