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 =
|
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
|
||||||
|
|
|
||||||
|
|
@ -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 *)
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue