algorithm - 在广度优先搜索中避免重复

Question

出于教育目的，我最近一直在使用 Haskell 实现常用算法。目前我坚持广度优先搜索。这是我的实现，为简单起见，节点仅表示为整数:

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 = []

(还有其他函数可以实际构建图形，但为了简洁起见，我将它们省略了)

调用 bfs 的结果将是图的正确广度优先遍历，如果不是因为某些图会产生重复的事实，例如这个图:

(bfs 1 g 的结果 g = 这个图是 [1,2,3,4,4,5,6,7, 7,7])

我目前的解决方案归结为将 _bfs 中的相关行更改为 L.nub $ layer++ _bfs (ns++ layer) (rip n g)，但是这看起来非常骇人听闻，而且我不确定它是否会产生正确的广度优先遍历。除了在插入之前不断检查 n:ns 是否有重复项(这听起来效率极低)，我没有其他想法。

我如何重写 _bfs(或更多)以便它不会根据定义产生重复项？

Answer 1

您应该使用一组访问过的节点而不是rip。

首先，rip在剩余边数上取线性时间，这使得整个广度优先遍历是二次的。

其次，无重复遍历在 rip 中不实用。目前，添加重复节点是因为可以从当前遍历边界的多个节点访问相同的节点。不能用 rip 简单地修剪重访，因为它会从图中完全删除节点，但我们仍然需要节点才能继续遍历。

这是一个在 State monad 中访问集的示例(这在这里很好，因为我们可以逐个边界构建遍历边界，并从 filterM >Control.Monad 很方便，嗯，过滤掉访问过的节点):

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]

下面是相同算法的实现，但不使用 State，而是使用 foldr 传递更新后的访问集:

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