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

Detect cycle in undirected graph in Ocaml

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

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

通常,使用额外的数据结构来标记已经访问过的节点。例如,我们可以使用集合数据结构(使用 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

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

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

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

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

我设法通过使用 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