避免广度优先搜索中的重复

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 gfor g= this图的结果是[1,2,3,4,4,5,6,7,7,7])

我目前的解决方案可以归结为改变相关行_bfs来L.nub $ layer ++ _bfs (ns ++ layer) (rip n g),但似乎令人难以置信的hackish,我不知道这是否会产生正确的广度优先遍历.除了n:ns在插入之前不断检查重复项(听起来非常低效),我没有其他想法.

如何重写_bfs(或更多),以便它不会产生重复的定义？

Answer 1

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

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

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

这是一个在 monad 中包含访问集的示例State（这很好，因为我们可以逐个边界建立遍历边界，并且filterMfromControl.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