simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-08 04:05:30 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

updated Graph to remove the functor; it is now

Browse source 
imperative, backed by PHashtbl, and offers a simplified Dot-printing interface.
This commit is contained in:
Simon Cruanes 2013-03-04 17:35:22 +01:00
parent 25a7d33985
commit d19abf889c
2 changed files with 399 additions and 511 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

332
graph.ml
View file

@ -23,201 +23,94 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*) *)
(** {1 A simple persistent directed graph.} *) (** {1 A simple mutable directed graph.} *)
module type S = sig type ('v, 'e) t = ('v, ('v, 'e) node) PHashtbl.t
(** {2 Basics} *) (** Graph parametrized by a type for vertices, and one for edges *)
and ('v, 'e) node = {
type vertex n_vertex : 'v;
mutable n_next : ('e * 'v) list;
module M : Map.S with type key = vertex mutable n_prev : ('e * 'v) list;
module S : Set.S with type elt = vertex
type 'e t
(** Graph parametrized by a type for edges *)
val empty : 'e t
(** Create an empty graph. *)
val is_empty : 'e t -> bool
(** Is the graph empty? *)
val length : 'e t -> int
(** Number of vertices *)
val add : 'e t -> vertex -> 'e -> vertex -> 'e t
(** Add an edge between two vertices *)
val add_seq : 'e t -> (vertex * 'e * vertex) Sequence.t -> 'e t
(** Add the vertices to the graph *)
val next : 'e t -> vertex -> ('e * vertex) Sequence.t
(** Outgoing edges *)
val prev : 'e t -> vertex -> ('e * vertex) Sequence.t
(** Incoming edges *)
val between : 'e t -> vertex -> vertex -> 'e Sequence.t
val iter_vertices : 'e t -> (vertex -> unit) -> unit
val vertices : 'e t -> vertex Sequence.t
(** Iterate on vertices *)
val iter : 'e t -> (vertex * 'e * vertex -> unit) -> unit
val to_seq : 'e t -> (vertex * 'e * vertex) Sequence.t
(** Dump the graph as a sequence of vertices *)
(** {2 Global operations} *)
val roots : 'e t -> vertex Sequence.t
(** Roots, ie vertices with no incoming edges *)
val leaves : 'e t -> vertex Sequence.t
(** Leaves, ie vertices with no outgoing edges *)
val choose : 'e t -> vertex
(** Pick a vertex, or raise Not_found *)
val rev_edge : (vertex * 'e * vertex) -> (vertex * 'e * vertex)
val rev : 'e t -> 'e t
(** Reverse all edges *)
(** {2 Traversals} *)
val bfs : 'e t -> vertex -> (vertex -> unit) -> unit
val bfs_seq : 'e t -> vertex -> vertex Sequence.t
(** Breadth-first search, from given vertex *)
val dfs_full : 'e t ->
?labels:int M.t ref ->
?enter:((vertex * int) list -> unit) ->
?exit:((vertex * int) list -> unit) ->
?tree_edge:((vertex * 'e * vertex) -> unit) ->
?fwd_edge:((vertex * 'e * vertex) -> unit) ->
?back_edge:((vertex * 'e * vertex) -> unit) ->
vertex ->
unit
(** DFS, with callbacks called on each encountered node and edge *)
val dfs : 'e t -> vertex -> ((vertex * int) -> unit) -> unit
(** Depth-first search, from given vertex. Each vertex is labelled
with its index in the traversal order. *)
val is_dag : 'e t -> bool
(** Is the graph acyclic? *)
(** {2 Path operations} *)
type 'e path = (vertex * 'e * vertex) list
val rev_path : 'e path -> 'e path
(** Reverse the path *)
val min_path_full : 'e t ->
?cost:(vertex -> 'e -> vertex -> int) ->
?ignore:(vertex -> bool) ->
goal:(vertex -> 'e path -> bool) ->
vertex ->
vertex * int * 'e path
(** Find the minimal path, from the given [vertex], that does not contain
any vertex satisfying [ignore], and that reaches a vertex
that satisfies [goal]. It raises Not_found if no reachable node
satisfies [goal]. *)
val min_path : 'e t -> cost:('e -> int) -> vertex -> vertex -> 'e path
(** Minimal path from first vertex to second, given the cost function,
or raises Not_found *)
val diameter : 'e t -> vertex -> int
(** Maximal distance between the given vertex, and any other vertex
in the graph that is reachable from it. *)
(** {2 Print to DOT} *)
type attribute = [
| `Color of string
| `Shape of string
| `Weight of int
| `Style of string
| `Label of string
| `Other of string * string
] (** Dot attribute *)
type 'e dot_printer
(** Helper to print a graph to DOT *)
val mk_dot_printer :
print_edge:(vertex -> 'e -> vertex -> attribute list) ->
print_vertex:(vertex -> attribute list) ->
'e dot_printer
(** Create a Dot graph printer. Functions to convert edges and vertices
to Dot attributes must be provided. *)
val pp : 'e dot_printer -> ?vertices:S.t -> name:string ->
Format.formatter ->
(vertex * 'e * vertex) Sequence.t -> unit
(** Pretty print the graph in DOT, on given formatter. Using a sequence
allows to easily select which edges are important,
or to combine several graphs with [Sequence.append].
An optional set of additional vertices to print can be given. *)
end
module Make(V : Map.OrderedType) = struct
module M = Map.Make(V)
module S = Set.Make(V)
type vertex = V.t
type 'e t = 'e node M.t
(** Graph parametrized by a type for edges *)
and 'e node = {
n_vertex : vertex;
n_next : ('e * vertex) list;
n_prev : ('e * vertex) list;
} (** A node of the graph *) } (** A node of the graph *)
let empty = M.empty (** Create an empty graph. The int argument specifies the initial size *)
let empty ?hash ?eq size =
PHashtbl.create ?hash ?eq size
let is_empty graph = M.is_empty graph let mk_v_set ?(size=10) graph =
let open PHashtbl in
empty ~hash:graph.hash ~eq:graph.eq size
let length graph = M.cardinal graph let mk_v_table ?(size=10) graph =
let open PHashtbl in
create ~hash:graph.hash ~eq:graph.eq size
let is_empty graph =
PHashtbl.length graph = 0
let length graph =
PHashtbl.length graph
(** Create an empty node for this vertex *)
let empty_node v = { let empty_node v = {
n_vertex = v; n_vertex = v;
n_next = []; n_next = [];
n_prev = []; n_prev = [];
} }
(** Copy of the graph *)
let copy graph =
PHashtbl.map
(fun v node ->
let node' = empty_node v in
node'.n_prev <- node.n_prev;
node'.n_next <- node.n_next;
node')
graph
let get_node t v =
try PHashtbl.find t v
with Not_found ->
let n = empty_node v in
PHashtbl.replace t v n;
n
let add t v1 e v2 = let add t v1 e v2 =
let n1 = try M.find v1 t with Not_found -> empty_node v1 let n1 = get_node t v1
and n2 = try M.find v2 t with Not_found -> empty_node v2 in and n2 = get_node t v2 in
let n1 = { n1 with n_next = (e,v2) :: n1.n_next; } n1.n_next <- (e,v2) :: n1.n_next;
and n2 = { n2 with n_prev = (e,v1) :: n2.n_prev; } in n2.n_prev <- (e,v1) :: n2.n_prev;
M.add v1 n1 (M.add v2 n2 t) ()
let add_seq t seq = Sequence.fold (fun t (v1,e,v2) -> add t v1 e v2) t seq let add_seq t seq =
Sequence.iter (fun (v1,e,v2) -> add t v1 e v2) seq
let next t v = Sequence.of_list (M.find v t).n_next let next t v =
Sequence.of_list (PHashtbl.find t v).n_next
let prev t v = Sequence.of_list (M.find v t).n_prev let prev t v =
Sequence.of_list (PHashtbl.find t v).n_prev
let between t v1 v2 = let between t v1 v2 =
let edges = Sequence.of_list (M.find v1 t).n_prev in let edges = Sequence.of_list (PHashtbl.find t v1).n_prev in
let edges = Sequence.filter (fun (e, v2') -> V.compare v2 v2' = 0) edges in let edges = Sequence.filter (fun (e, v2') -> (PHashtbl.get_eq t) v2 v2') edges in
Sequence.map fst edges Sequence.map fst edges
(** Call [k] on every vertex *) (** Call [k] on every vertex *)
let iter_vertices t k = M.iter (fun v _ -> k v) t let iter_vertices t k =
PHashtbl.iter (fun v _ -> k v) t
let vertices t = Sequence.from_iter (iter_vertices t) let vertices t =
Sequence.from_iter (iter_vertices t)
(** Call [k] on every edge *) (** Call [k] on every edge *)
let iter t k = let iter t k =
M.iter PHashtbl.iter
(fun v1 node -> List.iter (fun (e, v2) -> k (v1, e, v2)) node.n_next) (fun v1 node -> List.iter (fun (e, v2) -> k (v1, e, v2)) node.n_next)
t t
let to_seq t = Sequence.from_iter (iter t) let to_seq t =
Sequence.from_iter (iter t)
(** {2 Global operations} *) (** {2 Global operations} *)
@ -232,14 +125,21 @@ module Make(V : Map.OrderedType) = struct
Sequence.filter (fun v -> Sequence.is_empty (next g v)) vertices Sequence.filter (fun v -> Sequence.is_empty (next g v)) vertices
(** Pick a vertex, or raise Not_found *) (** Pick a vertex, or raise Not_found *)
let choose g = fst (M.choose g) let choose g =
match Sequence.to_list (Sequence.take 1 (vertices g)) with
| [x] -> x
| [] -> raise Not_found
| _ -> assert false
let rev_edge (v,e,v') = (v',e,v) let rev_edge (v,e,v') = (v',e,v)
(** Reverse all edges *) (** Reverse all edges in the graph, in place *)
let rev g = let rev g =
M.map PHashtbl.iter
(fun node -> {node with n_prev=node.n_next; n_next=node.n_prev}) (fun _ node -> (* reverse the incoming and outgoing edges *)
let next = node.n_next in
node.n_next <- node.n_prev;
node.n_prev <- next)
g g
(** {2 Traversals} *) (** {2 Traversals} *)
@ -247,7 +147,8 @@ module Make(V : Map.OrderedType) = struct
(** Breadth-first search *) (** Breadth-first search *)
let bfs graph first k = let bfs graph first k =
let q = Queue.create () let q = Queue.create ()
and explored = ref (S.singleton first) in and explored = mk_v_set graph in
Hashset.add explored first;
Queue.push first q; Queue.push first q;
while not (Queue.is_empty q) do while not (Queue.is_empty q) do
let v = Queue.pop q in let v = Queue.pop q in
@ -255,35 +156,36 @@ module Make(V : Map.OrderedType) = struct
k v; k v;
(* explore children *) (* explore children *)
Sequence.iter Sequence.iter
(fun (e, v') -> if not (S.mem v' !explored) (fun (e, v') -> if not (Hashset.mem explored v')
then (explored := S.add v' !explored; Queue.push v' q)) then (Hashset.add explored v'; Queue.push v' q))
(next graph v) (next graph v)
done done
let bfs_seq graph first = Sequence.from_iter (fun k -> bfs graph first k) let bfs_seq graph first =
Sequence.from_iter (fun k -> bfs graph first k)
(** DFS, with callbacks called on each encountered node and edge *) (** DFS, with callbacks called on each encountered node and edge *)
let dfs_full graph ?(labels=ref M.empty) let dfs_full graph ?(labels=mk_v_table graph)
?(enter=fun _ -> ()) ?(exit=fun _ -> ()) ?(enter=fun _ -> ()) ?(exit=fun _ -> ())
?(tree_edge=fun _ -> ()) ?(fwd_edge=fun _ -> ()) ?(back_edge=fun _ -> ()) ?(tree_edge=fun _ -> ()) ?(fwd_edge=fun _ -> ()) ?(back_edge=fun _ -> ())
first first
= =
(* next free number for traversal *) (* next free number for traversal *)
let count = ref (-1) in let count = ref (-1) in
M.iter (fun _ i -> count := max i !count) !labels; PHashtbl.iter (fun _ i -> count := max i !count) labels;
(* explore the vertex. trail is the reverse path from v to first *) (* explore the vertex. trail is the reverse path from v to first *)
let rec explore trail v = let rec explore trail v =
if M.mem v !labels then () else begin if PHashtbl.mem labels v then () else begin
(* first time we explore this node! give it an index, put it in trail *) (* first time we explore this node! give it an index, put it in trail *)
let n = (incr count; !count) in let n = (incr count; !count) in
labels := M.add v n !labels; PHashtbl.replace labels v n;
let trail' = (v, n) :: trail in let trail' = (v, n) :: trail in
(* enter the node *) (* enter the node *)
enter trail'; enter trail';
(* explore edges *) (* explore edges *)
Sequence.iter Sequence.iter
(fun (e, v') -> (fun (e, v') ->
try let n' = M.find v' !labels in try let n' = PHashtbl.find labels v' in
if n' < n && List.exists (fun (_,n'') -> n' = n'') trail' if n' < n && List.exists (fun (_,n'') -> n' = n'') trail'
then back_edge (v,e,v') (* back edge, cycle *) then back_edge (v,e,v') (* back edge, cycle *)
else else
@ -313,7 +215,7 @@ module Make(V : Map.OrderedType) = struct
if is_empty g then true if is_empty g then true
else if Sequence.is_empty (roots g) then false (* DAGs have roots *) else if Sequence.is_empty (roots g) then false (* DAGs have roots *)
else try else try
let labels = ref M.empty in let labels = mk_v_table g in
(* do a DFS from each root; any back edge indicates a cycle *) (* do a DFS from each root; any back edge indicates a cycle *)
Sequence.iter Sequence.iter
(fun v -> (fun v ->
@ -325,7 +227,7 @@ module Make(V : Map.OrderedType) = struct
(** {2 Path operations} *) (** {2 Path operations} *)
type 'e path = (vertex * 'e * vertex) list type ('v, 'e) path = ('v * 'e * 'v) list
(** Reverse the path *) (** Reverse the path *)
let rev_path p = let rev_path p =
@ -340,29 +242,30 @@ module Make(V : Map.OrderedType) = struct
any vertex satisfying [ignore], and that reaches a vertex any vertex satisfying [ignore], and that reaches a vertex
that satisfies [goal]. It raises Not_found if no reachable node that satisfies [goal]. It raises Not_found if no reachable node
satisfies [goal]. *) satisfies [goal]. *)
let min_path_full (type e) graph ?(cost=fun _ _ _ -> 1) ?(ignore=fun _ -> false) ~goal v = let min_path_full (type v) (type e) graph
?(cost=fun _ _ _ -> 1) ?(ignore=fun _ -> false) ~goal v =
let module HQ = Leftistheap.Make(struct let module HQ = Leftistheap.Make(struct
type t = vertex * int * e path type t = v * int * (v, e) path
let le (_,i,_) (_,j,_) = i <= j let le (_,i,_) (_,j,_) = i <= j
end) in end) in
let q = ref HQ.empty in let q = ref HQ.empty in
let explored = ref S.empty in let explored = mk_v_set graph in
q := HQ.insert (v, 0, []) !q; q := HQ.insert (v, 0, []) !q;
let best_path = ref (v,0,[]) in let best_path = ref (v,0,[]) in
try try
while not (HQ.is_empty !q) do while not (HQ.is_empty !q) do
let (v, cost_v, path), q' = HQ.extract_min !q in let (v, cost_v, path), q' = HQ.extract_min !q in
q := q'; q := q';
if S.mem v !explored then () (* a shorter path is known *) if Hashset.mem explored v then () (* a shorter path is known *)
else if ignore v then () (* ignore the node. *) else if ignore v then () (* ignore the node. *)
else if goal v path (* shortest path to goal node! *) else if goal v path (* shortest path to goal node! *)
then (best_path := v, cost_v, path; raise ExitBfs) then (best_path := v, cost_v, path; raise ExitBfs)
else begin else begin
explored := S.add v !explored; Hashset.add explored v;
(* explore successors *) (* explore successors *)
Sequence.iter Sequence.iter
(fun (e, v') -> (fun (e, v') ->
if S.mem v' !explored || ignore v' then () if Hashset.mem explored v' || ignore v' then ()
else else
let cost_v' = (cost v e v') + cost_v in let cost_v' = (cost v e v') + cost_v in
let path' = (v',e,v) :: path in let path' = (v',e,v) :: path in
@ -378,7 +281,7 @@ module Make(V : Map.OrderedType) = struct
(** Minimal path from first vertex to second, given the cost function *) (** Minimal path from first vertex to second, given the cost function *)
let min_path graph ~cost v1 v2 = let min_path graph ~cost v1 v2 =
let cost _ e _ = cost e in let cost _ e _ = cost e in
let goal v' _ = V.compare v' v2 = 0 in let goal v' _ = (PHashtbl.get_eq graph) v' v2 in
let _,_,path = min_path_full graph ~cost ~goal v1 in let _,_,path = min_path_full graph ~cost ~goal v1 in
path path
@ -406,35 +309,27 @@ module Make(V : Map.OrderedType) = struct
| `Other of string * string | `Other of string * string
] (** Dot attribute *) ] (** Dot attribute *)
type 'e dot_printer = {
print_edge : vertex -> 'e -> vertex -> attribute list;
print_vertex : vertex -> attribute list;
} (** Dot printer for graphs of type ['e G.t] *)
(** Create a Dot graph printer. Functions to convert edges and vertices
to Dot attributes must be provided. *)
let mk_dot_printer ~print_edge ~print_vertex = {
print_vertex;
print_edge;
}
(** Pretty print the graph in DOT, on given formatter. Using a sequence (** Pretty print the graph in DOT, on given formatter. Using a sequence
allows to easily select which edges are important, allows to easily select which edges are important,
or to combine several graphs with [Sequence.append]. *) or to combine several graphs with [Sequence.append]. *)
let pp printer ?(vertices=S.empty) ~name formatter edges = let pp ~name ?vertices
~(print_edge : 'v -> 'e -> 'v -> attribute list)
~(print_vertex : 'v -> attribute list) formatter (graph : ('v, 'e) t) =
(* map vertex -> unique int *)
let vertices = match vertices with
| Some v -> v
| None -> mk_v_table graph in
(* map from vertices to integers *) (* map from vertices to integers *)
let get_id = let get_id =
let count_map = ref M.empty let count_map = mk_v_table graph
and count = ref 0 in and count = ref 0 in
fun vertex -> fun vertex ->
try M.find vertex !count_map try PHashtbl.find count_map vertex
with Not_found -> with Not_found ->
let n = !count in let n = !count in
incr count; incr count;
count_map := M.add vertex n !count_map; PHashtbl.replace count_map vertex n;
n n
(* accumulate vertices *)
and vertices = ref vertices
(* print an attribute *) (* print an attribute *)
and print_attribute formatter attr = and print_attribute formatter attr =
match attr with match attr with
@ -445,28 +340,27 @@ module Make(V : Map.OrderedType) = struct
| `Label l -> Format.fprintf formatter "label=\"%s\"" l | `Label l -> Format.fprintf formatter "label=\"%s\"" l
| `Other (name, value) -> Format.fprintf formatter "%s=\"%s\"" name value | `Other (name, value) -> Format.fprintf formatter "%s=\"%s\"" name value
in in
(* the name of a vertex *) (* the unique name of a vertex *)
let pp_vertex formatter v = Format.fprintf formatter "vertex_%d" (get_id v) in let pp_vertex formatter v =
Format.fprintf formatter "vertex_%d" (get_id v) in
(* print preamble *) (* print preamble *)
Format.fprintf formatter "@[<v2>digraph %s {@;" name; Format.fprintf formatter "@[<v2>digraph %s {@;" name;
(* print edges *) (* print edges *)
Sequence.iter Sequence.iter
(fun (v1, e, v2) -> (fun (v1, e, v2) ->
(* add v1 and v2 to set of vertices *) let attributes = print_edge v1 e v2 in
vertices := S.add v1 (S.add v2 !vertices);
let attributes = printer.print_edge v1 e v2 in
Format.fprintf formatter " @[<h>%a -> %a [%a];@]@." Format.fprintf formatter " @[<h>%a -> %a [%a];@]@."
pp_vertex v1 pp_vertex v2 pp_vertex v1 pp_vertex v2
(Sequence.pp_seq ~sep:"," print_attribute) (Sequence.of_list attributes)) (Sequence.pp_seq ~sep:"," print_attribute)
edges; (Sequence.of_list attributes))
(to_seq graph);
(* print vertices *) (* print vertices *)
S.iter PHashtbl.iter
(fun v -> (fun v _ ->
let attributes = printer.print_vertex v in let attributes = print_vertex v in
Format.fprintf formatter " @[<h>%a [%a];@]@." pp_vertex v Format.fprintf formatter " @[<h>%a [%a];@]@." pp_vertex v
(Sequence.pp_seq ~sep:"," print_attribute) (Sequence.of_list attributes)) (Sequence.pp_seq ~sep:"," print_attribute) (Sequence.of_list attributes))
!vertices; vertices;
(* close *) (* close *)
Format.fprintf formatter "}@]@;"; Format.fprintf formatter "}@]@;";
() ()
end

140
graph.mli
View file

@ -25,111 +25,119 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 A simple persistent directed graph.} *) (** {1 A simple persistent directed graph.} *)
module type S = sig
(** {2 Basics} *) (** {2 Basics} *)
type vertex type ('v, 'e) t
(** Graph parametrized by a type for vertices, and a type for edges *)
module M : Map.S with type key = vertex val empty : ?hash:('v -> int) -> ?eq:('v -> 'v -> bool) -> int -> ('v, 'e) t
module S : Set.S with type elt = vertex (** Create an empty graph. The int argument specifies the initial size *)
type 'e t val mk_v_set : ?size:int -> ('v, _) t -> 'v Hashset.t
(** Graph parametrized by a type for edges *) (** Create an empty set of vertices *)
val empty : 'e t val mk_v_table : ?size:int -> ('v, _) t -> ('v, 'a) PHashtbl.t
(** Create an empty graph. *) (** Create an empty hashtable of vertices *)
val is_empty : 'e t -> bool val copy : ('v, 'e) t -> ('v, 'e) t
(** Copy the graph *)
val is_empty : (_, _) t -> bool
(** Is the graph empty? *) (** Is the graph empty? *)
val length : 'e t -> int val length : (_, _) t -> int
(** Number of vertices *) (** Number of vertices *)
val add : 'e t -> vertex -> 'e -> vertex -> 'e t val add : ('v,'e) t -> 'v -> 'e -> 'v -> unit
(** Add an edge between two vertices *) (** Add an edge between two vertices *)
val add_seq : 'e t -> (vertex * 'e * vertex) Sequence.t -> 'e t val add_seq : ('v,'e) t -> ('v * 'e * 'v) Sequence.t -> unit
(** Add the vertices to the graph *) (** Add the vertices to the graph *)
val next : 'e t -> vertex -> ('e * vertex) Sequence.t val next : ('v, 'e) t -> 'v -> ('e * 'v) Sequence.t
(** Outgoing edges *) (** Outgoing edges *)
val prev : 'e t -> vertex -> ('e * vertex) Sequence.t val prev : ('v, 'e) t -> 'v -> ('e * 'v) Sequence.t
(** Incoming edges *) (** Incoming edges *)
val between : 'e t -> vertex -> vertex -> 'e Sequence.t val between : ('v, 'e) t -> 'v -> 'v -> 'e Sequence.t
val iter_vertices : 'e t -> (vertex -> unit) -> unit val iter_vertices : ('v, 'e) t -> ('v -> unit) -> unit
val vertices : 'e t -> vertex Sequence.t val vertices : ('v, 'e) t -> 'v Sequence.t
(** Iterate on vertices *) (** Iterate on vertices *)
val iter : 'e t -> (vertex * 'e * vertex -> unit) -> unit val iter : ('v, 'e) t -> ('v * 'e * 'v -> unit) -> unit
val to_seq : 'e t -> (vertex * 'e * vertex) Sequence.t val to_seq : ('v, 'e) t -> ('v * 'e * 'v) Sequence.t
(** Dump the graph as a sequence of vertices *) (** Dump the graph as a sequence of vertices *)
(** {2 Global operations} *) (** {2 Global operations} *)
val roots : 'e t -> vertex Sequence.t val roots : ('v, 'e) t -> 'v Sequence.t
(** Roots, ie vertices with no incoming edges *) (** Roots, ie vertices with no incoming edges *)
val leaves : 'e t -> vertex Sequence.t val leaves : ('v, 'e) t -> 'v Sequence.t
(** Leaves, ie vertices with no outgoing edges *) (** Leaves, ie vertices with no outgoing edges *)
val choose : 'e t -> vertex val choose : ('v, 'e) t -> 'v
(** Pick a vertex, or raise Not_found *) (** Pick a 'v, or raise Not_found *)
val rev_edge : (vertex * 'e * vertex) -> (vertex * 'e * vertex) val rev_edge : ('v * 'e * 'v) -> ('v * 'e * 'v)
val rev : 'e t -> 'e t (** Reverse one edge *)
(** Reverse all edges *)
val rev : ('v, 'e) t -> unit
(** Reverse all edges in the graph, in place *)
(** {2 Traversals} *) (** {2 Traversals} *)
val bfs : 'e t -> vertex -> (vertex -> unit) -> unit val bfs : ('v, 'e) t -> 'v -> ('v -> unit) -> unit
val bfs_seq : 'e t -> vertex -> vertex Sequence.t (** Breadth-first search, from given 'v *)
(** Breadth-first search, from given vertex *)
val dfs_full : 'e t -> val bfs_seq : ('v, 'e) t -> 'v -> 'v Sequence.t
?labels:int M.t ref -> (** Sequence of vertices traversed during breadth-first search *)
?enter:((vertex * int) list -> unit) ->
?exit:((vertex * int) list -> unit) -> val dfs_full : ('v, 'e) t ->
?tree_edge:((vertex * 'e * vertex) -> unit) -> ?labels:('v, int) PHashtbl.t ->
?fwd_edge:((vertex * 'e * vertex) -> unit) -> ?enter:(('v * int) list -> unit) ->
?back_edge:((vertex * 'e * vertex) -> unit) -> ?exit:(('v * int) list -> unit) ->
vertex -> ?tree_edge:(('v * 'e * 'v) -> unit) ->
?fwd_edge:(('v * 'e * 'v) -> unit) ->
?back_edge:(('v * 'e * 'v) -> unit) ->
'v ->
unit unit
(** DFS, with callbacks called on each encountered node and edge *) (** DFS, with callbacks called on each encountered node and edge *)
val dfs : 'e t -> vertex -> ((vertex * int) -> unit) -> unit val dfs : ('v, 'e) t -> 'v -> (('v * int) -> unit) -> unit
(** Depth-first search, from given vertex. Each vertex is labelled (** Depth-first search, from given 'v. Each 'v is labelled
with its index in the traversal order. *) with its index in the traversal order. *)
val is_dag : 'e t -> bool val is_dag : ('v, 'e) t -> bool
(** Is the graph acyclic? *) (** Is the graph acyclic? *)
(** {2 Path operations} *) (** {2 Path operations} *)
type 'e path = (vertex * 'e * vertex) list type ('v, 'e) path = ('v * 'e * 'v) list
(** A path is a list of edges connected by vertices. *)
val rev_path : 'e path -> 'e path val rev_path : ('v, 'e) path -> ('v, 'e) path
(** Reverse the path *) (** Reverse the path *)
val min_path_full : 'e t -> val min_path_full : ('v, 'e) t ->
?cost:(vertex -> 'e -> vertex -> int) -> ?cost:('v -> 'e -> 'v -> int) ->
?ignore:(vertex -> bool) -> ?ignore:('v -> bool) ->
goal:(vertex -> 'e path -> bool) -> goal:('v -> ('v, 'e) path -> bool) ->
vertex -> 'v ->
vertex * int * 'e path 'v * int * ('v, 'e) path
(** Find the minimal path, from the given [vertex], that does not contain (** Find the minimal path, from the given ['v], that does not contain
any vertex satisfying [ignore], and that reaches a vertex any 'v satisfying [ignore], and that reaches a 'v
that satisfies [goal]. It raises Not_found if no reachable node that satisfies [goal]. It raises Not_found if no reachable node
satisfies [goal]. *) satisfies [goal]. *)
val min_path : 'e t -> cost:('e -> int) -> vertex -> vertex -> 'e path val min_path : ('v, 'e) t -> cost:('e -> int) -> 'v -> 'v -> ('v,'e) path
(** Minimal path from first vertex to second, given the cost function, (** Minimal path from first 'v to second, given the cost function,
or raises Not_found *) or raises Not_found *)
val diameter : 'e t -> vertex -> int val diameter : ('v, 'e) t -> 'v -> int
(** Maximal distance between the given vertex, and any other vertex (** Maximal distance between the given 'v, and any other 'v
in the graph that is reachable from it. *) in the graph that is reachable from it. *)
(** {2 Print to DOT} *) (** {2 Print to DOT} *)
@ -143,23 +151,9 @@ module type S = sig
| `Other of string * string | `Other of string * string
] (** Dot attribute *) ] (** Dot attribute *)
type 'e dot_printer val pp : name:string -> ?vertices:('v,int) PHashtbl.t ->
(** Helper to print a graph to DOT *) print_edge:('v -> 'e -> 'v -> attribute list) ->
print_vertex:('v -> attribute list) ->
val mk_dot_printer :
print_edge:(vertex -> 'e -> vertex -> attribute list) ->
print_vertex:(vertex -> attribute list) ->
'e dot_printer
(** Create a Dot graph printer. Functions to convert edges and vertices
to Dot attributes must be provided. *)
val pp : 'e dot_printer -> ?vertices:S.t -> name:string ->
Format.formatter -> Format.formatter ->
(vertex * 'e * vertex) Sequence.t -> unit ('v, 'e) t -> unit
(** Pretty print the graph in DOT, on given formatter. Using a sequence (** Pretty print the graph in DOT, on given formatter. *)
allows to easily select which edges are important,
or to combine several graphs with [Sequence.append].
An optional set of additional vertices to print can be given. *)
end
module Make(V : Map.OrderedType) : S with type vertex = V.t