Recently I was looking for an A-star search algorithm. I've found a package <div>but I couldn't understand the code. Then I saw some blogposts but they</div><div> were difficult to understand too. I thought about some easier solution that</div>
<div>relies on laziness. And I've come to this:</div><div><br></div><div>Heuristic search is like depth-first search but solutions in sub-trees </div><div>are concatenated with <font class="Apple-style-span" color="#000099">mergeBy</font> function, that concatenates two </div>
<div>list by specific order:</div><div><br></div><div><div>module Search where</div><div><br></div><div>import Control.Applicative</div><div>import Data.Function(on)</div><div>import Control.Arrow(second)</div><div>import Data.Tree</div>
</div><div><br></div><div><div>-- | Heuristic search. Nodes are visited from smaller to greater.</div><div>searchBy :: (a -> a -> Ordering) -> Tree a -> [a]</div><div>searchBy heur (Node v ts) = </div><div> v : foldr (mergeBy heur) [] (searchBy heur <$> ts)</div>
<div><br></div><div>-- | Merge two lists. Elements concatenated in specified order.</div><div>mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]</div><div>mergeBy _ a [] = a</div><div>mergeBy _ [] b = b</div>
<div>mergeBy p (a:as) (b:bs) </div><div> | a `p` b == LT = a : mergeBy p as (b:bs)</div><div> | otherwise = b : mergeBy p bs (a:as)</div></div><div><br></div><div><br></div><div>Now we can define specific heuristic search in terms of <font class="Apple-style-span" color="#000099">searchBy</font>:</div>
<div><br></div><div><div>-- | Heuristic is distance to goal.</div><div>bestFirst :: Ord h => (a -> h) -> (a -> [a]) -> a -> [a]</div><div>bestFirst dist alts = </div><div> searchBy (compare `on` dist) . unfoldTree (\a -> (a, alts a))</div>
<div><br></div><div>-- | A-star search.</div><div>-- Heuristic is estimated length of whole path. </div><div>astar :: (Ord h, Num h) => (a -> h) -> (a -> [(a, h)]) -> a -> [a]</div><div>astar dist alts s0 = fmap fst $ </div>
<div> searchBy (compare `on` astarDist) $ unfoldTree gen (s0, 0)</div><div> where astarDist (a, d) = dist a + d</div><div> gen (a, d) = d `seq` ((a, d), second (+d) <$> alts a)</div></div><div><br></div>
<div>I'm wondering is it effective enough?</div><div><br></div><div><br></div><div>Anton</div>