From 0465040c7fcb7602f29fa2a10187f3095037a05e Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 7 Oct 2013 16:00:22 +0200
Subject: [PATCH] implemented LazyGraph.from_enum, and added from_list (simple
 interface); LazyGraph.find_cycle can be used on cyclic graphs

---
 lazyGraph.ml  | 56 +++++++++++++++++++++++++++++++++++++++++++++++----
 lazyGraph.mli | 13 ++++++++++--
 2 files changed, 63 insertions(+), 6 deletions(-)

diff --git a/lazyGraph.ml b/lazyGraph.ml
index 2eefe514..989ada76 100644
--- a/lazyGraph.ml
+++ b/lazyGraph.ml
@@ -62,9 +62,6 @@ let singleton ?(eq=(=)) ?(hash=Hashtbl.hash) v label =
 let make ?(eq=(=)) ?(hash=Hashtbl.hash) force =
   { eq; hash; force; }
 
-let from_enum ?(eq=(=)) ?(hash=Hashtbl.hash) ~vertices ~edges =
-  failwith "from_enum: not implemented"
-
 let from_fun ?(eq=(=)) ?(hash=Hashtbl.hash) f =
   let force v =
     match f v with
@@ -109,7 +106,7 @@ module Mutable = struct
     mutable mut_outgoing : ('e * 'id) list;
   }
 
-  let create ?(eq=(=)) ~hash =
+  let create ?(eq=(=)) ?(hash=Hashtbl.hash) () =
     let map = mk_map ~eq ~hash in
     let force v =
       try let node = map.map_get v in
@@ -130,6 +127,26 @@ module Mutable = struct
     ()
 end
 
+let from_enum ?(eq=(=)) ?(hash=Hashtbl.hash) ~vertices ~edges =
+  let g, lazy_g = Mutable.create ~eq ~hash () in
+  Sequence.iter
+    (fun (v,label_v) -> Mutable.add_vertex g v label_v;)
+    vertices;
+  Sequence.iter
+    (fun (v1, e, v2) -> Mutable.add_edge g v1 e v2)
+    edges;
+  lazy_g
+
+let from_list ?(eq=(=)) ?(hash=Hashtbl.hash) l =
+  let g, lazy_g = Mutable.create ~eq ~hash () in
+  List.iter
+    (fun (v1, e, v2) ->
+      Mutable.add_vertex g v1 v1;
+      Mutable.add_vertex g v2 v2;
+      Mutable.add_edge g v1 e v2)
+    l;
+  lazy_g
+
 (** {2 Traversals} *)
 
 (** {3 Full interface to traversals} *)
@@ -198,6 +215,9 @@ module Full = struct
             end
       done)
 
+  (* TODO: use a set of nodes currently being explored, rather than
+    checking whether the node is in the path (should be faster) *)
+
   let dfs_full graph vertices =
     Sequence.from_iter (fun k ->
       let explored = mk_map ~eq:graph.eq ~hash:graph.hash in
@@ -414,6 +434,34 @@ let is_dag_full graph vs =
       | _ -> true)
     (Full.dfs_full graph vs)
 
+let rec _cut_path ~eq v path = match path with
+  | [] -> []
+  | (v'', e, v') :: _ when eq v v' -> [v'', e, v']  (* cut *)
+  | (v'', e, v') :: path' -> (v'', e, v') :: _cut_path ~eq v path'
+
+let find_cycle graph v =
+  let cycle = ref [] in
+  try
+    let path_stack = Stack.create () in
+    let seq = Full.dfs_full graph (Sequence.singleton v) in
+    Sequence.iter
+      (function
+      | Full.EnterVertex (_, _, _, path) ->
+        Stack.push path path_stack
+      | Full.ExitVertex _ ->
+        ignore (Stack.pop path_stack)
+      | Full.MeetEdge(v1, e, v2, Full.EdgeBackward) ->
+        (* found a cycle! cut the non-cyclic part and add v1->v2 at the beginning *)
+        let path = _cut_path ~eq:graph.eq v1 (Stack.top path_stack) in
+        let path = (v1, e, v2) :: path in
+        cycle := path;
+        raise Exit
+      | Full.MeetEdge _ -> ())
+      seq;
+    raise Not_found
+  with Exit ->
+    !cycle
+
 (** Reverse the path *)
 let rev_path p =
   let rec rev acc p = match p with
diff --git a/lazyGraph.mli b/lazyGraph.mli
index e5be1036..de109d89 100644
--- a/lazyGraph.mli
+++ b/lazyGraph.mli
@@ -73,7 +73,12 @@ val from_enum : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) ->
                 vertices:('id * 'v) Sequence.t ->
                 edges:('id * 'e * 'id) Sequence.t ->
                 ('id, 'v, 'e) t
-  (** Concrete (eager) representation of a Graph (XXX not implemented)*)
+  (** Concrete (eager) representation of a Graph *)
+
+val from_list : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) ->
+                ('id * 'e * 'id) list ->
+                ('id, 'id, 'e) t
+  (** Simple way to generate a graph, from a list of edges *)
 
 val from_fun : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) ->
                ('id -> ('v * ('e * 'id) list) option) -> ('id, 'v, 'e) t
@@ -87,7 +92,7 @@ module Mutable : sig
   type ('id, 'v, 'e) t
     (** Mutable graph *)
 
-  val create : ?eq:('id -> 'id -> bool) -> hash:('id -> int) ->
+  val create : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) -> unit ->
     ('id, 'v, 'e) t * ('id, 'v, 'e) graph
     (** Create a new graph from the given equality and hash function, plus
         a view of it as an abstract graph *)
@@ -172,6 +177,10 @@ val is_dag : ('id, _, _) t -> 'id -> bool
 val is_dag_full : ('id, _, _) t -> 'id Sequence.t -> bool
   (** Is the Graph reachable from the given vertices, a DAG? See {! is_dag} *)
 
+val find_cycle : ('id, _, 'e) t -> 'id -> ('id, 'e) path
+  (** Find a cycle in the given graph.
+      @raise Not_found if the graph is acyclic *)
+
 val rev_path : ('id, 'e) path -> ('id, 'e) path
   (** Reverse the path *)