【问题标题】:Detect cycle in undirected graph in Ocaml在 Ocaml 中检测无向图中的循环
【发布时间】:2020-01-12 16:31:26
【问题描述】:

有人知道如何在 OCaml 中检测无向图中是否存在循环吗?

这是我用于图表的类型:

type 'a graph = { nodes : 'a list; edges : ('a * 'a * int) list }

例如,我想检查此图是否包含循环:

let graph = { nodes = ['a'; 'b'; 'c'; 'd'; 'e'; 'f'; 'g'; 'h'; 'j';]; 
              edges = [('c', 'j', 9); ('d', 'e', 8); ('a', 'b', 8); ('b', 'c', 7); ('f', 'g', 6); ('b', 'h', 4); ('a', 'd', 4); ('g', 'h', 2); ('b', 'f', 2); ('e', 'g', 1)]}

【问题讨论】:

  • 在有循环的图上使用图遍历算法会发生什么?你做了什么实验?你在哪里卡住了?您是否有一些无法正常工作的起始代码?如果您花更多的时间来构思您的问题,将会更有帮助。
  • 我正在实现 Kruskal 的最小生成树算法,但我一直在检测我已经提取的边中是否存在循环。所以,我有一个像我在示例中编写的图表,并且我正在迭代它,每次取最小权重的边,但我不能取一个产生循环的边。所以,现在我被它困住了,因为我不知道如何检测是否存在循环。
  • 如果您跟踪到目前为止您所看到的节点,您可以通过检查当前节点是否在所见节点集中来检测您是否处于循环中。
  • 我无法跟踪它们,或者至少我不知道如何跟踪它们,因为我只考虑边缘。所以在我看来,我应该每次都做一些算法(DST或类似的)来检查是否有一条通往初始节点的路径,但我也不知道我会怎么做。我是 OCaml 的新手。我也在阅读 Kruskal 的算法应该包含联合查找算法,但我不知道如何实现它。 stackoverflow.com/questions/4290163/…
  • 这是一个更好的问题,您应该编辑您的初始问题以添加这种最少的信息。是的,union-help 可用于检测两个顶点是否属于图的相同连通分量。

标签: graph tree ocaml cycle


【解决方案1】:

在有向和无向图中,使用depth first search 检测循环的存在。粗略地说,你遍历一个图,如果一个 walk 包含重复的节点,那么就有一个循环。

通常,使用额外的数据结构来标记已经访问过的节点。例如,我们可以使用一个集合数据结构(使用 vanilla OCaml),

module Nodes = Set.Make(struct 
                 type t = int
                 let compare = compare
               end)

let dfs {edges} f x = 
 let rec loop visited x = function
   | [] -> x 
   | (src,dst,data) :: rest -> 
     let x = f src data in
     let visited = Nodes.add src visited in
     if Nodes.mem dst visited 
     then loop visited x rest
     else ... in
  loop Nodes.empty x edges

您还可以使用命令式哈希表来代替纯函数集。还有一种算法,称为Iterative Deepening DFS,它可以遍历循环图而不标记所有访问过的节点,这在你的图很大(并且不适合内存)时很有用。

除非您这样做是为了练习,否则我建议您使用 OCaml 中的一些现有图形库,例如 OCamlgraph (docs) 或 Graphlib (docs)。

【讨论】:

    【解决方案2】:

    还可以通过从可用边列表中删除同一边来避免两次访问同一边;假设边缘之间的顺序无关紧要,您可以按如下方式删除边缘:

    let edges_remove_edge edges edge =
      let (src, dst, _) = edge in
      let rec iter edges res = match edges with
        | [] -> res
        | ((s, d, _) as e)::edges ->
           if (s = src && d = dst) then
             res @ edges
           else
             iter edges (e::res)
      in iter edges []
    

    然后通过构建一个与前一个图表共享数据的新图表来从图表中删除一条边,但使用修改后的边列表:

    let graph_remove_edge graph edge =
      { nodes = graph.nodes;
        edges = edges_remove_edge graph.edges edge }
    

    然后,您可以沿着图形遍历的递归调用转换图形;这个例子在这里没有什么有趣的,它只是为了演示结构:

    let choose_edge graph = match graph.edges with
      | [] -> None
      | e::_ -> Some e;;
    
    let rec visit graph = match (choose_edge graph) with
      | None -> graph
      | Some e -> visit (graph_remove_edge graph e);;
    
    # visit graph;;
    - : char graph =
    {nodes = ['a'; 'b'; 'c'; 'd'; 'e'; 'f'; 'g'; 'h'; 'j']; edges = []}
    

    或者,您使用 ref 跟踪当前图表:

    let visit2 graph =
      let g = ref graph in
      let rec v () = match (choose_edge !g) with
      | None -> ()
      | Some e -> begin g := graph_remove_edge !g e; v () end
      in v(); !g
    

    【讨论】:

      【解决方案3】:

      我设法通过使用 union-find 数据结构来检测循环。

      表示联合查找子集的结构:

      let create n =
          {parent = Array.init n (fun i -> i);
           rank = Array.init n (fun i -> 0)} 
      

      用于查找元素集合的实用函数。它使用路径压缩技术:

      let rec find uf i =
        let pi = uf.parent.(i) in
        if pi == i then
           i
        else begin
           let ci = find uf pi in
           uf.parent.(i) <- ci;
           ci
        end
      

      将两组 x 和 y 合并的函数。它按等级使用联合:

      let union ({ parent = p; rank = r } as uf) x y =
          let cx = find uf x in
          let cy = find uf y in
          if cx == cy then raise (Failure "Cycle detected") else  begin
             if r.(cx) > r.(cy) then
                p.(cy) <- cx
             else if r.(cx) < r.(cy) then
                p.(cx) <- cy
             else begin
                r.(cx) <- r.(cx) + 1;
                p.(cy) <- cx
             end
          end
      

      我创建了检查是否存在循环的函数。

      let thereIsCycle c1 c2 g subset =
        let isCycle = try Some (union subset (findIndex c1 g.nodes) (findIndex c2 g.nodes)) with _ -> None in
            match isCycle with
           | Some isCycle -> false
           | None -> true
      
      let rec findIndex x lst =
          match lst with
          | [] -> raise (Failure "Not Found")
          | h :: t -> if x = h then 0 else 1 + findIndex x t
      

      【讨论】:

        猜你喜欢
        • 2017-01-19
        • 1970-01-01
        • 2020-08-02
        • 1970-01-01
        • 1970-01-01
        • 2016-03-28
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        相关资源
        最近更新 更多