Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 319 lines (268 sloc) 9.231 kb
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
1 (*
2 * Please imagine a long and boring gnu-style copyright notice
3 * appearing just here.
4 *)
5
6 open Common
7
8 (*****************************************************************************)
9 (* Purpose *)
10 (*****************************************************************************)
11
4759e20 * main_pm_depend.ml: experiment with the GUESS tool
pad authored
12 (* A module/package dependency visualizer generating data for
13 * different graph visualizer (e.g. gephi, guess).
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
14 *
15 * todo? have a backend for graphviz?
78f625e phylomel: started migration to pad style
pad authored
16 * todo? use phylomel? and cairo?
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
17 *
18 * usage:
4759e20 * main_pm_depend.ml: experiment with the GUESS tool
pad authored
19 * $ pm_depend [-lang X] [-with-extern] [-depth n] -o filename /path/to/dir
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
20 *)
21
22 (*****************************************************************************)
23 (* Flags *)
24 (*****************************************************************************)
25
26 (* In addition to flags that can be tweaked via -xxx options (cf the
27 * full list of options in the "the options" section below), this
28 * program also depends on external files ?
29 *)
30
31 let verbose = ref false
32
33 let with_extern = ref false
34 let package_depth = ref 0
35
36 let lang = ref "ml"
37
4759e20 * main_pm_depend.ml: experiment with the GUESS tool
pad authored
38 (* todo? gephi mode? that set default output file to something different? *)
39 let output_file = ref "/tmp/pm.gdf"
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
40
41 (* action mode *)
42 let action = ref ""
43
44 (*****************************************************************************)
45 (* Some debugging functions *)
46 (*****************************************************************************)
47
48 (*****************************************************************************)
49 (* Helpers *)
50 (*****************************************************************************)
51
52 (*****************************************************************************)
53 (* Language specific *)
54 (*****************************************************************************)
55
56 let rec dependencies_of_files_or_dirs lang xs =
57 let verbose = !verbose in
58 match lang, xs with
59 | "ml", [dir] ->
60 Graph_modules_packages_ml.dependencies
61 ~verbose
62 ~with_extern:!with_extern
63 ~package_depth:!package_depth
64 dir
65 | _ -> failwith ("language not supported: " ^ lang)
66
67 (*****************************************************************************)
68 (* Main action *)
69 (*****************************************************************************)
70
4759e20 * main_pm_depend.ml: experiment with the GUESS tool
pad authored
71 module G = Graph
72 let to_gdf g ~str_of_node ~output =
73 Common.with_open_outfile output (fun (pr_no_nl, _chan) ->
74 let nodes = G.nodes g in
75 let pr s = pr_no_nl (s ^ "\n") in
76
77
78 let node_name_of_n n =
79 let s = str_of_node n in
80 let (d,b,e) = Common.dbe_of_filename_noext_ok s in
81
82 match e with
83 | "ml" ->
84 let str = String.capitalize b in
85 if str = "Math" then "Math_xxx"
86 else str
87 | "mli" -> b ^ "." ^ e
88 | "NOEXT" ->
89 (* can be directory like external/foo *)
90 s ^ "/"
91 | _ ->
92 failwith (spf "PB: weird node: %s" s);
93 in
94
95 let dirs_of_n n =
96 let s = str_of_node n in
97 let (d,b,e) = Common.dbe_of_filename_noext_ok s in
98 let xs = Common.split "/" d in
99 match xs with
100 | x::y::xs -> x, x ^ "/" ^ y, d
101 | [x] -> x, x ^ "/_TOP_", d
102 | [] -> "_TOP_", "_TOP_", d
103 in
104
105 (* check that no ambiguity? *)
106 pr (spf "nodedef> name, dir1 varchar(200), dir2 varchar(200), dir varchar(200)");
107 nodes +> List.iter (fun n ->
108 let (dir1, dir2, dir) = dirs_of_n n in
109 (* don't add extra space for attributes, otherwise no match when
110 * use ==
111 *)
112 pr (spf "%s,%s,%s,%s" (node_name_of_n n) dir1 dir2 dir);
113 );
114 pr (spf "edgedef> node1,node2,directed");
115 nodes +> List.iter (fun n1 ->
116 let succ = G.succ n1 g in
117 succ +> List.iter (fun n2 ->
118 pr (spf "%s,%s,true" (node_name_of_n n1) (node_name_of_n n2));
119 )
120 );
121 ()
122 )
123
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
124 let main_action xs =
125 let g = dependencies_of_files_or_dirs !lang xs in
126 pr2 (spf "Writing data in %s" !output_file);
4759e20 * main_pm_depend.ml: experiment with the GUESS tool
pad authored
127
128 to_gdf g ~str_of_node:(fun s -> s) ~output:!output_file;
129 (*
e7dc7fe misc
pad authored
130 g +> Graph_gephi.graph_to_gefx
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
131 ~str_of_node:(fun s -> s)
132 ~tree:None
133 ~weight_edges:None
134 ~output:!output_file;
4759e20 * main_pm_depend.ml: experiment with the GUESS tool
pad authored
135 *)
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
136 ()
137
138 (*****************************************************************************)
139 (* Extra Actions *)
140 (*****************************************************************************)
141
8bf36da pm_depend now use phylomel, test
pad authored
142 open Vec2
143 open BarnesHut
144
145 let update_state n fs bs fig =
146 let delta = 0.05 in
147
148 (* Update forces *)
149 ForceDirectedLayout.do_calc_forces fs bs fig;
150
151 (* Euler integration on each body *)
152 for i=0 to n - 1 do
153 let b = bs.(i) in
154 let f = fs.(i) in
155 b.p.x <-
156 b.p.x +. delta *. b.v.x +. 1./.2. *. delta *. delta *. f.x;
157 b.p.y <-
158 b.p.y +. delta *. b.v.y +. 1./.2. *. delta *. delta *. f.y;
159 b.v.x <- b.v.x +. delta *. f.x;
160 b.v.y <- b.v.y +. delta *. f.y;
161 f.x <- 0.;
162 f.y <- 0.
163 done
164
165 let test_phylomel geno_file =
166
167 let svg_file = "/tmp/foo.svg" in
168 (* We create four things :
169 * - genotypes collection
170 * - distance matrix
171 * - minimum spanning tree
172 * - figure (graphical tree)
173 *)
174 let collec =
175 Genotypes.read_file geno_file +> Genotypes.remove_duplicates
176 in
177 let dmat = GenoMat.create collec in
178 let tree = Tree.prim_complete collec dmat in
c4fa3d2 phylomel: misc
pad authored
179 (*
180 let dist_mat =
181 [|
182 [||];
183 [|1|];
184 [|1;2|];
185 |]
186 in
187 let adj_mat =
188 [|
189 [||];
190 [|true|];
191 [|true;false|];
192 |]
193 in
194
195 let tree = Tree.create adj_mat dist_mat in
196 let infos = [|"n0"; "n1"; "n2"|] in
197 *)
8bf36da pm_depend now use phylomel, test
pad authored
198
199 let fig = Phylogram.radial_layout ~reframe:false 800. tree in
200
201 (* Creates force array, bodies *)
202 let n = Phylogram.size fig in
203 let fs = Array.init n (fun _ -> Vec2.null ()) in
2e15a18 * main_pm_depend.ml: misc
pad authored
204 let bs = Array.map ForceDirectedLayout.body_of_pos fig.Phylogram.ps in
8bf36da pm_depend now use phylomel, test
pad authored
205
206 for i=0 to 2000 do
207 update_state n fs bs fig
208 done;
209
210 let x0, y0 = (10.,10.) in
2e15a18 * main_pm_depend.ml: misc
pad authored
211 Phylogram.unsafe_reframe (10.,10.) fig.Phylogram.ps;
212 Phylogram.unsafe_crop_width (800.-.2.*.x0) fig.Phylogram.ps;
213 fig.Phylogram.h <- Phylogram.height fig.Phylogram.ps +. 2. *. y0;
8bf36da pm_depend now use phylomel, test
pad authored
214
215 (* let x0 = 10. in *)
216 (* unsafe_reframe (10., 10.) fig.ps; *)
217 (* unsafe_crop_width (800.-.2.*.x0) fig.ps; *)
c4fa3d2 phylomel: misc
pad authored
218
219 let nodeinfo =
220 (fun i -> Genotype.description collec.Genotypes.genos.(i))
221 (* (fun i -> infos.(i)) *)
222 in
8bf36da pm_depend now use phylomel, test
pad authored
223
c4fa3d2 phylomel: misc
pad authored
224 Phylogram.write_svg_file nodeinfo fig svg_file;
8bf36da pm_depend now use phylomel, test
pad authored
225 ()
226
227
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
228 (* ---------------------------------------------------------------------- *)
8bf36da pm_depend now use phylomel, test
pad authored
229 let extra_actions () = [
2e15a18 * main_pm_depend.ml: misc
pad authored
230 "-test_phylomel", " <geno file>",
8bf36da pm_depend now use phylomel, test
pad authored
231 Common.mk_action_1_arg test_phylomel;
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
232 ]
233
234 (*****************************************************************************)
235 (* The options *)
236 (*****************************************************************************)
237
238 let all_actions () =
947293b * main_pm_depend.ml: misc
pad authored
239 Test_parsing_ml.actions()++
8bf36da pm_depend now use phylomel, test
pad authored
240 extra_actions () ++
7966cbd * lang_ml/analyze/graph_modules_packages_ml.ml: new file, also main_pm_d...
pad authored
241 []
242
243 let options () =
244 [
245 "-with_extern", Arg.Set with_extern,
246 " includes external references";
247 "-package_mode", Arg.Set_int package_depth,
248 " <n> project at depth n";
249 "-verbose", Arg.Set verbose,
250 " ";
251 "-lang", Arg.Set_string lang,
252 (spf " <str> choose language (default = %s)" !lang);
253 "-o", Arg.Set_string output_file,
254 (spf " <file> default = %s" !output_file);
255 ] ++
256 Common.options_of_actions action (all_actions()) ++
257 Common.cmdline_flags_devel () ++
258 Common.cmdline_flags_other () ++
259 [
260 "-version", Arg.Unit (fun () ->
261 pr2 (spf "pm_depend version: %s" Config.version);
262 exit 0;
263 ),
264 " guess what";
265 (* this can not be factorized in Common *)
266 "-date", Arg.Unit (fun () ->
267 pr2 "version: $Date: 2011/09/01 00:44:57 $";
268 raise (Common.UnixExit 0)
269 ),
270 " guess what";
271 ] ++
272 []
273
274 (*****************************************************************************)
275 (* Main entry point *)
276 (*****************************************************************************)
277
278 let main () =
279 (* Common_extra.set_link(); *)
280 let usage_msg =
281 "Usage: " ^ basename Sys.argv.(0) ^
282 " [options] <file or dir> " ^ "\n" ^ "Options are:"
283 in
284 (* does side effect on many global flags *)
285 let args = Common.parse_options (options()) usage_msg Sys.argv in
286
287 (* must be done after Arg.parse, because Common.profile is set by it *)
288 Common.profile_code "Main total" (fun () ->
289 (match args with
290 (* --------------------------------------------------------- *)
291 (* actions, useful to debug subpart *)
292 (* --------------------------------------------------------- *)
293 | xs when List.mem !action (Common.action_list (all_actions())) ->
294 Common.do_action !action xs (all_actions())
295
296 | _ when not (Common.null_string !action) ->
297 failwith ("unrecognized action or wrong params: " ^ !action)
298
299 (* --------------------------------------------------------- *)
300 (* main entry *)
301 (* --------------------------------------------------------- *)
302 | x::xs ->
303 main_action (x::xs)
304
305 (* --------------------------------------------------------- *)
306 (* empty entry *)
307 (* --------------------------------------------------------- *)
308 | [] ->
309 Common.usage usage_msg (options());
310 failwith "too few arguments"
311 )
312 )
313
314 (*****************************************************************************)
315 let _ =
316 Common.main_boilerplate (fun () ->
317 main ();
318 )
Something went wrong with that request. Please try again.