From 13b34f4fcfaadaf9882992cefbb765b46f0b87c5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 3 Nov 2016 23:25:39 +0100 Subject: [PATCH] simplify and cleanup of CCGraph --- src/data/CCGraph.ml | 316 ++++++++++++++++++------------------------- src/data/CCGraph.mli | 136 ++++++++----------- 2 files changed, 187 insertions(+), 265 deletions(-) diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index b4989f79..67705f64 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -1,27 +1,9 @@ -(* -copyright (c) 2013-2015, simon cruanes -all rights reserved. -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +(* This file is free software, part of containers. See file "license" for more details. *) -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. +(** {1 Simple Graph Interface} *) -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -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. -*) +(** {2 Sequence Helpers} *) type 'a sequence = ('a -> unit) -> unit @@ -51,24 +33,12 @@ end (** {2 Interfaces for graphs} *) -(** Directed graph with vertices of type ['v] and edges of type [e'] *) -type ('v, 'e) t = { - children: 'v -> 'e sequence; - origin: 'e -> 'v; - dest: 'e -> 'v; -} +(** Directed graph with vertices of type ['v] and edges labeled with [e'] *) +type ('v, 'e) t = ('v -> ('e * 'v) sequence) type ('v, 'e) graph = ('v, 'e) t -let make ~origin ~dest f = {origin; dest; children=f; } - -let make_labelled_tuple f = - make ~origin:(fun (x,_,_) -> x) ~dest:(fun (_,_,x) -> x) - (fun v yield -> f v (fun (l,v') -> yield (v,l,v'))) - -let make_tuple f = - make ~origin:fst ~dest:snd - (fun v yield -> f v (fun v' -> yield (v,v'))) +let make (f:'v->('e*'v) sequence): ('v, 'e) t = f (** Mutable bitset for values of type ['v] *) type 'v tag_set = { @@ -171,7 +141,7 @@ let mk_heap ~leq = (** {2 Traversals} *) module Traverse = struct - type 'e path = 'e list + type ('v, 'e) path = ('v * 'e * 'v) list let generic_tag ~tags ~bag ~graph seq = let first = ref true in @@ -185,8 +155,8 @@ module Traverse = struct k x; tags.set_tag x; Seq.iter - (fun e -> bag.push (graph.dest e)) - (graph.children x) + (fun (_,dest) -> bag.push dest) + (graph x) ) done @@ -209,11 +179,10 @@ module Traverse = struct set_tag=(fun (v,_,_) -> tags.set_tag v); } and seq' = Seq.map (fun v -> v, 0, []) seq - and graph' = { - children=(fun (v,d,p) -> Seq.map (fun e -> e, d, p) (graph.children v)); - origin=(fun (e, d, p) -> graph.origin e, d, p); - dest=(fun (e, d, p) -> graph.dest e, d + dist e, e :: p); - } in + and graph' (v,d,p) = + graph v + |> Seq.map (fun (e,v') -> e, (v',d+dist e, (v,e,v')::p)) + in let bag = mk_heap ~leq:(fun (_,d1,_) (_,d2,_) -> d1 <= d2) in generic_tag ~tags:tags' ~bag ~graph:graph' seq' @@ -235,9 +204,9 @@ module Traverse = struct (** A traversal is a sequence of such events *) type ('v,'e) t = - [ `Enter of 'v * int * 'e path (* unique index in traversal, path from start *) + [ `Enter of 'v * int * ('v,'e) path (* unique index in traversal, path from start *) | `Exit of 'v - | `Edge of 'e * edge_kind + | `Edge of 'v * 'e * 'v * edge_kind ] let get_vertex = function @@ -256,20 +225,20 @@ module Traverse = struct | `Edge _ -> None let get_edge = function - | `Edge (e, _) -> Some e + | `Edge (v1,e,v2,_) -> Some (v1,e,v2) | `Enter _ | `Exit _ -> None let get_edge_kind = function - | `Edge (e, k) -> Some (e, k) + | `Edge (v,e,v',k) -> Some (v,e,v',k) | `Enter _ | `Exit _ -> None (* is [v] the origin of some edge in [path]? *) let rec list_mem_ ~eq ~graph v path = match path with | [] -> false - | e :: path' -> - eq v (graph.origin e) || list_mem_ ~eq ~graph v path' + | (v1,_,_) :: path' -> + eq v v1 || list_mem_ ~eq ~graph v path' let dfs_tag ?(eq=(=)) ~tags ~graph seq = let first = ref true in @@ -291,22 +260,22 @@ module Traverse = struct k (`Enter (x, num, path)); bag.push (`Exit x); Seq.iter - (fun e -> bag.push (`Edge (e, e :: path))) - (graph.children x); + (fun (e,v') -> bag.push (`Edge (v,e,v',(v,e,v') :: path))) + (graph x); ) | `Exit x -> k (`Exit x) - | `Edge (e, path) -> - let v = graph.dest e in + | `Edge (v,e,v', path) -> let edge_kind = - if tags.get_tag v - then if list_mem_ ~eq ~graph v path + if tags.get_tag v' + then if list_mem_ ~eq ~graph v' path then `Back else `Cross else ( - bag.push (`Enter (v, path)); + bag.push (`Enter (v', path)); `Forward - ) in - k (`Edge (e, edge_kind)) + ) + in + k (`Edge (v,e,v', edge_kind)) done ) seq @@ -325,7 +294,7 @@ let is_dag ?(tbl=mk_table 128) ~graph vs = Traverse.Event.dfs ~tbl ~graph vs |> Seq.exists_ (function - | `Edge (_, `Back) -> true + | `Edge (_, _, _, `Back) -> true | _ -> false) (** {2 Topological Sort} *) @@ -339,7 +308,7 @@ let topo_sort_tag ?(eq=(=)) ?(rev=false) ~tags ~graph seq = |> Seq.filter_map (function | `Exit v -> Some v - | `Edge (_, `Back) -> raise Has_cycle + | `Edge (_, _, _, `Back) -> raise Has_cycle | `Enter _ | `Edge _ -> None ) @@ -371,39 +340,41 @@ let topo_sort ?eq ?rev ?(tbl=mk_table 128) ~graph seq = (** {2 Lazy Spanning Tree} *) -module LazyTree = struct - type ('v, 'e) t = - | Vertex of 'v * ('e * ('v, 'e) t) list Lazy.t +module Lazy_tree = struct + type ('v, 'e) t = { + vertex: 'v; + children: ('e * ('v, 'e) t) list Lazy.t; + } - let rec map_v f (Vertex (v, l)) = + let make_ vertex children = {vertex; children} + + let rec map_v f {vertex=v; children=l} = let l' = lazy (List.map (fun (e, child) -> e, map_v f child) (Lazy.force l)) in - Vertex (f v, l') + make_ (f v) l' - let rec fold_v f acc t = match t with - | Vertex (v, l) -> - let acc = f acc v in - List.fold_left - (fun acc (_, t') -> fold_v f acc t') - acc - (Lazy.force l) + let rec fold_v f acc {vertex=v; children=l} = + let acc = f acc v in + List.fold_left + (fun acc (_, t') -> fold_v f acc t') + acc + (Lazy.force l) end let spanning_tree_tag ~tags ~graph v = let rec mk_node v = let children = lazy ( Seq.fold - (fun acc e -> - let v' = graph.dest e in + (fun acc (e,v') -> if tags.get_tag v' then acc else ( tags.set_tag v'; (e, mk_node v') :: acc ) - ) [] (graph.children v) + ) [] (graph v) ) in - LazyTree.Vertex (v, children) + Lazy_tree.make_ v children in mk_node v @@ -469,21 +440,20 @@ module SCC = struct Stack.push (`Exit (v, cell)) to_explore; (* explore children *) Seq.iter - (fun e -> Stack.push (`Enter (graph.dest e)) to_explore) - (graph.children v) + (fun (_,v') -> Stack.push (`Enter v') to_explore) + (graph v) ) | `Exit (v, cell) -> (* update [min_id] *) assert cell.on_stack; Seq.iter - (fun e -> - let dest = graph.dest e in + (fun (_,dest) -> (* must not fail, [dest] already explored *) let dest_cell = tbl.find dest in (* same SCC? yes if [dest] points to [cell.v] *) if dest_cell.on_stack then cell.min_id <- min cell.min_id dest_cell.min_id - ) (graph.children v); + ) (graph v); (* pop from stack if SCC found *) if cell.id = cell.min_id then ( let scc = pop_down_to ~id:cell.id [] stack in @@ -602,9 +572,7 @@ module Dot = struct let attrs = attrs_v v in Format.fprintf out "@[%a %a;@]@," pp_vertex v (pp_list pp_attr) attrs | `Exit _ -> () - | `Edge (e, _) -> - let v1 = graph.origin e in - let v2 = graph.dest e in + | `Edge (v1,e,v2,_) -> let attrs = attrs_e e in Format.fprintf out "@[%a -> %a %a;@]@," pp_vertex v1 pp_vertex v2 @@ -633,11 +601,11 @@ end (** {2 Mutable Graph} *) -type ('v, 'e) mut_graph = < +type ('v, 'e) mut_graph = { graph: ('v, 'e) t; - add_edge: 'e -> unit; + add_edge: 'v -> 'e -> 'v -> unit; remove : 'v -> unit; -> +} let mk_mut_tbl (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size = let module Tbl = Hashtbl.Make(struct @@ -646,174 +614,158 @@ let mk_mut_tbl (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size = let equal = eq end) in let tbl = Tbl.create size in - object - method graph = { - origin=(fun (x,_,_) -> x); - dest=(fun (_,_,x) -> x); - children=(fun v k -> - try List.iter k (Tbl.find tbl v) - with Not_found -> () - ); - } - method add_edge (v1,e,v2) = + { + graph=(fun v yield -> + try List.iter yield (Tbl.find tbl v) + with Not_found -> () + ); + add_edge=(fun v1 e v2 -> let l = try Tbl.find tbl v1 with Not_found -> [] in - Tbl.replace tbl v1 ((v1,e,v2)::l) - method remove v = Tbl.remove tbl v - end + Tbl.replace tbl v1 ((e,v2)::l) + ); + remove = (fun v -> Tbl.remove tbl v); + } (** {2 Immutable Graph} *) module type MAP = sig type vertex - type t + type 'a t - val as_graph : t -> (vertex, (vertex * vertex)) graph + val as_graph : 'a t -> (vertex, 'a) graph (** Graph view of the map *) - val empty : t + val empty : 'a t - val add_edge : vertex -> vertex -> t -> t + val add_edge : vertex -> 'a -> vertex -> 'a t -> 'a t - val remove_edge : vertex -> vertex -> t -> t + val remove_edge : vertex -> vertex -> 'a t -> 'a t - val add : vertex -> t -> t + val add : vertex -> 'a t -> 'a t (** Add a vertex, possibly with no outgoing edge *) - val remove : vertex -> t -> t + val remove : vertex -> 'a t -> 'a t (** Remove the vertex and all its outgoing edges. Edges that point to the vertex are {b NOT} removed, they must be manually removed with {!remove_edge} *) - val union : t -> t -> t + val union : 'a t -> 'a t -> 'a t - val vertices : t -> vertex sequence + val vertices : _ t -> vertex sequence - val vertices_l : t -> vertex list + val vertices_l : _ t -> vertex list - val of_list : (vertex * vertex) list -> t + val of_list : (vertex * 'a * vertex) list -> 'a t - val add_list : (vertex * vertex) list -> t -> t + val add_list : (vertex * 'a * vertex) list -> 'a t -> 'a t - val to_list : t -> (vertex * vertex) list + val to_list : 'a t -> (vertex * 'a * vertex) list - val of_seq : (vertex * vertex) sequence -> t + val of_seq : (vertex * 'a * vertex) sequence -> 'a t - val add_seq : (vertex * vertex) sequence -> t -> t + val add_seq : (vertex * 'a * vertex) sequence -> 'a t -> 'a t - val to_seq : t -> (vertex * vertex) sequence + val to_seq : 'a t -> (vertex * 'a * vertex) sequence end -module Map(O : Map.OrderedType) = struct +module Map(O : Map.OrderedType) : MAP with type vertex = O.t = struct module M = Map.Make(O) - module S = Set.Make(O) type vertex = O.t - type t = { - edges: S.t M.t; - vertices: S.t; - } + type 'a t = 'a M.t M.t + (* vertex -> set of (vertex * label) *) - let as_graph m = { - origin=fst; - dest=snd; - children=(fun v yield -> + let as_graph m = + (fun v yield -> try - let set = M.find v m.edges in - S.iter (fun v' -> yield (v, v')) set + let sub = M.find v m in + M.iter (fun v' e -> yield (e, v')) sub with Not_found -> () - ); - } + ) - let empty = {edges=M.empty; vertices=S.empty} + let empty = M.empty - let add_edge v1 v2 m = - let set = try M.find v1 m.edges with Not_found -> S.empty in - let edges = M.add v1 (S.add v2 set) m.edges in - let vertices = S.add v1 (S.add v2 m.vertices) in - { edges; vertices; } + let add_edge v1 e v2 m = + let sub = try M.find v1 m with Not_found -> M.empty in + M.add v1 (M.add v2 e sub) m let remove_edge v1 v2 m = try - let set = S.remove v2 (M.find v1 m.edges) in - if S.is_empty set - then {m with edges=M.remove v1 m.edges} - else {m with edges=M.add v1 set m.edges} + let map = M.remove v2 (M.find v1 m) in + if M.is_empty map + then M.remove v1 m + else M.add v1 map m with Not_found -> m - let add v m = { m with vertices=S.add v m.vertices } + let add v m = + if M.mem v m then m + else M.add v M.empty m - let remove v m = - { edges=M.remove v m.edges; vertices=S.remove v m.vertices } + let remove v m = M.remove v m let union m1 m2 = - {edges=M.merge + M.merge (fun _ s1 s2 -> match s1, s2 with | Some s, None | None, Some s -> Some s | None, None -> assert false - | Some s1, Some s2 -> Some (S.union s1 s2) - ) m1.edges m2.edges; - vertices=S.union m1.vertices m2.vertices - } + | Some s1, Some s2 -> + let s = + M.merge + (fun _ e1 e2 -> match e1, e2 with + | Some _, _ -> e1 + | None, _ -> e2) + s1 s2 + in + Some s) + m1 m2 - let vertices m yield = S.iter yield m.vertices + let vertices m yield = M.iter (fun v _ -> yield v) m - let vertices_l m = S.fold (fun v acc -> v::acc) m.vertices [] + let vertices_l m = M.fold (fun v _ acc -> v::acc) m [] - let add_list l m = List.fold_left (fun m (v1,v2) -> add_edge v1 v2 m) m l + let add_list l m = List.fold_left (fun m (v1,e,v2) -> add_edge v1 e v2 m) m l let of_list l = add_list l empty let to_list m = M.fold - (fun v set acc -> S.fold (fun v' acc -> (v,v')::acc) set acc) - m.edges [] + (fun v map acc -> M.fold (fun v' e acc -> (v,e,v')::acc) map acc) + m [] - let add_seq seq m = Seq.fold (fun m (v1,v2) -> add_edge v1 v2 m) m seq + let add_seq seq m = Seq.fold (fun m (v1,e,v2) -> add_edge v1 e v2 m) m seq let of_seq seq = add_seq seq empty - let to_seq m k = M.iter (fun v set -> S.iter (fun v' -> k(v,v')) set) m.edges + let to_seq m k = M.iter (fun v map -> M.iter (fun v' e -> k(v,e,v')) map) m end (** {2 Misc} *) -let of_list ?(eq=(=)) l = { - origin=fst; - dest=snd; - children=(fun v yield -> List.iter (fun (a,b) -> if eq a v then yield (a,b)) l) -} +let of_list ?(eq=(=)) l = + (fun v yield -> List.iter (fun (a,b) -> if eq a v then yield ((),b)) l) -let of_fun f = { - origin=fst; - dest=snd; - children=(fun v yield -> - let l = f v in - List.iter (fun v' -> yield (v,v')) l - ); -} +let of_fun f = + (fun v yield -> + let l = f v in + List.iter (fun v' -> yield ((),v')) l + ) -let of_hashtbl tbl = { - origin=fst; - dest=snd; - children=(fun v yield -> - try List.iter (fun b -> yield (v, b)) (Hashtbl.find tbl v) +let of_hashtbl tbl = + (fun v yield -> + try List.iter (fun b -> yield ((), b)) (Hashtbl.find tbl v) with Not_found -> () ) -} -let divisors_graph = { - origin=fst; - dest=snd; - children=(fun i -> +let divisors_graph = + (fun i -> (* divisors of [i] that are [>= j] *) let rec divisors j i yield = if j < i then ( - if (i mod j = 0) then yield (i,j); + if (i mod j = 0) then yield ((),j); divisors (j+1) i yield ) in divisors 1 i - ); -} + ) diff --git a/src/data/CCGraph.mli b/src/data/CCGraph.mli index 5ccb00f2..e2baa749 100644 --- a/src/data/CCGraph.mli +++ b/src/data/CCGraph.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2015, simon cruanes -all rights reserved. -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -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. -*) +(* This file is free software, part of containers. See file "license" for more details. *) (** {1 Simple Graph Interface} @@ -45,6 +23,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. @since 0.12 *) +(** {2 Sequence Helpers} *) + type 'a sequence = ('a -> unit) -> unit (** A sequence of items of type ['a], possibly infinite *) @@ -65,41 +45,29 @@ module Seq : sig val to_list : 'a t -> 'a list end -(** {2 Interfaces for graphs} *) +(** {2 Interfaces for graphs} -(** Directed graph with vertices of type ['v] and edges of type [e'] *) -type ('v, 'e) t = { - children: 'v -> 'e sequence; - origin: 'e -> 'v; - dest: 'e -> 'v; -} + This interface is designed for oriented graphs with labels on edges *) + +(** Directed graph with vertices of type ['v] and edges labeled with [e'] *) +type ('v, 'e) t = ('v -> ('e * 'v) sequence) type ('v, 'e) graph = ('v, 'e) t -val make : - origin:('e -> 'v) -> - dest:('e -> 'v) -> - ('v -> 'e sequence) -> ('v, 'e) t -(** Make a graph by providing its fields - @since 0.16 *) +val make : ('v -> ('e * 'v) sequence) -> ('v, 'e) t +(** Make a graph by providing the children function *) -val make_labelled_tuple : - ('v -> ('a * 'v) sequence) -> ('v, ('v * 'a * 'v)) t -(** Make a graph with edges being triples [(origin,label,dest)] - @since 0.16 *) +(** {2 Tags} -val make_tuple : - ('v -> 'v sequence) -> ('v, ('v * 'v)) t -(** Make a graph with edges being pairs [(origin,dest)] - @since 0.16 *) - -(** Mutable tags from values of type ['v] to tags of type [bool] *) + Mutable tags from values of type ['v] to tags of type [bool] *) type 'v tag_set = { get_tag: 'v -> bool; set_tag: 'v -> unit; (** Set tag for the given element *) } -(** Mutable table with keys ['k] and values ['a] *) +(** {2 Table} + + Mutable table with keys ['k] and values ['a] *) type ('k, 'a) table = { mem: 'k -> bool; find: 'k -> 'a; (** @raise Not_found if element not added before *) @@ -134,7 +102,7 @@ val mk_heap: leq:('a -> 'a -> bool) -> 'a bag (** {2 Traversals} *) module Traverse : sig - type 'e path = 'e list + type ('v, 'e) path = ('v * 'e * 'v) list val generic: ?tbl:'v set -> bag:'v bag -> @@ -176,7 +144,7 @@ module Traverse : sig ?dist:('e -> int) -> graph:('v, 'e) t -> 'v sequence -> - ('v * int * 'e path) sequence_once + ('v * int * ('v,'e) path) sequence_once (** Dijkstra algorithm, traverses a graph in increasing distance order. Yields each vertex paired with its distance to the set of initial vertices (the smallest distance needed to reach the node from the initial vertices) @@ -187,7 +155,7 @@ module Traverse : sig tags:'v tag_set -> graph:('v, 'e) t -> 'v sequence -> - ('v * int * 'e path) sequence_once + ('v * int * ('v,'e) path) sequence_once (** {2 More detailed interface} *) module Event : sig @@ -195,16 +163,16 @@ module Traverse : sig (** A traversal is a sequence of such events *) type ('v,'e) t = - [ `Enter of 'v * int * 'e path (* unique index in traversal, path from start *) + [ `Enter of 'v * int * ('v,'e) path (* unique index in traversal, path from start *) | `Exit of 'v - | `Edge of 'e * edge_kind + | `Edge of 'v * 'e * 'v * edge_kind ] val get_vertex : ('v, 'e) t -> ('v * [`Enter | `Exit]) option val get_enter : ('v, 'e) t -> 'v option val get_exit : ('v, 'e) t -> 'v option - val get_edge : ('v, 'e) t -> 'e option - val get_edge_kind : ('v, 'e) t -> ('e * edge_kind) option + val get_edge : ('v, 'e) t -> ('v * 'e * 'v) option + val get_edge_kind : ('v, 'e) t -> ('v * 'e * 'v * edge_kind) option val dfs: ?tbl:'v set -> ?eq:('v -> 'v -> bool) -> @@ -266,9 +234,11 @@ val topo_sort_tag : ?eq:('v -> 'v -> bool) -> (** {2 Lazy Spanning Tree} *) -module LazyTree : sig - type ('v, 'e) t = - | Vertex of 'v * ('e * ('v, 'e) t) list Lazy.t +module Lazy_tree : sig + type ('v, 'e) t = { + vertex: 'v; + children: ('e * ('v, 'e) t) list Lazy.t; + } val map_v : ('a -> 'b) -> ('a, 'e) t -> ('b, 'e) t @@ -278,14 +248,14 @@ end val spanning_tree : ?tbl:'v set -> graph:('v, 'e) t -> 'v -> - ('v, 'e) LazyTree.t + ('v, 'e) Lazy_tree.t (** [spanning_tree ~graph v] computes a lazy spanning tree that has [v] as a root. The table [tbl] is used for the memoization part *) val spanning_tree_tag : tags:'v tag_set -> graph:('v, 'e) t -> 'v -> - ('v, 'e) LazyTree.t + ('v, 'e) Lazy_tree.t (** {2 Strongly Connected Components} *) @@ -364,16 +334,16 @@ end (** {2 Mutable Graph} *) -type ('v, 'e) mut_graph = < +type ('v, 'e) mut_graph = { graph: ('v, 'e) t; - add_edge: 'e -> unit; + add_edge: 'v -> 'e -> 'v -> unit; remove : 'v -> unit; -> +} val mk_mut_tbl : ?eq:('v -> 'v -> bool) -> ?hash:('v -> int) -> int -> - ('v, ('v * 'a * 'v)) mut_graph + ('v, 'a) mut_graph (** Make a new mutable graph from a Hashtbl. Edges are labelled with type ['a] *) (** {2 Immutable Graph} @@ -385,60 +355,60 @@ val mk_mut_tbl : ?eq:('v -> 'v -> bool) -> module type MAP = sig type vertex - type t + type 'a t - val as_graph : t -> (vertex, (vertex * vertex)) graph + val as_graph : 'a t -> (vertex, 'a) graph (** Graph view of the map *) - val empty : t + val empty : 'a t - val add_edge : vertex -> vertex -> t -> t + val add_edge : vertex -> 'a -> vertex -> 'a t -> 'a t - val remove_edge : vertex -> vertex -> t -> t + val remove_edge : vertex -> vertex -> 'a t -> 'a t - val add : vertex -> t -> t + val add : vertex -> 'a t -> 'a t (** Add a vertex, possibly with no outgoing edge *) - val remove : vertex -> t -> t + val remove : vertex -> 'a t -> 'a t (** Remove the vertex and all its outgoing edges. Edges that point to the vertex are {b NOT} removed, they must be manually removed with {!remove_edge} *) - val union : t -> t -> t + val union : 'a t -> 'a t -> 'a t - val vertices : t -> vertex sequence + val vertices : _ t -> vertex sequence - val vertices_l : t -> vertex list + val vertices_l : _ t -> vertex list - val of_list : (vertex * vertex) list -> t + val of_list : (vertex * 'a * vertex) list -> 'a t - val add_list : (vertex * vertex) list -> t -> t + val add_list : (vertex * 'a * vertex) list -> 'a t -> 'a t - val to_list : t -> (vertex * vertex) list + val to_list : 'a t -> (vertex * 'a * vertex) list - val of_seq : (vertex * vertex) sequence -> t + val of_seq : (vertex * 'a * vertex) sequence -> 'a t - val add_seq : (vertex * vertex) sequence -> t -> t + val add_seq : (vertex * 'a * vertex) sequence -> 'a t -> 'a t - val to_seq : t -> (vertex * vertex) sequence + val to_seq : 'a t -> (vertex * 'a * vertex) sequence end module Map(O : Map.OrderedType) : MAP with type vertex = O.t (** {2 Misc} *) -val of_list : ?eq:('v -> 'v -> bool) -> ('v * 'v) list -> ('v, ('v * 'v)) t +val of_list : ?eq:('v -> 'v -> bool) -> ('v * 'v) list -> ('v, unit) t (** [of_list l] makes a graph from a list of pairs of vertices. Each pair [(a,b)] is an edge from [a] to [b]. @param eq equality used to compare vertices *) -val of_hashtbl : ('v, 'v list) Hashtbl.t -> ('v, ('v * 'v)) t +val of_hashtbl : ('v, 'v list) Hashtbl.t -> ('v, unit) t (** [of_hashtbl tbl] makes a graph from a hashtable that maps vertices to lists of children *) -val of_fun : ('v -> 'v list) -> ('v, ('v * 'v)) t +val of_fun : ('v -> 'v list) -> ('v, unit) t (** [of_fun f] makes a graph out of a function that maps a vertex to the list of its children. The function is assumed to be deterministic. *) -val divisors_graph : (int, (int * int)) t +val divisors_graph : (int, unit) t (** [n] points to all its strict divisors *)