在Haskell中检测图形的周期（可能是有向的或无向的）

Question

我开始以命令式方式解决这个问题并且它可以工作（DFS使用传统的三种着色技术）。但是，我需要三倍的时间来弄清楚Haskell是如何做到的，我失败了！假设我将图表表示为具有邻接节点的节点的列表（或映射）。

type Node = Int
type Graph = [(Node, [Node])]

请注意，上述表示可以是定向的或不定向的。 在进行探测以检测后沿边缘时，我还将看到的集合和完成集合作为参数传递（因为在功能上没有副作用）。但是，我不能在Haskell中做到这一点！ 我知道可能会使用State monad，但那件事并没有在我的脑海中完成。 我很想知道怎么能有人指导我如何以“美丽的”Haskell风格做到这一点？

Answer 1

首先，有一种用于在Haskell中存储Graphs的数据类型;它在Data.Graph.Graph包中称为containers。它使用Data.Array而不是列表，但在其他方面与您的表示相同。

type Graph = Array Int [Int]

这种表示方式可以提高图表效率，同时还可以使用更少的内存。我像这样使用这个库：

import Data.Graph (Graph)
import qualified Data.Graph as Graph
import Data.Array

您可能知道图表中的最小和最大节点;如果没有，此函数会为您计算它们并创建Graph：

makeGraph :: [(Node, [Node])] -> Graph
makeGraph list =
  array (minimum nodes, maximum nodes) list
  where
    nodes = map fst list

要查看节点是否属于循环，必须检查从一个节点（不包括节点本身）可到达的节点是否包含该节点。可以使用reachable函数来获取可从给定节点（包括该节点）到达的节点。由于Graph是Array，因此可以使用assocs来获取其构建的列表，类型为[(Node, [Node])]。我们使用这三个事实来构建两个函数：

-- | Calculates all the nodes that are part of cycles in a graph.
cyclicNodes :: Graph -> [Node]
cyclicNodes graph =
  map fst . filter isCyclicAssoc . assocs $ graph
  where
    isCyclicAssoc = uncurry $ reachableFromAny graph

-- | In the specified graph, can the specified node be reached, starting out
-- from any of the specified vertices?
reachableFromAny :: Graph -> Node -> [Node] -> Bool
reachableFromAny graph node =
  elem node . concatMap (Graph.reachable graph)

如果您对reachable函数的工作原理感兴趣，我可以在这里详细介绍所有这些内容，但是当您查看the code时，可以直截了当地理解。

这些功能非常高效，但根据您希望最终表示周期的方式，它们可以大大改进。例如，您可以使用stronglyConnComp中的Data.Graph函数来获得更简化的表示。

请注意，我在这种情况下滥用Node ~ Graph.Vertex ~ Int的事实，因此，如果您的Node更改类型，则需要在Data.Graph中使用适当的转化功能，例如 graphFromEdges，以获得Graph和相关的转换函数。

fgl库是另一种替代方案，它还提供了一套完整的图形相关功能，并且非常优化。

Answer 2

有尝试它的天真方式，看起来像这样：

route :: Graph -> Label -> Label -> Bool
route g dest from | from == dest = True
route g dest from = any (route g dest) (neighbours g from)

但是在循环图时失败了。 （我也假设你有邻居定义）

那么，做什么但是通过已经看过的节点列表。

route2 :: Graph  -> Label -> Label -> [Label] -> Bool
route2 g dest from seen 
  | dest == from = True
  | otherwise    = any (\x -> route2 g dest x (from:seen)) (neighbours g from)

但是如果你在图表上运行它： 你会得到一个看起来像这样的痕迹（原谅这个方案，我无耻地从我的cs类中偷走了这些图片.fr是find-route，而fr-l是一个带有列表的版本。第二个参数是累加器）

如您所见，它最终访问节点K和H两次。这很糟糕，让我们看看为什么这样做。

由于它没有从any中递归的调用中传递任何信息，因此它无法看到它在失败的分支中所做的事情，只能看到当前节点的路径上的内容。

现在要解决这个问题，我们可以采取两种方式。我的班级采用了一种相当新颖的延续传递方法，因此我将在状态monad版本之前首先显示它。

routeC :: Graph -> Label -> Label -> [Label] -> ([Label] -> Bool) -> Bool
routeC g  dest from seen k 
  | dest == from     = True
  | from `elem` seen = k (from:seen)
  | otherwise        = routeCl g dest (neighbours g from) (from:seen) k

routeCl :: Graph -> Label -> [Label] -> [Label] -> ([Label] -> Bool) -> Bool
routeCl g dest []     seen k = k seen
routeCl g dest (x:xs) seen k = 
    routeC g dest x seen (\newSeen -> routeCl g dest xs newSeen k)

这使用了一对函数，而不是任何函数。 routeC只是检查我们是否到达目的地，或者我们是否已经循环，否则它只是调用routeCL与当前节点的邻居。

如果我们已经循环，那么我们不是仅仅返回False，而是使用我们当前看到的节点（包括当前节点）来继续调用。

routeCL获取节点列表，如果列表为空，则运行延续，否则它会执行一些有趣的操作。它在第一个节点上运行routeC，并向其传递一个将在列表的其余部分上运行routeCl的延续，其中包含新的已查看节点列表。因此，它将能够看到失败的分支的历史。

（另外一点，我们可以进一步概括一下，并将其完全转换为连续传递样式。我也推广了任何一个，而不是使用这对函数。这是可选的，类型签名比代码更可怕。）

anyK :: (a -> s -> (s -> r) -> (s -> r) -> r) ->
        [a] -> s -> (s -> r) -> (s -> r) -> r
anyK p []     s tK fK = fK s
anyK p (x:xs) s tK fK = p x s tK (\s' -> anyK p xs s' tK fK)

routeK2 :: Graph -> Label -> Label -> ([Label] -> r) -> ([Label] -> r) -> r
routeK2 g dest from' trueK falseK = route from' [] trueK falseK
  where route from seen tK fK 
         | from == dest = tK seen
         | from `elem` seen = fK seen
         | otherwise = anyK route (neighbours g from) (from:seen) tK fK

同样的事情，但传递了更多信息。

现在，你一直在等待State Monad版本。

routeS :: Graph -> Label -> Label -> State [Label] Bool
routeS g dest from | dest == from = return True
routeS g dest from = do
      seen <- get 
      if from `elem` seen then return False else do
      put (from:seen)
      anyM (routeS g dest) (neighbours g from)

但最后一行看起来不像我们开始的那样，只是有一些额外的管道？比较：

any  (route g dest)  (neighbours g from)  -- Simple version
anyM (routeS g dest) (neighbours g from)  -- State Version
anyK route         (neighbours g from) (from:seen) tK fK  -- CPS version

核心是，这三个人都在做同样的事情。状态版本中的monad很好地为我们处理了所见节点的管道。 CPS版本以比州monad更明确的方式向我们展示了控制流的确切含义。

哦，但anyM似乎不在标准库中。这是它的样子：

anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
anyM p [] = return False
anyM p (x:xs) = do
    y <- p x
    if y
      then return True
      else anyM p xs

Answer 3

我可能只是cabal install fgl并使用内置的DFS函数，如components等。