Breadth First Alga

Breadth first search has a similar goal to depth first, but a different approach. We also build a forest, but instead of exploring trees before neighbors, we advance along the frontier level by level – breadth before depth.

This implementation is basically a wrapper around container's unfoldForestM_BF implementation which is based on Chris Okasaki's Breadth-First Numbering paper. The key here was simply getting the monadic unfold argument function right. A queue (Data.Sequence) is threaded through as the forest is unfolded.

The main visibile contrast here (to dfs) is that instead of filtering based on the table of visited vertices during the exploration function, the filtering happens as adjacent vertices are queried.

bfsForest :: Ord a => [a] -> AdjacencyMap a -> Forest a
bfsForest vs g = evalState (explore [ v | v <- vs, hasVertex v g ]) Set.empty where
  explore = unfoldForestM_BF walk <=< filterM discovered
  walk v = (v,) <$> adjacentM v
  adjacentM v = filterM discovered $ Set.toList (postSet v g)
  discovered v = do new <- gets (not . Set.member v)
                    when new $ modify' (Set.insert v)
                    return new

That last statment may look like a lie as explore calls filterM discovered straight away. However! nothing prevents the argument vs from having duplicate vertices so this first step in processing is really a nub that also starts up our crucial table of explored vertices.

If you squint (or stare for too long at the computer screen), it's like the caller of bfsForest augmented graph \(g\) with some vertex connected to those in \(vs\), and the search carries on without this declared root. Through these goggles, the filtering is still at adjacent vertices!

Anyway, all that to point out that in dfs we check roots before exploring trees and in bfs we explore roots and then check branches.

Before presenting the flattened analogue to dfs, an issue that came up in writing the implementation was figuring out how should the level order forest we get from breadFirstForestFrom be flattened?

The type we're looking for is Forest a -> [ [a] ] with the property that vertices at the \(k\text{th}\) index of the result appear at a distance \(k\) from the input vertices \(vs\) to bfsForestFrom in \(g\).

Data.Tree does provide functions flatten and levels that turn preorder trees and level order trees into lists. The issue is that concatMap levels doesn't work for forests. Basically, concatMap flatten does what we'd expect but concatMap levels doesn't. Concretely:

> let put'forest = putStrLn . drawForest . map (fmap show)
> let g = (circuit [1..5] + circuit [5,4..1]) + (6*7) :: AdjacencyMap Int
> put'forest $ dfsForestFrom [1,6] g
1
|
`- 2
   |
   `- 3
      |
      `- 4
         |
         `- 5

6
|
`- 7
> concatMap flatten $ dfsForestFrom [1,6] g
[1,2,3,4,5,6,7]
> put'forest $ bfsForest [1,6] g
1
|
+- 2
|  |
|  `- 3
|
`- 5
   |
   `- 4

6
|
`- 7
> concatMap levels $ bfsForest [1,6] g
[[1],[2,5],[3,4],[6],[7]]

Which is wrong… 6 is at distance 0 from vs = [1,6], but appears at index 3!

Here's the fix:

bfs :: Ord a => [a] -> AdjacencyMap a -> [[a]]
bfs vs = map concat . List.transpose . map levels . bfsForest vs

The reason for this (one has become clearer to me since picking up J – see transpose |:) is that the forest has the wrong leading axis: trees are prioritized over levels in the structure of the initial forest. To put levels out in front, we must reverse axes before concat-ing, which is exactly trasnpose. With a small twist:

> map levels $ bfsForest [1,6] g
[[[1],[2,5],[3,4]],[[6],[7]]]

> List.transpose $ map levels $ bfsForest [1,6] g
[[[1],[6]],[[2,5],[7]],[[3,4]]]

> map concat $ List.transpose $ map levels $ bfsForest [1,6] g
[[1,6],[2,5,7],[3,4]]