diff --git a/test/my-rdbg-tuning.ml b/test/my-rdbg-tuning.ml index 332cf6c89cca61057acdf93d6d3c04a743789a5a..65501bfc54b24c618ec820ec5f4f9ba253ea77b9 100644 --- a/test/my-rdbg-tuning.ml +++ b/test/my-rdbg-tuning.ml @@ -272,14 +272,25 @@ let man () = man(); let p = Topology.read dotfile;; (* shortcuts for dot viewer *) -let dot () = dot p dotfile !e;; -let ne () = neato p dotfile !e;; -let tw () = twopi p dotfile !e;; -let ci () = circo p dotfile !e;; -let fd () = fdp p dotfile !e;; -let sf () = sfdp p dotfile !e;; -let pa () = patchwork p dotfile !e;; -let os () = osage p dotfile !e;; +let d_par () = dot true p dotfile !e;; +let dot_par () = dot true p dotfile !e;; +let ne_par () = neato true p dotfile !e;; +let tw_par () = twopi true p dotfile !e;; +let ci_par () = circo true p dotfile !e;; +let fd_par () = fdp true p dotfile !e;; +let sf_par () = sfdp true p dotfile !e;; +let pa_par () = patchwork true p dotfile !e;; +let os_par () = osage true p dotfile !e;; + +let dot () = dot false p dotfile !e;; +let ne () = neato false p dotfile !e;; +let tw () = twopi false p dotfile !e;; +let ci () = circo false p dotfile !e;; +let fd () = fdp false p dotfile !e;; +let sf () = sfdp false p dotfile !e;; +let pa () = patchwork false p dotfile !e;; +let os () = osage false p dotfile !e;; + (* To be able to choose the different default dot viewer on a per directory basis. To change the graph printer: @@ -410,6 +421,19 @@ let l () = sf: "^(RdbgMain.doc_msg "sf")^" pa: "^(RdbgMain.doc_msg "pa")^" os: "^(RdbgMain.doc_msg "os")^" + + nb: for algorithms that have a field named 'par', you can try + of the following (which only draw the parent arcs) + + d_par: "^(RdbgMain.doc_msg "d")^" (parent arcs only) + ne_par: "^(RdbgMain.doc_msg "ne")^" (parent arcs only) + tw_par: "^(RdbgMain.doc_msg "tw")^" (parent arcs only) + ci_par: "^(RdbgMain.doc_msg "ci")^" (parent arcs only) + fd_par: "^(RdbgMain.doc_msg "fd")^" (parent arcs only) + sf_par: "^(RdbgMain.doc_msg "sf")^" (parent arcs only) + pa_par: "^(RdbgMain.doc_msg "pa")^" (parent arcs only) + os_par: "^(RdbgMain.doc_msg "os")^" (parent arcs only) + + Moving commands [*] sd: "^(RdbgMain.doc_msg "sd")^" nd: "^(RdbgMain.doc_msg "nd")^" diff --git a/test/rdbg-utils/dot.ml b/test/rdbg-utils/dot.ml index 23a446f94e0d47727fd3aee338798ad8bdc7628b..a6aa03c920a832cfaa15227a4a4a765c193a02d8 100644 --- a/test/rdbg-utils/dot.ml +++ b/test/rdbg-utils/dot.ml @@ -99,8 +99,11 @@ let (get_parent_var_name: nodes list -> string) = vn *) -(* Compute a dot from the content of e.data *) -let to_pdf engine par_var g f e = +(* Compute a dot from the content of e.data. if [only_parent], only + display the arcs of the parent, where the parent is an integer held + in a variable named "par". if no such variable exist in the current + algo, no edges are drawn. *) +let to_pdf engine par_var only_parent g f e = let nodes = g.nodes in let (pidl : process list) = get_processes e in let n = List.length pidl in @@ -131,7 +134,7 @@ let to_pdf engine par_var g f e = pid.vars ) in - if (n>200 || ln > 500) && enabled <> "" then + if (n>200 || ln > 5000) && enabled <> "" then Printf.sprintf " %s [shape=point]" pid.name else Printf.sprintf " %s [%slabel=\"%s|{%s%s}\"] " @@ -172,7 +175,10 @@ let to_pdf engine par_var g f e = Str.global_replace (Str.regexp "--") "->" trans_undir_str in let trans_str = (* if trans_dir_str = "" then trans_undir_str else *) - Printf.sprintf "subgraph dir {\n\t%s} + if only_parent then + Printf.sprintf "subgraph dir {\n\t%s} " trans_dir_str + else + Printf.sprintf "subgraph dir {\n\t%s} subgraph undir {\n\t edge [dir=none]\n%s} " trans_dir_str trans_undir_str in Printf.fprintf oc