mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
implemented LazyGraph.from_enum, and added from_list (simple interface);
LazyGraph.find_cycle can be used on cyclic graphs
This commit is contained in:
parent
ba49d959be
commit
0465040c7f
2 changed files with 63 additions and 6 deletions
56
lazyGraph.ml
56
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
|
||||
|
|
|
|||
|
|
@ -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 *)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue