Haskell 中的通用 DFS 实现可以用于检测邻接列表中的循环吗？

问题描述 投票：0回答：1

考虑here中的以下多态 DFS 函数：

-- | Depth-first search.
--
-- Generates the list of unique visited states from a
-- given starting state. States are unique up to the
-- characterizing function.
dfsOnN ::
  Ord r =>
  (a -> r)   {- ^ state characterization              -} ->
  (a -> [a]) {- ^ successors function                 -} ->
  [a]        {- ^ initial states                      -} ->
  [a]        {- ^ visited states in depth-first order -}
dfsOnN rep next = loop S.empty
  where
    loop _ [] = []
    loop !seen (x:xs)
      | S.member r seen =     loop seen xs
      | otherwise       = x : loop seen1 (next x ++ xs)
      where
        r     = rep x
        seen1 = S.insert r seen

可以用这个检测周期吗？我猜不会，因为我们处理“已经见过的”案例的方式。如果没有，有没有一种方法可以概括它，使其保留所有现有功能，但也可以检测周期？

为了具体起见，我们可以说：

neighbors :: Int -> [Int]
vertices :: [Int]

我们想将其称为 

dfsOnN id neighbors vertices
并以某种方式使用输出来检测周期。

haskell depth-first-search
1个回答
0
投票

输出列表的 DFS 会丢弃您在整个 DFS 中学到的大量信息。 “DFS 树” 是 DFS 输出的更有趣的结构。 DFS 描述了所访问节点的生成树，不属于该树的原始图的边可以分为“后边”或“交叉边”，具体取决于它们是否与生成树的边形成有向循环。树（链接的维基百科文章还定义了一个类前向边缘，但为了简单起见，我们将它们算作交叉边缘）。 对于具有多个起始顶点的 DFS，您将获得 DFS 树的森林。 data DfsTree a = Tree a [DfsTree a] | BackEdge a -- ancestor in the tree | CrossEdge a -- already visited but not an ancestor in the tree deriving (Show)

要构建 DFS 树（或森林），我们必须跟踪 (1) 之前的

visited
 顶点，以及 (2) 当前顶点的
ancestors

（它是 

visited
的子集）。 
visited
和 
ancestors
之间的主要区别在于，内部递归函数 
dfsFrom
返回更新后的 
visited
，而 
ancestors
被丢弃，因此它的更改不会在每个顶点的子节点中持续存在。这里可以方便地使用 
mapAccumL
来在遍历列表时跟踪 
visited
；或者，您可以使用状态 monad 来执行此操作。
dfs :: Ord r => (a -> r) -> (a -> [a]) -> [a] -> [DfsTree a]
dfs rep next initial = forest
  where
    (_s, forest) = mapAccumL (dfsFrom Set.empty) Set.empty initial
    dfsFrom ancestors visited a
        | ra `Set.member` ancestors = (visited, BackEdge a)
        | ra `Set.member` visited = (visited, CrossEdge a)
        | otherwise =
            let (visited', branches) = mapAccumL (dfsFrom (Set.insert ra ancestors)) (Set.insert ra visited) (next a) in
            (visited', Tree a branches)
        where ra = rep a

许多操作可以通过 DFS 树上的结构递归来定义。 
dfs
保证每个可达顶点在
Tree
构造函数中只出现一次，
branches
中的
Tree x branches
列表具有与邻接列表
next x
一样多的分支，并且每条边对应于一个构造函数（ 
Tree
、
BackEdge
或
CrossEdge
）。换句话说，DFS 树是图的“无循环”表示。
例如，下面的代码实现了循环查找和连通分量枚举（仅适用于无向图（其中邻接矩阵是对称的）；有向图的连通分量计算起来比较棘手，但仍然可以在不修改的情况下这样做
dfs 
）。


循环仅通过后沿的存在来指示。为了使练习更有趣，
findCycle
 还返回循环中的顶点。


findCycle :: Ord r => (a -> r) -> (a -> [a]) -> [a] -> Maybe [a]
findCycle rep next initial = findMaybe (findCycleTree rep []) forest
    where
        forest = dfs rep next initial

findCycleTree :: Eq r => (a -> r) -> [a] -> DfsTree a -> Maybe [a]
findCycleTree rep ancestors (Tree a branches) = findMaybe (findCycleTree rep (a : ancestors)) branches
findCycleTree rep ancestors (BackEdge a) = Just (a : reverse (takeWhile (\a' -> rep a /= rep a') ancestors))
findCycleTree _ _ (CrossEdge _) = Nothing

findMaybe :: (a -> Maybe b) -> [a] -> Maybe b
findMaybe f = foldr ((<|>) . f) Nothing

无向图中的连通分量简单地对应于每棵树。 
connected
 只是将树展平为列表，忽略后边缘和交叉边缘。


-- Assumes undirected graph: x ∈ next y <-> y ∈ next x
connected :: Ord r => (a -> r) -> (a -> [a]) -> [a] -> [[a]]
connected rep next initial = [c | c@(_ : _) <- collectComponent <$> forest]
    where
        forest = dfs rep next initial
        collectComponent (Tree a branches) = a : (branches >>= collectComponent)
        collectComponent (BackEdge _) = []
        collectComponent (CrossEdge _) = []



带有测试用例的完整代码：
import Control.Applicative ((<|>))
import Data.Traversable (mapAccumL)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set

-- General DFS, outputs a DFS forest
-- Reference: https://en.wikipedia.org/wiki/Depth-first_search#Output_of_a_depth-first_search

data DfsTree a
    = Tree a [DfsTree a]
    | BackEdge a
    | CrossEdge a
    deriving (Show)

dfs :: Ord r => (a -> r) -> (a -> [a]) -> [a] -> [DfsTree a]
dfs rep next initial = forest
  where
    (_s, forest) = mapAccumL (dfsFrom Set.empty) Set.empty initial
    dfsFrom ancestors visited a
        | ra `Set.member` ancestors = (visited, BackEdge a)
        | ra `Set.member` visited = (visited, CrossEdge a)
        | otherwise =
            let (visited', branches) = mapAccumL (dfsFrom (Set.insert ra ancestors)) (Set.insert ra visited) (next a) in
            (visited', Tree a branches)
        where ra = rep a

-- Finding cycles

findCycle :: Ord r => (a -> r) -> (a -> [a]) -> [a] -> Maybe [a]
findCycle rep next initial = findMaybe (findCycleTree rep []) forest
    where
        forest = dfs rep next initial

findCycleTree :: Eq r => (a -> r) -> [a] -> DfsTree a -> Maybe [a]
findCycleTree rep ancestors (Tree a branches) = findMaybe (findCycleTree rep (a : ancestors)) branches
findCycleTree rep ancestors (BackEdge a) = Just (a : reverse (takeWhile (\a' -> rep a /= rep a') ancestors))
findCycleTree _ _ (CrossEdge _) = Nothing

findMaybe :: (a -> Maybe b) -> [a] -> Maybe b
findMaybe f = foldr ((<|>) . f) Nothing

exampleCycle :: Maybe [Int]
exampleCycle = findCycle rep next initial
    where
        rep = id
        next 0 = [1]
        next 1 = []
        next 2 = [3,5]
        next 3 = [4]
        next 4 = []
        next 5 = [6,7]
        next 6 = [2]
        next _ = []
        initial = [0,2]

-- Finding connected components

-- Assumes undirected graph: x ∈ next y <-> y ∈ next x
connected :: Ord r => (a -> r) -> (a -> [a]) -> [a] -> [[a]]
connected rep next initial = [c | c@(_ : _) <- collectComponent <$> forest]
    where
        forest = dfs rep next initial
        collectComponent (Tree a branches) = a : (branches >>= collectComponent)
        collectComponent (BackEdge _) = []
        collectComponent (CrossEdge _) = []

exampleConnected :: [[Int]]
exampleConnected = connected rep next initial
    where
        rep = id
        next 0 = [1]
        next 1 = [0]
        next 2 = [3,4]
        next 3 = [2,4]
        next 4 = [2,3]
        next 5 = [6]
        next 6 = [5]
        next _ = []
        initial = [0,2,5]

main :: IO ()
main = do
    print exampleCycle      -- cycle: [2,5,6]
    print exampleConnected  -- connected components: [[0,1],[2,3,4],[5,6]]


    

	

    

    


  

  

    
最新问题


  





  

    © www.soinside.com 2019 - 2024. All rights reserved.