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

simpler and better interface for LazyGraph.Dot;

Browse source 
LazyGraph.Full traversals start from an enum of vertices and not just one vertex
This commit is contained in:
Simon Cruanes 2013-03-20 00:16:53 +01:00
parent 5b4e205591
commit bd99d044f7
2 changed files with 44 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

80
lazyGraph.ml
View file

@ -81,18 +81,23 @@ module type S = sig
| EdgeBackward (* toward the current trail *) | EdgeBackward (* toward the current trail *)
| EdgeTransverse (* toward a totally explored part of the graph *) | EdgeTransverse (* toward a totally explored part of the graph *)
val bfs_full : ?id:int -> ('v, 'e) t -> vertex -> ('v, 'e) traverse_event Enum.t val bfs_full : ?id:int ref -> ?explored:unit H.t ->
('v, 'e) t -> vertex Enum.t -> ('v, 'e) traverse_event Enum.t
(** Lazy traversal in breadth first from a finite set of vertices *)
val dfs_full : ?id:int -> ('v, 'e) t -> vertex -> ('v, 'e) traverse_event Enum.t val dfs_full : ?id:int ref -> ?explored:unit H.t ->
(** Lazy traversal in depth first *) ('v, 'e) t -> vertex Enum.t -> ('v, 'e) traverse_event Enum.t
(** Lazy traversal in depth first from a finite set of vertices *)
end end
(** The traversal functions assign a unique ID to every traversed node *) (** The traversal functions assign a unique ID to every traversed node *)
val bfs : ?id:int -> ('v, 'e) t -> vertex -> (vertex * 'v * int) Enum.t val bfs : ?id:int ref -> ?explored:unit H.t ->
('v, 'e) t -> vertex -> (vertex * 'v * int) Enum.t
(** Lazy traversal in breadth first *) (** Lazy traversal in breadth first *)
val dfs : ?id:int -> ('v, 'e) t -> vertex -> (vertex * 'v * int) Enum.t val dfs : ?id:int ref -> ?explored:unit H.t ->
('v, 'e) t -> vertex -> (vertex * 'v * int) Enum.t
(** Lazy traversal in depth first *) (** Lazy traversal in depth first *)
val enum : ('v, 'e) t -> vertex -> (vertex * 'v) Enum.t * (vertex * 'e * vertex) Enum.t val enum : ('v, 'e) t -> vertex -> (vertex * 'v) Enum.t * (vertex * 'e * vertex) Enum.t
@ -135,12 +140,6 @@ module type S = sig
(** {2 Pretty printing in the DOT (graphviz) format *) (** {2 Pretty printing in the DOT (graphviz) format *)
module Dot : sig module Dot : sig
type graph
(** A DOT graph *)
val empty : string -> graph
(** Create an empty graph with the given name *)
type attribute = [ type attribute = [
| `Color of string | `Color of string
| `Shape of string | `Shape of string
@ -150,18 +149,11 @@ module type S = sig
| `Other of string * string | `Other of string * string
] (** Dot attribute *) ] (** Dot attribute *)
val add : print_edge:(vertex -> 'e -> vertex -> attribute list) -> val pp : name:string -> (attribute list, attribute list) t ->
print_vertex:(vertex -> 'v -> attribute list) -> Format.formatter ->
graph -> vertex Enum.t -> unit
('v,'e) t -> vertex Enum.t -> (** Pretty print the given graph (starting from the given set of vertices)
graph to the channel in DOT format *)
(** Add the given vertices of the graph to the DOT graph *)
val pp : Format.formatter -> graph -> unit
(** Pretty print the graph in DOT, on the given formatter. *)
val to_string : graph -> string
(** Pretty print the graph in a string *)
end end
end end
@ -231,12 +223,10 @@ module Make(X : HASHABLE) : S with type vertex = X.t = struct
| EdgeBackward (* toward the current trail *) | EdgeBackward (* toward the current trail *)
| EdgeTransverse (* toward a totally explored part of the graph *) | EdgeTransverse (* toward a totally explored part of the graph *)
let bfs_full ?(id=0) graph v = let bfs_full ?(id=ref 0) ?(explored=H.create 5) graph vertices =
let enum () = let enum () =
let q = Queue.create () in (* queue of nodes to explore *) let q = Queue.create () in (* queue of nodes to explore *)
Queue.push (v,[]) q; Enum.iter (fun v -> Queue.push (v,[]) q) vertices;
let explored = H.create 5 in (* explored nodes *)
let n = ref id in (* index of vertices *)
let rec next () = let rec next () =
if Queue.is_empty q then raise Enum.EOG else if Queue.is_empty q then raise Enum.EOG else
let v', path = Queue.pop q in let v', path = Queue.pop q in
@ -253,8 +243,8 @@ module Make(X : HASHABLE) : S with type vertex = X.t = struct
Queue.push (v'',path') q) Queue.push (v'',path') q)
edges; edges;
(* return this vertex *) (* return this vertex *)
let i = !n in let i = !id in
incr n; incr id;
Enum.of_list [EnterVertex (v', label, i, path); ExitVertex v'] Enum.of_list [EnterVertex (v', label, i, path); ExitVertex v']
end end
in next in next
@ -271,12 +261,10 @@ module Make(X : HASHABLE) : S with type vertex = X.t = struct
(X.equal v v') || (X.equal v v'') || (mem_path path' v) (X.equal v v') || (X.equal v v'') || (mem_path path' v)
| [] -> false | [] -> false
let dfs_full ?(id=0) graph v = let dfs_full ?(id=ref 0) ?(explored=H.create 5) graph vertices =
fun () -> fun () ->
let s = Stack.create () in (* stack of nodes to explore *) let s = Stack.create () in (* stack of nodes to explore *)
Stack.push (DFSEnter (v,[])) s; Enum.iter (fun v -> Stack.push (DFSEnter (v,[])) s) vertices;
let explored = H.create 5 in (* explored nodes *)
let n = ref id in (* index of vertices *)
let rec next () = let rec next () =
if Stack.is_empty s then raise Enum.EOG else if Stack.is_empty s then raise Enum.EOG else
match Stack.pop s with match Stack.pop s with
@ -296,8 +284,8 @@ module Make(X : HASHABLE) : S with type vertex = X.t = struct
Stack.push (DFSFollowEdge ((v'', e, v') :: path)) s) Stack.push (DFSFollowEdge ((v'', e, v') :: path)) s)
edges; edges;
(* return this vertex *) (* return this vertex *)
let i = !n in let i = !id in
incr n; incr id;
EnterVertex (v', label, i, path) EnterVertex (v', label, i, path)
end end
| DFSFollowEdge [] -> assert false | DFSFollowEdge [] -> assert false
@ -315,19 +303,19 @@ module Make(X : HASHABLE) : S with type vertex = X.t = struct
in next in next
end end
let bfs ?id graph v = let bfs ?id ?explored graph v =
Enum.filterMap Enum.filterMap
(function (function
| Full.EnterVertex (v, l, i, _) -> Some (v, l, i) | Full.EnterVertex (v, l, i, _) -> Some (v, l, i)
| _ -> None) | _ -> None)
(Full.bfs_full ?id graph v) (Full.bfs_full ?id ?explored graph (Enum.singleton v))
let dfs ?id graph v = let dfs ?id ?explored graph v =
Enum.filterMap Enum.filterMap
(function (function
| Full.EnterVertex (v, l, i, _) -> Some (v, l, i) | Full.EnterVertex (v, l, i, _) -> Some (v, l, i)
| _ -> None) | _ -> None)
(Full.dfs_full ?id graph v) (Full.dfs_full ?id ?explored graph (Enum.singleton v))
let enum graph v = (Enum.empty, Enum.empty) (* TODO *) let enum graph v = (Enum.empty, Enum.empty) (* TODO *)
@ -360,10 +348,6 @@ module Make(X : HASHABLE) : S with type vertex = X.t = struct
end end
module Dot = struct module Dot = struct
type graph = Graph of string (* TODO *)
let empty name = Graph name
type attribute = [ type attribute = [
| `Color of string | `Color of string
| `Shape of string | `Shape of string
@ -373,14 +357,8 @@ module Make(X : HASHABLE) : S with type vertex = X.t = struct
| `Other of string * string | `Other of string * string
] (** Dot attribute *) ] (** Dot attribute *)
let add ~print_edge ~print_vertex graph g vertices = graph (* TODO *) let pp ~name graph formatter vertices =
failwith "not implemented"
let pp formatter graph = failwith "not implemented"
let to_string graph =
let b = Buffer.create 64 in
Format.bprintf b "%a@?" pp graph;
Buffer.contents b
end end
end end

39
lazyGraph.mli
View file

@ -85,19 +85,23 @@ module type S = sig
| EdgeBackward (* toward the current trail *) | EdgeBackward (* toward the current trail *)
| EdgeTransverse (* toward a totally explored part of the graph *) | EdgeTransverse (* toward a totally explored part of the graph *)
val bfs_full : ?id:int -> ('v, 'e) t -> vertex -> ('v, 'e) traverse_event Enum.t val bfs_full : ?id:int ref -> ?explored:unit H.t ->
(** Lazy traversal in breadth first *) ('v, 'e) t -> vertex Enum.t -> ('v, 'e) traverse_event Enum.t
(** Lazy traversal in breadth first from a finite set of vertices *)
val dfs_full : ?id:int -> ('v, 'e) t -> vertex -> ('v, 'e) traverse_event Enum.t val dfs_full : ?id:int ref -> ?explored:unit H.t ->
(** Lazy traversal in depth first *) ('v, 'e) t -> vertex Enum.t -> ('v, 'e) traverse_event Enum.t
(** Lazy traversal in depth first from a finite set of vertices *)
end end
(** The traversal functions assign a unique ID to every traversed node *) (** The traversal functions assign a unique ID to every traversed node *)
val bfs : ?id:int -> ('v, 'e) t -> vertex -> (vertex * 'v * int) Enum.t val bfs : ?id:int ref -> ?explored:unit H.t ->
('v, 'e) t -> vertex -> (vertex * 'v * int) Enum.t
(** Lazy traversal in breadth first *) (** Lazy traversal in breadth first *)
val dfs : ?id:int -> ('v, 'e) t -> vertex -> (vertex * 'v * int) Enum.t val dfs : ?id:int ref -> ?explored:unit H.t ->
('v, 'e) t -> vertex -> (vertex * 'v * int) Enum.t
(** Lazy traversal in depth first *) (** Lazy traversal in depth first *)
val enum : ('v, 'e) t -> vertex -> (vertex * 'v) Enum.t * (vertex * 'e * vertex) Enum.t val enum : ('v, 'e) t -> vertex -> (vertex * 'v) Enum.t * (vertex * 'e * vertex) Enum.t
@ -140,12 +144,6 @@ module type S = sig
(** {2 Pretty printing in the DOT (graphviz) format *) (** {2 Pretty printing in the DOT (graphviz) format *)
module Dot : sig module Dot : sig
type graph
(** A DOT graph *)
val empty : string -> graph
(** Create an empty graph with the given name *)
type attribute = [ type attribute = [
| `Color of string | `Color of string
| `Shape of string | `Shape of string
@ -155,18 +153,11 @@ module type S = sig
| `Other of string * string | `Other of string * string
] (** Dot attribute *) ] (** Dot attribute *)
val add : print_edge:(vertex -> 'e -> vertex -> attribute list) -> val pp : name:string -> (attribute list, attribute list) t ->
print_vertex:(vertex -> 'v -> attribute list) -> Format.formatter ->
graph -> vertex Enum.t -> unit
('v,'e) t -> vertex Enum.t -> (** Pretty print the given graph (starting from the given set of vertices)
graph to the channel in DOT format *)
(** Add the given vertices of the graph to the DOT graph *)
val pp : Format.formatter -> graph -> unit
(** Pretty print the graph in DOT, on the given formatter. *)
val to_string : graph -> string
(** Pretty print the graph in a string *)
end end
end end