[Haskell-cafe] Re: breadth first search one-liner?

Bertram Felgenhauer bertram.felgenhauer at googlemail.com
Mon Mar 22 08:10:00 EDT 2010


Ross Paterson wrote:
> On Mon, Mar 22, 2010 at 10:30:32AM +0000, Johannes Waldmann wrote:
> > Nice! - Where's the 'nub'?
> 
> A bit longer:
> 
> bfs :: Eq a => (a -> [a]) -> a -> [a]
> bfs f s = concat $ takeWhile (not . null) $ map snd $ iterate step ([], [s])
>   where step (seen, xs) = let seen' = xs++seen in (seen', nub $ [y | x <- xs, y <- f x, notElem y seen'])

Basically the same idea:

    bfs next start =
        let go _  [] = []
            go xs ys = let zs = nub (ys >>= next) \\ xs
                       in  ys ++ go (zs ++ xs) zs
        in  go [start] [start]

A slightly different approach is to add stage markers to the produced
streams, say

    bfs next start =
        let xs = nub $ Left 0 : Right s : (xs >>= next')
            next' (Left n) = [Left (n + 1)]
            next' (Right s) = map Right (next s)
            stop (Left _ : Left _ : _) = []
            stop (Left x : xs) = stop xs
            stop (Right x : xs) = x : stop xs
        in  stop xs

or
    bfs next start = lefts . takeWhile (not . null)
        . unfoldr (Just . span (either (const False) (const True)) . tail)
        $ fix (nub . (Left 0 :) . (Right start :)
              . (>>= either ((:[]) . Left . succ) (map Right . next)))

This has the advantage that nub can be used directly. But it's far from
beautiful.

regards,

Bertram


More information about the Haskell-Cafe mailing list