Détecter le cycle en graphique non dirigé dans OCAML

Dans les graphiques orientés et non dirigés, la présence d'un cycle est détectée à l'aide de la première recherche approfondie . En gros, vous parcourez un graphique et si une marche contient des nœuds répétitifs, alors il y a un cycle.

Généralement, une structure de données supplémentaire est utilisée pour étiqueter les nœuds déjà visités. Par exemple, nous pouvons utiliser une structure de données d'ensemble (en utilisant l'OCaml vanilla),

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

Vous pouvez également utiliser une table de hachage impérative au lieu d'un ensemble fonctionnel pur. Il existe également un algorithme, appelé Iterative Deepening DFS , qui peut parcourir des graphes cycliques sans étiqueter tous les nœuds visités, ce qui est utile lorsque votre graphe est énorme (et ne rentre pas dans la mémoire).

Sauf si vous faites cela pour un exercice, je vous suggère d'utiliser une bibliothèque Graph existante dans OCaml, par exemple, OCamlgraph ( docs ) ou Graphlib ( docs ).

Il est également possible d'éviter de visiter deux fois la même arête en la supprimant de la liste des arêtes disponibles; en supposant que l'ordre n'a pas d'importance entre les arêtes, vous pouvez supprimer une arête comme suit:

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

La suppression d'une arête d'un graphe se fait ensuite en construisant un nouveau graphe qui partage les données avec le graphe précédent, mais avec une liste d'arêtes modifiée:

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 = []}

Vous pouvez ensuite transformer le graphe le long des appels récursifs de votre parcours de graphe; l'exemple ne fait rien d'intéressant ici, c'est juste pour montrer la structure:

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

Ou, vous gardez une trace du graphe courant avec une ref:

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 []

J'ai réussi à détecter le cycle en utilisant la structure de données union-find.

Une structure pour représenter un sous-ensemble pour union-find:

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

Une fonction utilitaire à trouver ensemble d'un élément. Il utilise la technique de compression de chemin:

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

Une fonction qui fait l'union de deux ensembles de x et y. Il utilise l'union par rang:

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

J'ai créé une fonction pour vérifier s'il y a un cycle.

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