simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-07 03:35: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

422
graph.ml
View file

@ -23,231 +23,132 @@ 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 = {
n_vertex : 'v;
mutable n_next : ('e * 'v) list;
mutable n_prev : ('e * 'v) list;
} (** A node of the graph *)
type vertex (** Create an empty graph. The int argument specifies the initial size *)
let empty ?hash ?eq size =
PHashtbl.create ?hash ?eq size
module M : Map.S with type key = vertex let mk_v_set ?(size=10) graph =
module S : Set.S with type elt = vertex let open PHashtbl in
empty ~hash:graph.hash ~eq:graph.eq size
type 'e t let mk_v_table ?(size=10) graph =
(** Graph parametrized by a type for edges *) let open PHashtbl in
create ~hash:graph.hash ~eq:graph.eq size
val empty : 'e t let is_empty graph =
(** Create an empty graph. *) PHashtbl.length graph = 0
val is_empty : 'e t -> bool let length graph =
(** Is the graph empty? *) PHashtbl.length graph
val length : 'e t -> int (** Create an empty node for this vertex *)
(** Number of vertices *) let empty_node v = {
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 *)
let empty = M.empty
let is_empty graph = M.is_empty graph
let length graph = M.cardinal graph
let empty_node v = {
n_vertex = v; n_vertex = v;
n_next = []; n_next = [];
n_prev = []; n_prev = [];
} }
let add t v1 e v2 = (** Copy of the graph *)
let n1 = try M.find v1 t with Not_found -> empty_node v1 let copy graph =
and n2 = try M.find v2 t with Not_found -> empty_node v2 in PHashtbl.map
let n1 = { n1 with n_next = (e,v2) :: n1.n_next; } (fun v node ->
and n2 = { n2 with n_prev = (e,v1) :: n2.n_prev; } in let node' = empty_node v in
M.add v1 n1 (M.add v2 n2 t) node'.n_prev <- node.n_prev;
node'.n_next <- node.n_next;
node')
graph
let add_seq t seq = Sequence.fold (fun t (v1,e,v2) -> add t v1 e v2) t seq 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 next t v = Sequence.of_list (M.find v t).n_next let add t v1 e v2 =
let n1 = get_node t v1
and n2 = get_node t v2 in
n1.n_next <- (e,v2) :: n1.n_next;
n2.n_prev <- (e,v1) :: n2.n_prev;
()
let prev t v = Sequence.of_list (M.find v t).n_prev let add_seq t seq =
Sequence.iter (fun (v1,e,v2) -> add t v1 e v2) seq
let between t v1 v2 = let next t v =
let edges = Sequence.of_list (M.find v1 t).n_prev in Sequence.of_list (PHashtbl.find t v).n_next
let edges = Sequence.filter (fun (e, v2') -> V.compare v2 v2' = 0) edges in
let prev t v =
Sequence.of_list (PHashtbl.find t v).n_prev
let between t v1 v2 =
let edges = Sequence.of_list (PHashtbl.find t v1).n_prev 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} *)
(** Roots, ie vertices with no incoming edges *) (** Roots, ie vertices with no incoming edges *)
let roots g = let roots g =
let vertices = vertices g in let vertices = vertices g in
Sequence.filter (fun v -> Sequence.is_empty (prev g v)) vertices Sequence.filter (fun v -> Sequence.is_empty (prev g v)) vertices
(** Leaves, ie vertices with no outgoing edges *) (** Leaves, ie vertices with no outgoing edges *)
let leaves g = let leaves g =
let vertices = vertices g in let vertices = vertices g in
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} *)
(** 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
@ -298,9 +200,9 @@ module Make(V : Map.OrderedType) = struct
in in
explore [] first explore [] first
(** Depth-first search, from given vertex. Each vertex is labelled (** Depth-first search, from given vertex. Each vertex is labelled
with its index in the traversal order. *) with its index in the traversal order. *)
let dfs graph first k = let dfs graph first k =
(* callback upon entering node *) (* callback upon entering node *)
let enter = function let enter = function
| [] -> assert false | [] -> assert false
@ -308,12 +210,12 @@ module Make(V : Map.OrderedType) = struct
in in
dfs_full graph ~enter first dfs_full graph ~enter first
(** Is the graph acyclic? *) (** Is the graph acyclic? *)
let is_dag g = let is_dag g =
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 ->
@ -323,46 +225,47 @@ module Make(V : Map.OrderedType) = struct
with Exit -> with Exit ->
false (* back edge detected! *) false (* back edge detected! *)
(** {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 =
let rec rev acc p = match p with let rec rev acc p = match p with
| [] -> acc | [] -> acc
| (v,e,v')::p' -> rev ((v',e,v)::acc) p' | (v,e,v')::p' -> rev ((v',e,v)::acc) p'
in rev [] p in rev [] p
exception ExitBfs exception ExitBfs
(** Find the minimal path, from the given [vertex], that does not contain (** Find the minimal path, from the given [vertex], that does not contain
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
@ -375,16 +278,16 @@ module Make(V : Map.OrderedType) = struct
with ExitBfs -> (* found shortest satisfying path *) with ExitBfs -> (* found shortest satisfying path *)
!best_path !best_path
(** 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
(** Maximal distance between the given vertex, and any other vertex (** Maximal distance between the given vertex, and any other vertex
in the graph that is reachable from it. *) in the graph that is reachable from it. *)
let diameter graph v = let diameter graph v =
let diameter = ref 0 in let diameter = ref 0 in
(* no path is a goal, but we can use its length to update diameter *) (* no path is a goal, but we can use its length to update diameter *)
let goal _ path = let goal _ path =
@ -395,46 +298,38 @@ module Make(V : Map.OrderedType) = struct
with Not_found -> with Not_found ->
!diameter (* explored every shortest path *) !diameter (* explored every shortest path *)
(** {2 Print to DOT} *) (** {2 Print to DOT} *)
type attribute = [ type attribute = [
| `Color of string | `Color of string
| `Shape of string | `Shape of string
| `Weight of int | `Weight of int
| `Style of string | `Style of string
| `Label of string | `Label of string
| `Other of string * string | `Other of string * string
] (** Dot attribute *) ] (** Dot attribute *)
type 'e dot_printer = { (** Pretty print the graph in DOT, on given formatter. Using a sequence
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
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

166
graph.mli
View file

@ -25,141 +25,135 @@ 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 *)
(** {2 Traversals} *) val rev : ('v, 'e) t -> unit
(** Reverse all edges in the graph, in place *)
val bfs : 'e t -> vertex -> (vertex -> unit) -> unit (** {2 Traversals} *)
val bfs_seq : 'e t -> vertex -> vertex Sequence.t
(** Breadth-first search, from given vertex *)
val dfs_full : 'e t -> val bfs : ('v, 'e) t -> 'v -> ('v -> unit) -> unit
?labels:int M.t ref -> (** Breadth-first search, from given 'v *)
?enter:((vertex * int) list -> unit) ->
?exit:((vertex * int) list -> unit) -> val bfs_seq : ('v, 'e) t -> 'v -> 'v Sequence.t
?tree_edge:((vertex * 'e * vertex) -> unit) -> (** Sequence of vertices traversed during breadth-first search *)
?fwd_edge:((vertex * 'e * vertex) -> unit) ->
?back_edge:((vertex * 'e * vertex) -> unit) -> val dfs_full : ('v, 'e) t ->
vertex -> ?labels:('v, int) PHashtbl.t ->
?enter:(('v * int) list -> unit) ->
?exit:(('v * int) list -> unit) ->
?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} *)
type attribute = [ type attribute = [
| `Color of string | `Color of string
| `Shape of string | `Shape of string
| `Weight of int | `Weight of int
| `Style of string | `Style of string
| `Label of string | `Label of string
| `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