Breadth First Traversal in Haskell

Question

I need to find all the paths in a tree-like structure.

I recently defined Deep First traversal (or iterate) as follows:

dfIterate:: (a -> [a]) -> a -> [[a]]
dfIterate f a = map (a:) ([] : concatMap (dfIterate f) (f a))

It takes a seed a and a function a -> [a] (from each "a", you can get to multiple a's). The result is a list of paths starting from the seed. It works well:

ghci> let f a = if a == 1 then [2, 3] else if a == 2 then [4] else []
ghci> dfIterate f 1
[[1],[1,2],[1,2,4],[1,3]]

My function dfIterate iterates correctly and shows me all the paths. The function f simulates the tree above.

But how to make a "Breadth First Traversal"? The result in this case should be: [[1],[1,2],[1,3],[1,2,4]]. My first attempt:

bfIterate :: (a -> [a]) -> [a] -> [[a]]
bfIterate _ [] = [[]]
bfIterate f (a:as) = map (a:) (bfIterate f (as ++ (f a)))

I tried to use the second argument as a queue. I know I'm quite far from the result... Thanks

EDIT: This link gives interesting lines of approach: Breadth-First Search using State monad in Haskell. However, my question is about finding all paths (i.e. [[a]]), while that question is for finding single solutions (i.e. [a])

Answer 1

Correctness first, efficiency later.

bfPaths :: (a -> [a]) -> a -> [[a]]
bfPaths step seed  =  go [ (seed, [seed]) ]
 where
 go []  =  []
 go ((s, path) : q) = path :
   go (q ++ [ (x, path ++ [x]) | x <- step s ])

indeed maintaining a queue and adding the nodes to it, level by level.

go's argument is a list, used as a "first in first out" queue. It contains pairs of (node_value, that_node's_path). The initial node value is seed, and its path is thus [seed].

At each step, the queue is deconstructed into it head pair (s, path) and the rest of the queue, q. Then that path is returned, followed by the result of processing the rest of the q, with the next pairs produced by step function from this seed s, appended after the q: (q ++ [....]).

Appending at the end of the list at each step produces a queue, while prepending would have produced a "last in first out" stack.

This list is thus used as a "to-do" list, an "agenda", or a frontier of exploration of this implicit graph. With queue the exploration is breadth-first; with stack it is depth-first.

Trying it:

> bfPaths f 1
[[1],[1,2],[1,3],[1,2,4]]

Now you can look for ways to make it more efficient. In particular, repeated appending of singleton lists to build a result list leads to a quadratic behavior. The execution time will grow as the square of the input size.

---

The simplest improvement is to build the paths in reverse and either return them reversed (or reverse only on final processing, if you must), thus avoiding the quadratic slowdown:

bfPathsR :: (a -> [a]) -> a -> [[a]]
bfPathsR step seed  =  go [ (seed, [seed]) ]
 where
 go []  =  []
 go ((s, path) : q) = path :
   go (q ++ [ (x, [x] ++ path) | x <- step s ])

Looks like it's the best, too, since it allows for maximum sharing of structure while the paths are being built (in reverse) and of course adding new value at the front is O(1), so on the whole it will be linear (execution time growing as the size of the input).

If you want to only output the completed paths, i.e. such that have no continuation, you just add this condition to the code:

bfPathsRC :: (a -> [a]) -> a -> [[a]]
bfPathsRC step seed  =  go [ (seed, [seed]) ]
 where
 go []  =  []
 go ((s, path) : q) = [path | null next] ++
   go (q ++ [ (x, [x] ++ path) | x <- next ])
  where
  next = step s

-- bfPathsRC f 1  =  [[3,1],[4,2,1]]