在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函数来获取可从给定节点(包括该节点)到达的节点.由于a Graph是a 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函数的工作原理感兴趣,我可以在这里详细介绍它,但是当您查看代码时,它是非常直截了当的.

这些函数非常有效,但它们可以大大改进,具体取决于您希望最终如何表示循环.例如,您可以使用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获取节点列表,如果列表为空,则运行continuation,否则它会执行一些有趣的操作.它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 函数，例如组件等。