implemented LazyGraph.from_enum, and added from_list (simple interface);

LazyGraph.find_cycle can be used on cyclic graphs
This commit is contained in:
Simon Cruanes 2013-10-07 16:00:22 +02:00
parent ba49d959be
commit 0465040c7f
2 changed files with 63 additions and 6 deletions

View file

@ -62,9 +62,6 @@ let singleton ?(eq=(=)) ?(hash=Hashtbl.hash) v label =
let make ?(eq=(=)) ?(hash=Hashtbl.hash) force = let make ?(eq=(=)) ?(hash=Hashtbl.hash) force =
{ eq; 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 from_fun ?(eq=(=)) ?(hash=Hashtbl.hash) f =
let force v = let force v =
match f v with match f v with
@ -109,7 +106,7 @@ module Mutable = struct
mutable mut_outgoing : ('e * 'id) list; mutable mut_outgoing : ('e * 'id) list;
} }
let create ?(eq=(=)) ~hash = let create ?(eq=(=)) ?(hash=Hashtbl.hash) () =
let map = mk_map ~eq ~hash in let map = mk_map ~eq ~hash in
let force v = let force v =
try let node = map.map_get v in try let node = map.map_get v in
@ -130,6 +127,26 @@ module Mutable = struct
() ()
end 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} *) (** {2 Traversals} *)
(** {3 Full interface to traversals} *) (** {3 Full interface to traversals} *)
@ -198,6 +215,9 @@ module Full = struct
end end
done) 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 = let dfs_full graph vertices =
Sequence.from_iter (fun k -> Sequence.from_iter (fun k ->
let explored = mk_map ~eq:graph.eq ~hash:graph.hash in let explored = mk_map ~eq:graph.eq ~hash:graph.hash in
@ -414,6 +434,34 @@ let is_dag_full graph vs =
| _ -> true) | _ -> true)
(Full.dfs_full graph vs) (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 *) (** Reverse the path *)
let rev_path p = let rev_path p =
let rec rev acc p = match p with let rec rev acc p = match p with

View file

@ -73,7 +73,12 @@ val from_enum : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) ->
vertices:('id * 'v) Sequence.t -> vertices:('id * 'v) Sequence.t ->
edges:('id * 'e * 'id) Sequence.t -> edges:('id * 'e * 'id) Sequence.t ->
('id, 'v, 'e) 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) -> val from_fun : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) ->
('id -> ('v * ('e * 'id) list) option) -> ('id, 'v, 'e) t ('id -> ('v * ('e * 'id) list) option) -> ('id, 'v, 'e) t
@ -87,7 +92,7 @@ module Mutable : sig
type ('id, 'v, 'e) t type ('id, 'v, 'e) t
(** Mutable graph *) (** 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 ('id, 'v, 'e) t * ('id, 'v, 'e) graph
(** Create a new graph from the given equality and hash function, plus (** Create a new graph from the given equality and hash function, plus
a view of it as an abstract graph *) 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 val is_dag_full : ('id, _, _) t -> 'id Sequence.t -> bool
(** Is the Graph reachable from the given vertices, a DAG? See {! is_dag} *) (** 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 val rev_path : ('id, 'e) path -> ('id, 'e) path
(** Reverse the path *) (** Reverse the path *)