Detect cycle in undirected graph in Ocaml - graph

Question

Does someone has idea how to detect if there is a cycle in undirected graph in OCaml?
Here's the type I'm using for graph:
type 'a graph = { nodes : 'a list; edges : ('a * 'a * int) list }
And for example, I would like to check if this graph contains cycles:
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

In both directed and undirected graphs, the presence of a cycle is detected using depth first search. Roughly, you traverse a graph and if a walk contains repetitive nodes, then there is a cycle.
Commonly, an additional data structure is employed for labeling already visited nodes. For example, we can employ a set data structure (using 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
You can also use an imperative hash table instead of a pure functional set. There is also an algorithm, called Iterative Deepening DFS, that can traverse cyclic graphs without labeling all visited nodes, which is useful when your graph is huge (and won't fit into the memory).
Unless you're doing this for an exercise, I would suggest you using some existing Graph library in OCaml, e.g., OCamlgraph (docs) or Graphlib (docs).

Answer 2

It is also possible to avoid visiting the same edge twice by removing it from the list of available edges; assuming order does not matter in among edges, you can remove an edge as follows:
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 []
Removing an edge from a graph is then done by building a new graph that shares data with the previous graph, but with a modified list of edges:
let graph_remove_edge graph edge =
{ nodes = graph.nodes;
edges = edges_remove_edge graph.edges edge }
You can then transform the graph along the recursive calls of your graph traversal; the example does nothing interesting here, it is just to demonstrate the structure:
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 = []}
Or, you keep track of the current graph with a 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

I managed to detect cycle by using union-find data structure.
A structure to represent a subset for union-find:
let create n =
{parent = Array.init n (fun i -> i);
rank = Array.init n (fun i -> 0)}
A utility function to find set of an element. It uses path compression technique:
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
A function that does union of two sets of x and y. It uses union by rank:
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
I created function for checking if there is a cycle.
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