在 Ocaml 中检测无向图中的循环

Question

有人知道如何检测 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)
  ]
}

Answer 1

在有向图和无向图中，使用“深度优先搜索”检测循环的存在。粗略地说，您遍历一个图，如果一次遍历包含重复的节点，则存在一个循环。 通常，采用额外的数据结构来标记已经访问过的节点。例如，我们可以采用集合数据结构（使用普通 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

您还可以使用命令式哈希表来代替纯函数集。还有一种称为“迭代加深 DFS”的算法，它可以遍历循环图，而无需标记所有访问过的节点，这在您的图很大（并且无法放入内存中）时非常有用。 

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

docs

) 或 Graphlib (docs)。 还可以通过从可用边列表中删除同一条边来避免访问同一边两次；假设边之间的顺序并不重要，您可以按如下方式删除边：

Answer 2

然后通过构建与前一个图共享数据的新图来完成从图中删除边：

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

我设法使用并查数据结构来检测循环。

Answer 3

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