Avoiding duplicates in breadth-first search

algorithm, functional-programming, haskell

Solution

You should use a set of visited nodes instead of `rip`.

First, `rip` takes linear time in the number of remaining edges, which makes the whole breadth-first traversal quadratic.

Second, the no-duplicates traversal is not practical with `rip`. Currently, duplicate nodes are added because the same nodes can be visited from multiple nodes of the current frontier of traversal. The revisits can't be simply pruned with `rip` because it removes the node from the graph altogether, but we still need the node in order to continue the traversal.

Here's an example with a visited set in a `State` monad (which is nice here, since we can build up the traversal frontier by frontier, and `filterM` from `Control.Monad` is handy for, well, filtering out visited nodes):

import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS

import Control.Monad
import Control.Monad.State.Strict

type Node = Int
type Graph = IM.IntMap [Node]

bfs :: Node -> Graph -> [Node]
bfs n g = evalState (go [n]) (IS.singleton n) where

    go :: [Node] -> State IS.IntSet [Node]
    go [] = return []
    go ns = do
        ns' <- flip filterM ((g IM.!) =<< ns) $ \n' -> do
            notVisited <- gets (IS.notMember n')
            when notVisited $ modify (IS.insert n')
            return notVisited
        (ns++) `fmap` go ns'

-- your example graph
graph :: Graph
graph = IM.fromList $ [
      (1, [2, 3])
    , (2, [1, 4])
    , (3, [1, 4])
    , (4, [2, 5, 3, 6])
    , (5, [4, 7])
    , (6, [4, 7])
    , (7, [5, 6])]

main = print $ bfs 1 graph -- [1, 2, 3, 4, 5, 6, 7]

Here's is an implementation of the same algorithm without `State`, instead using `foldr` to pass along the updated visited set:

bfs' :: Node -> Graph -> [Node]
bfs' start graph = go [start] (IS.singleton start) where

    go :: [Node] -> IS.IntSet -> [Node]
    go [] _       = []
    go ns visited = ns ++ go ns' visited' where

        newNodes = [n' | n <- ns, n' <- graph IM.! n]

        step n (acc, visited) 
            | IS.member n visited = (acc, visited)
            | otherwise = (n:acc, IS.insert n visited) 

        (ns', visited') = foldr step ([], visited) newNodes

Problem

For educational purposes I've recently been implementing common algorithms in Haskell. Currently I'm stuck on Breadth-First Search. This is my implementation, with nodes being represented as just integers for simplicity: ``` import qualified Data.Map as M import qualified Data.List as L type Node = Int type Graph = M.Map Node [Node] -- Returns list of nodes adjacent to n in graph g adjacent :: Node -> Graph -> [Node] adjacent n g = M.findWithDefault [] n g -- Returns graph g with all instances of n removed rip :: Node -> Graph -> Graph rip n g = M.delete n (M.map (L.delete n) g) bfs :: Node -> Graph -> [Node] bfs n g = [n] ++ _bfs [n] g _bfs :: [Node] -> Graph -> [Node] _bfs (n:ns) g = if not (M.null g) then let layer = adjacent n g in layer ++ _bfs (ns ++ layer) (rip n g) else n:ns _bfs [] g = [] ``` (There are other functions for actually constructing the graph, but I left them out for brevity's sake) The result of calling `bfs` would be a correct breadth-first traversal of the graph, if not for the fact that some graphs produce duplicates, such as this one: (The result of `bfs 1 g` for `g` = this graph is `[1,2,3,4,4,5,6,7,7,7]`) My current solution boils down to changing the relevant line in `_bfs` to `L.nub $ layer ++ _bfs (ns ++ layer) (rip n g)`, but that seems incredibly hackish, and I'm not sure if it'll produce a correct breadth-first traversal. Aside from constantly checking `n:ns` for duplicates before inserting (which sounds horribly inefficient), I have no other ideas. How can I rewrite `_bfs` (or more) so that it does not produce duplicates by definition?

Original source