mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
optional argument ~eq to CCGraph.Dot.pp
This commit is contained in:
parent
4409f79ed4
commit
03a29d72cb
2 changed files with 12 additions and 8 deletions
|
|
@ -519,10 +519,11 @@ module Dot = struct
|
||||||
|
|
||||||
let pp_list pp_x out l =
|
let pp_list pp_x out l =
|
||||||
Format.pp_print_string out "[";
|
Format.pp_print_string out "[";
|
||||||
List.iteri (fun i x ->
|
List.iteri
|
||||||
|
(fun i x ->
|
||||||
if i > 0 then Format.fprintf out ",@;";
|
if i > 0 then Format.fprintf out ",@;";
|
||||||
pp_x out x
|
pp_x out x)
|
||||||
) l;
|
l;
|
||||||
Format.pp_print_string out "]"
|
Format.pp_print_string out "]"
|
||||||
|
|
||||||
type vertex_state = {
|
type vertex_state = {
|
||||||
|
|
@ -533,6 +534,7 @@ module Dot = struct
|
||||||
(** Print an enum of Full.traverse_event *)
|
(** Print an enum of Full.traverse_event *)
|
||||||
let pp_seq
|
let pp_seq
|
||||||
?(tbl=mk_table 128)
|
?(tbl=mk_table 128)
|
||||||
|
?(eq=(=))
|
||||||
?(attrs_v=fun _ -> [])
|
?(attrs_v=fun _ -> [])
|
||||||
?(attrs_e=fun _ -> [])
|
?(attrs_e=fun _ -> [])
|
||||||
?(name="graph")
|
?(name="graph")
|
||||||
|
|
@ -570,18 +572,18 @@ module Dot = struct
|
||||||
get_tag=vertex_explored;
|
get_tag=vertex_explored;
|
||||||
set_tag=set_explored; (* allocate new ID *)
|
set_tag=set_explored; (* allocate new ID *)
|
||||||
} in
|
} in
|
||||||
let events = Traverse.Event.dfs_tag ~tags ~graph seq in
|
let events = Traverse.Event.dfs_tag ~eq ~tags ~graph seq in
|
||||||
Seq.iter
|
Seq.iter
|
||||||
(function
|
(function
|
||||||
| `Enter (v, _n, _path) ->
|
| `Enter (v, _n, _path) ->
|
||||||
let attrs = attrs_v v in
|
let attrs = attrs_v v in
|
||||||
Format.fprintf out " @[<h>%a %a;@]@." pp_vertex v (pp_list pp_attr) attrs
|
Format.fprintf out "@[<h>%a %a;@]@," pp_vertex v (pp_list pp_attr) attrs
|
||||||
| `Exit _ -> ()
|
| `Exit _ -> ()
|
||||||
| `Edge (e, _) ->
|
| `Edge (e, _) ->
|
||||||
let v1 = graph.origin e in
|
let v1 = graph.origin e in
|
||||||
let v2 = graph.dest e in
|
let v2 = graph.dest e in
|
||||||
let attrs = attrs_e e in
|
let attrs = attrs_e e in
|
||||||
Format.fprintf out " @[<h>%a -> %a %a;@]@."
|
Format.fprintf out "@[<h>%a -> %a %a;@]@,"
|
||||||
pp_vertex v1 pp_vertex v2
|
pp_vertex v1 pp_vertex v2
|
||||||
(pp_list pp_attr)
|
(pp_list pp_attr)
|
||||||
attrs
|
attrs
|
||||||
|
|
@ -590,8 +592,8 @@ module Dot = struct
|
||||||
Format.fprintf out "}@]@;@?";
|
Format.fprintf out "}@]@;@?";
|
||||||
()
|
()
|
||||||
|
|
||||||
let pp ?tbl ?attrs_v ?attrs_e ?name ~graph fmt v =
|
let pp ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt v =
|
||||||
pp_seq ?tbl ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v)
|
pp_seq ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v)
|
||||||
|
|
||||||
let with_out filename f =
|
let with_out filename f =
|
||||||
let oc = open_out filename in
|
let oc = open_out filename in
|
||||||
|
|
|
||||||
|
|
@ -307,6 +307,7 @@ module Dot : sig
|
||||||
(** Hidden state associated to a vertex *)
|
(** Hidden state associated to a vertex *)
|
||||||
|
|
||||||
val pp : ?tbl:('v,vertex_state) table ->
|
val pp : ?tbl:('v,vertex_state) table ->
|
||||||
|
?eq:('v -> 'v -> bool) ->
|
||||||
?attrs_v:('v -> attribute list) ->
|
?attrs_v:('v -> attribute list) ->
|
||||||
?attrs_e:('e -> attribute list) ->
|
?attrs_e:('e -> attribute list) ->
|
||||||
?name:string ->
|
?name:string ->
|
||||||
|
|
@ -320,6 +321,7 @@ module Dot : sig
|
||||||
@param name name of the graph *)
|
@param name name of the graph *)
|
||||||
|
|
||||||
val pp_seq : ?tbl:('v,vertex_state) table ->
|
val pp_seq : ?tbl:('v,vertex_state) table ->
|
||||||
|
?eq:('v -> 'v -> bool) ->
|
||||||
?attrs_v:('v -> attribute list) ->
|
?attrs_v:('v -> attribute list) ->
|
||||||
?attrs_e:('e -> attribute list) ->
|
?attrs_e:('e -> attribute list) ->
|
||||||
?name:string ->
|
?name:string ->
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue