grew_html.ml 38.5 KB
Newer Older
bguillaum's avatar
bguillaum committed
1 2 3 4 5 6 7 8 9 10
(**********************************************************************************)
(*    Libcaml-grew - a Graph Rewriting library dedicated to NLP applications      *)
(*                                                                                *)
(*    Copyright 2011-2013 Inria, Université de Lorraine                           *)
(*                                                                                *)
(*    Webpage: http://grew.loria.fr                                               *)
(*    License: CeCILL (see LICENSE folder or "http://www.cecill.info")            *)
(*    Authors: see AUTHORS file                                                   *)
(**********************************************************************************)

bguillaum's avatar
bguillaum committed
11
open Printf
bguillaum's avatar
bguillaum committed
12
open Log
bguillaum's avatar
bguillaum committed
13

bguillaum's avatar
bguillaum committed
14
open Grew_base
bguillaum's avatar
bguillaum committed
15
open Grew_types
bguillaum's avatar
bguillaum committed
16
open Grew_ast
17
open Grew_domain
bguillaum's avatar
bguillaum committed
18
open Grew_graph
bguillaum's avatar
bguillaum committed
19 20 21
open Grew_rule
open Grew_grs

bguillaum's avatar
bguillaum committed
22
let html_header ?css_file ?title ?(add_lines=[]) buff =
bguillaum's avatar
bguillaum committed
23 24 25 26 27 28
  let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in

  wnl "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">";

  wnl "<html>";
  wnl "  <head>";
bguillaum's avatar
bguillaum committed
29
  wnl "    <meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">";
bguillaum's avatar
bguillaum committed
30 31 32 33
  (match css_file with
    | Some file -> wnl "    <link rel=\"stylesheet\" href=\"%s\" type=\"text/css\">" file
    | None -> ()
  );
bguillaum's avatar
bguillaum committed
34 35 36 37
  (match title with
    | Some t -> wnl "    <title>%s</title>" (Str.global_replace (Str.regexp "#") " " t)
    | None -> ()
  );
bguillaum's avatar
bguillaum committed
38
  List.iter (fun line -> wnl "    %s" line) add_lines;
bguillaum's avatar
bguillaum committed
39
  wnl "  </head>";
bguillaum's avatar
bguillaum committed
40

bguillaum's avatar
bguillaum committed
41
(* ================================================================================*)
bguillaum's avatar
bguillaum committed
42
module Html_doc = struct
pj2m's avatar
pj2m committed
43

bguillaum's avatar
bguillaum committed
44
  let string_of_concat_item = function
45
    | Ast.Qfn_item id -> sprintf "%s" (Ast.dump_feature_ident id)
bguillaum's avatar
bguillaum committed
46 47
    | Ast.String_item s -> sprintf "\"%s\"" s
    | Ast.Param_item var -> sprintf "%s" var
bguillaum's avatar
bguillaum committed
48

bguillaum's avatar
bguillaum committed
49 50 51
  let buff_html_command ?(li_html=false) buff (u_command,_) =
    bprintf buff "      ";
    if li_html then bprintf buff "<li>";
bguillaum's avatar
bguillaum committed
52
    bprintf buff "%s" (Ast.string_of_u_command u_command);
bguillaum's avatar
bguillaum committed
53
    if li_html then bprintf buff "</li>\n" else bprintf buff ";\n"
bguillaum's avatar
bguillaum committed
54

bguillaum's avatar
bguillaum committed
55
  let html_feature (u_feature,_) =
bguillaum's avatar
bguillaum committed
56 57
    match u_feature.Ast.kind with
    | Ast.Equality values ->
bguillaum's avatar
bguillaum committed
58 59 60
        sprintf "%s=%s" u_feature.Ast.name (List_.to_string (fun x->x) "|" values)
    | Ast.Disequality [] ->
        sprintf "%s=*" u_feature.Ast.name
bguillaum's avatar
bguillaum committed
61 62
    | Ast.Absent ->
        sprintf "!%s" u_feature.Ast.name
bguillaum's avatar
bguillaum committed
63
    | Ast.Disequality values ->
bguillaum's avatar
bguillaum committed
64
        sprintf "%s<>%s" u_feature.Ast.name (List_.to_string (fun x->x) "|" values)
bguillaum's avatar
bguillaum committed
65
    | Ast.Equal_param index ->
bguillaum's avatar
bguillaum committed
66 67
        sprintf "%s=%s" u_feature.Ast.name index

bguillaum's avatar
bguillaum committed
68 69 70 71 72 73 74 75
  let buff_html_node buff (u_node,_) =
    bprintf buff "      %s [" u_node.Ast.node_id;
    bprintf buff "%s" (String.concat ", " (List.map html_feature u_node.Ast.fs));
    bprintf buff "];\n"

  let buff_html_edge buff (u_edge,_) =
    bprintf buff "      ";
    bprintf buff "%s" (match u_edge.Ast.edge_id with Some n -> n^": " | None -> "");
bguillaum's avatar
bguillaum committed
76
    match u_edge.Ast.edge_label_cst with
77 78 79
    | Ast.Pos_list l -> bprintf buff "%s -[%s]-> %s;\n" u_edge.Ast.src (List_.to_string (fun x->x) "|" l) u_edge.Ast.tar
    | Ast.Neg_list l -> bprintf buff "%s -[^%s]-> %s;\n" u_edge.Ast.src (List_.to_string (fun x->x) "|" l) u_edge.Ast.tar
    | Ast.Regexp re -> bprintf buff "%s -[re\"%s\"]-> %s;\n" u_edge.Ast.src re u_edge.Ast.tar
bguillaum's avatar
bguillaum committed
80

bguillaum's avatar
bguillaum committed
81 82 83
  let buff_html_const buff (u_const,_) =
    bprintf buff "      ";
    (match u_const with
84
    | Ast.Cst_out (ident, Ast.Neg_list []) ->
85
      bprintf buff "%s -> *" ident
86
    | Ast.Cst_out (ident, Ast.Pos_list labels) ->
87
      bprintf buff "%s -[%s]-> *" ident (List_.to_string (fun x->x) "|" labels)
88
    | Ast.Cst_out (ident, Ast.Neg_list labels) ->
89
      bprintf buff "%s -[^%s]-> *" ident (List_.to_string (fun x->x) "|" labels)
90 91
    | Ast.Cst_out (ident, Ast.Regexp re) ->
      bprintf buff "%s -[re\"%s\"]-> *" ident re
92

93
    | Ast.Cst_in (ident, Ast.Neg_list []) ->
94
      bprintf buff "* -> %s" ident
95
    | Ast.Cst_in (ident, Ast.Pos_list labels) ->
96
      bprintf buff "* -[%s]-> %s" (List_.to_string (fun x->x) "|" labels) ident
97
    | Ast.Cst_in (ident, Ast.Neg_list labels) ->
98
      bprintf buff "* -[^%s]-> %s" (List_.to_string (fun x->x) "|" labels) ident
99 100
    | Ast.Cst_in (ident, Ast.Regexp re) ->
      bprintf buff "* -[re\"%s\"]-> %s" re ident
101

102
    | Ast.Features_eq (feat_id_l, feat_id_r) ->
103
      bprintf buff "%s = %s" (Ast.dump_feature_ident feat_id_l) (Ast.dump_feature_ident feat_id_r);
104
    | Ast.Features_diseq (feat_id_l, feat_id_r) ->
105
      bprintf buff "%s <> %s" (Ast.dump_feature_ident feat_id_l) (Ast.dump_feature_ident feat_id_r);
106
    | Ast.Features_ineq (ineq, feat_id_l, feat_id_r) ->
107
      bprintf buff "%s %s %s" (Ast.dump_feature_ident feat_id_l) (Ast.string_of_ineq ineq) (Ast.dump_feature_ident feat_id_r)
108 109
    | Ast.Feature_ineq_cst (ineq, feat_id_l, constant) ->
      bprintf buff "%s %s %f" (Ast.dump_feature_ident feat_id_l) (Ast.string_of_ineq ineq) constant
bguillaum's avatar
bguillaum committed
110

111
    | Ast.Feature_eq_cst (feat_id_l, value) ->
bguillaum's avatar
bguillaum committed
112 113 114 115
      bprintf buff "%s = \"%s\"" (Ast.dump_feature_ident feat_id_l) value;
    | Ast.Feature_diff_cst (feat_id_l, value) ->
      bprintf buff "%s ≠ \"%s\"" (Ast.dump_feature_ident feat_id_l) value;

116
    | Ast.Feature_eq_float (feat_id_l, value) ->
bguillaum's avatar
bguillaum committed
117 118 119 120
      bprintf buff "%s = %g" (Ast.dump_feature_ident feat_id_l) value;
    | Ast.Feature_diff_float (feat_id_l, value) ->
      bprintf buff "%s ≠ %g" (Ast.dump_feature_ident feat_id_l) value;

121
    | Ast.Feature_eq_regexp (feat_id, regexp) ->
bguillaum's avatar
bguillaum committed
122
      bprintf buff "%s == \"%s\"" (Ast.dump_feature_ident feat_id) regexp
123
    | Ast.Immediate_prec (id1, id2) ->
bguillaum's avatar
bguillaum committed
124
      bprintf buff "%s < %s" id1 id2
125
    | Ast.Large_prec (id1, id2) ->
bguillaum's avatar
bguillaum committed
126
      bprintf buff "%s << %s" id1 id2
127
    );
bguillaum's avatar
bguillaum committed
128 129
    bprintf buff "\n"

bguillaum's avatar
bguillaum committed
130
  let buff_html_pos_basic buff pos_basic =
bguillaum's avatar
bguillaum committed
131
    bprintf buff "    <font color=\"purple\">match</font> <b>{</b>\n";
bguillaum's avatar
bguillaum committed
132 133 134
    List.iter (buff_html_node buff) pos_basic.Ast.pat_nodes;
    List.iter (buff_html_edge buff) pos_basic.Ast.pat_edges;
    List.iter (buff_html_const buff) pos_basic.Ast.pat_const;
bguillaum's avatar
bguillaum committed
135
    bprintf buff "    <b>}</b>\n"
bguillaum's avatar
bguillaum committed
136

bguillaum's avatar
bguillaum committed
137
  let buff_html_neg_basic buff neg_basic =
bguillaum's avatar
bguillaum committed
138
    bprintf buff "    <font color=\"purple\">without</font> <b>{</b>\n";
bguillaum's avatar
bguillaum committed
139 140 141
    List.iter (buff_html_node buff) neg_basic.Ast.pat_nodes;
    List.iter (buff_html_edge buff) neg_basic.Ast.pat_edges;
    List.iter (buff_html_const buff) neg_basic.Ast.pat_const;
bguillaum's avatar
bguillaum committed
142 143 144 145
    bprintf buff "    <b>}</b>\n"

  let to_html_rules rules =
    let buff = Buffer.create 32 in
bguillaum's avatar
bguillaum committed
146
    List.iter
bguillaum's avatar
bguillaum committed
147
      (fun rule ->
148
        (* the first line: (lex_)rule / filter *)
bguillaum's avatar
bguillaum committed
149
        (match (rule.Ast.commands, rule.Ast.param) with
bguillaum's avatar
bguillaum committed
150
          | (_,None) ->
bguillaum's avatar
bguillaum committed
151
            bprintf buff "<font color=\"purple\">rule</font> %s <b>{</b>\n" rule.Ast.rule_id
152
          | (_,Some (files, vars)) ->
bguillaum's avatar
bguillaum committed
153 154
            let param =
              match files with
155
                | [] -> sprintf "(feature %s)" (String.concat ", " vars)
bguillaum's avatar
bguillaum committed
156 157
                | l ->  sprintf "(feature %s; %s)"
                  (String.concat ", " vars)
158
                  (String.concat ", " (List.map (fun f -> sprintf "file \"%s\"" f) l)) in
bguillaum's avatar
bguillaum committed
159 160
            bprintf buff "<font color=\"purple\">lex_rule</font> %s %s <b>{</b>\n" rule.Ast.rule_id param
        );
bguillaum's avatar
bguillaum committed
161 162

        (* the match part *)
163
        buff_html_pos_basic buff rule.Ast.pattern.Ast.pat_pos;
bguillaum's avatar
bguillaum committed
164 165

        (* the without parts *)
166
        List.iter (buff_html_neg_basic buff) rule.Ast.pattern.Ast.pat_negs;
bguillaum's avatar
bguillaum committed
167 168

        (*  the commands part *)
Bruno Guillaume's avatar
Bruno Guillaume committed
169 170 171
        bprintf buff "    <font color=\"purple\">commands</font> <b>{</b>\n";
        List.iter (buff_html_command buff) rule.Ast.commands;
        bprintf buff "    <b>}</b>\n";
bguillaum's avatar
bguillaum committed
172

bguillaum's avatar
bguillaum committed
173
        bprintf buff "<b>}</b>\n";
bguillaum's avatar
bguillaum committed
174 175 176 177 178 179 180
      ) rules;
    Buffer.contents buff


  let doc_to_html string =
    if Str.string_match (Str.regexp "^  \\* ") string 0
    then sprintf "<font color=\"green\"><i>%s</i></font>" (String.sub string 4 ((String.length string)-4))
bguillaum's avatar
bguillaum committed
181
    else
bguillaum's avatar
bguillaum committed
182 183 184 185 186 187 188 189 190 191
      List.fold_left
        (fun acc (re,str) -> Str.global_replace (Str.regexp re) str acc)
        string
        [
          "\\[", "<b>";
          "\\]", "</b>";
          "~", "&nbsp;";
        ]

  let of_opt_color = function
192 193
    | [] -> "black"
    | c::_ -> String.sub c 1 ((String.length c) - 1)
bguillaum's avatar
bguillaum committed
194

195
  let module_page_text ~corpus prev next module_ =
bguillaum's avatar
bguillaum committed
196 197 198 199
    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
    let w fmt  = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in

bguillaum's avatar
bguillaum committed
200
    let title = sprintf "Grew -- Module %s" module_.Ast.module_id in
bguillaum's avatar
bguillaum committed
201
    html_header ~css_file:"style.css" ~title buff;
bguillaum's avatar
bguillaum committed
202

bguillaum's avatar
bguillaum committed
203
    wnl "  <body>";
204 205
    if corpus
    then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
bguillaum's avatar
bguillaum committed
206

bguillaum's avatar
bguillaum committed
207 208
    wnl "    <div class=\"navbar\">";
    w "      ";
bguillaum's avatar
bguillaum committed
209 210 211
    (match prev with Some p -> w "&nbsp;<a href=\"%s.html\">Previous</a>" p | _ -> ());
    w "&nbsp;<a href=\"index.html\">Up</a>";
    (match next with Some n -> w "&nbsp;<a href=\"%s.html\">Next</a>" n | _ -> ());
bguillaum's avatar
bguillaum committed
212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
    wnl "    </div>";

    wnl "    <center><h1>Module <div class=\"module_title\">%s</div></h1></center><br/>" module_.Ast.module_id;
    List.iter (fun s -> wnl "    %s<br/>" (doc_to_html s)) module_.Ast.module_doc;
    wnl "    <h6>%d Rules</h6>" (List.length module_.Ast.rules);
    wnl "    <table class=\"indextable\">";
    List.iter
      (fun rule ->
        wnl "      <tr>";
        wnl "        <td width=\"200px\"><a href=\"%s_%s.html\">%s</a></td>" module_.Ast.module_id rule.Ast.rule_id rule.Ast.rule_id;
        (match rule.Ast.rule_doc with [] -> () | l::_ -> wnl "        <td>%s</td>" (doc_to_html l));
        wnl "      </tr>";
      ) module_.Ast.rules;
    wnl "    </table>";
    wnl "  </body>";
    wnl "</html>";
    Buffer.contents buff

230
  let rule_page_text ~corpus ~dep prev next rule_ module_ =
bguillaum's avatar
bguillaum committed
231 232
    let rid = rule_.Ast.rule_id in
    let mid = module_.Ast.module_id in
bguillaum's avatar
bguillaum committed
233

bguillaum's avatar
bguillaum committed
234 235 236
    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
    let w fmt  = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
pj2m's avatar
pj2m committed
237

bguillaum's avatar
bguillaum committed
238
    let title = sprintf "Grew -- Rule %s/%s" mid rid in
bguillaum's avatar
bguillaum committed
239
    html_header ~css_file:"style.css" ~title buff;
pj2m's avatar
pj2m committed
240

bguillaum's avatar
bguillaum committed
241
    wnl "  <body>";
242 243
    if corpus
    then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
bguillaum's avatar
bguillaum committed
244

bguillaum's avatar
bguillaum committed
245 246
    wnl "    <div class=\"navbar\">";
    w "      ";
bguillaum's avatar
bguillaum committed
247
    (match prev with Some p -> w "&nbsp;<a href=\"%s_%s.html\">Previous</a>" mid p | _ -> ());
bguillaum's avatar
bguillaum committed
248
    w "&nbsp;<a href=\"%s.html\">Up</a>" mid;
bguillaum's avatar
bguillaum committed
249
    (match next with Some n -> w "&nbsp;<a href=\"%s_%s.html\">Next</a>" mid n | _ -> ());
bguillaum's avatar
bguillaum committed
250
    wnl "    </div>";
pj2m's avatar
pj2m committed
251

bguillaum's avatar
bguillaum committed
252 253 254 255 256 257 258
    wnl "<center><h1>Rule <a href=\"%s.html\">%s</a>.<div class=\"module_title\">%s</div></h1></center>" mid mid rid;
    List.iter (fun s -> wnl "    %s<br/>" (doc_to_html s)) rule_.Ast.rule_doc;

    wnl "<h6>Code</h6>";
    wnl "<pre>";
    w "%s" (to_html_rules [rule_]);
    wnl "</pre>";
bguillaum's avatar
bguillaum committed
259 260 261

    if dep
    then
262 263 264 265 266 267
      begin
        wnl "<h6>Pattern</h6>";
        wnl "<pre>";
        w "<IMG src=\"%s\">" (sprintf "%s_%s-patt.png" mid rid);
        wnl "</pre>"
      end;
bguillaum's avatar
bguillaum committed
268

269 270 271
    let output_table args lines =
      wnl "    <table border=\"1\" cellspacing=\"0\" cellpadding=\"3\">";
      wnl "    <tr>%s</tr>" (List_.to_string (fun x -> sprintf "<th bgcolor=\"#cccccc\">%s</th>" x) "" args);
bguillaum's avatar
bguillaum committed
272 273
      List.iter
        (fun l -> wnl "<tr>%s</tr>"
274 275 276 277
          (List_.to_string (fun x -> sprintf "<td>%s</td>" x) "" (Str.split (Str.regexp "#+") l))
        ) lines;
      wnl "    </table>" in

bguillaum's avatar
bguillaum committed
278 279
    (match rule_.Ast.param with
      | None -> ()
bguillaum's avatar
bguillaum committed
280
      | Some (files, args) ->
bguillaum's avatar
bguillaum committed
281
        wnl "<h6>Lexical parameters</h6>";
282 283

        (* output local lexical parameters (if any) *)
bguillaum's avatar
bguillaum committed
284
        (match rule_.Ast.lex_par with
285
          | None -> ()
bguillaum's avatar
bguillaum committed
286
          | Some lines ->
bguillaum's avatar
bguillaum committed
287
            wnl "<b>Local parameters</b><br/>";
bguillaum's avatar
bguillaum committed
288
            output_table args lines
289 290 291 292 293 294
        );

        (* output external lexical parameters (if any) *)
        List.iter
          (fun file ->
            let filename = Filename.concat module_.Ast.mod_dir file in
bguillaum's avatar
bguillaum committed
295
            wnl "<b>File:</b> %s<br/>" file;
bguillaum's avatar
bguillaum committed
296
            let lines =
297 298 299 300 301
              try File.read filename
              with Sys_error msg -> wnl "<font color=\"red\">Error: %s</font>" msg; [] in
            output_table args lines
          ) files
    );
bguillaum's avatar
bguillaum committed
302 303 304 305 306
    wnl "  </body>";
    wnl "</html>";
    Buffer.contents buff


307
  let sequences_text ~corpus ast =
bguillaum's avatar
bguillaum committed
308 309
    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
bguillaum's avatar
bguillaum committed
310 311

    let title = sprintf "Grew -- List of sequences" in
bguillaum's avatar
bguillaum committed
312
    html_header ~css_file:"style.css" ~title buff;
bguillaum's avatar
bguillaum committed
313

bguillaum's avatar
bguillaum committed
314
    wnl "  <body>";
315 316
    if corpus
    then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
bguillaum's avatar
bguillaum committed
317

bguillaum's avatar
bguillaum committed
318 319 320
    wnl "  <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
    wnl "  <center><h1>List of sequences</h1></center>";
    List.iter
bguillaum's avatar
bguillaum committed
321
      (fun ast_seq ->
322 323
        wnl "<h6>%s</h6>" ast_seq.Ast.strat_name;
        List.iter (fun l -> wnl "<p>%s</p>" (doc_to_html l)) ast_seq.Ast.strat_doc;
bguillaum's avatar
bguillaum committed
324
        wnl "<div class=\"code\">";
325
        wnl "%s" (Ast.strat_def_to_string ast_seq.Ast.strat_def);
bguillaum's avatar
bguillaum committed
326
        wnl "</div>";
bguillaum's avatar
bguillaum committed
327

bguillaum's avatar
bguillaum committed
328
      ) ast.Ast.strategies;
bguillaum's avatar
bguillaum committed
329 330 331 332 333 334
    wnl "  </body>";
    wnl "</html>";
    Buffer.contents buff



bguillaum's avatar
bguillaum committed
335
  let index_modules_text ast =
bguillaum's avatar
bguillaum committed
336 337
    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
bguillaum's avatar
bguillaum committed
338 339

    let title = sprintf "Grew -- Index of modules" in
bguillaum's avatar
bguillaum committed
340
    html_header ~css_file:"style.css" ~title buff;
bguillaum's avatar
bguillaum committed
341

bguillaum's avatar
bguillaum committed
342
    wnl "  <body>";
bguillaum's avatar
bguillaum committed
343 344 345 346 347
    wnl "  <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
    wnl "  <center><h1>Index of modules</h1></center>";
    wnl "  <table width=100%%>";
    List.iter
      (fun initial ->
348
        match List.filter (fun mod_ -> Char.uppercase_ascii mod_.Ast.module_id.[0] = initial) ast.Ast.modules  with
bguillaum's avatar
bguillaum committed
349
          | [] -> ()
bguillaum's avatar
bguillaum committed
350
          | l ->
bguillaum's avatar
bguillaum committed
351 352
            wnl "<tr><td colspan=2 ><h6>%s</h6></td></tr>" (Char.escaped initial);
            List.iter
bguillaum's avatar
bguillaum committed
353
              (fun mod_ ->
bguillaum's avatar
bguillaum committed
354 355 356 357 358 359 360 361 362 363
                wnl "<tr>";
                wnl "<td width=\"200px\"><a href=\"%s.html\">%s</a></td>" mod_.Ast.module_id mod_.Ast.module_id;
                (match mod_.Ast.module_doc with [] -> () | h::_ -> wnl "<td>%s</td>\n" (doc_to_html h));
                wnl "</tr>";
              ) l
      ) ['A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P';'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z'];
    wnl "  </body>";
    wnl "</html>";
    Buffer.contents buff

bguillaum's avatar
bguillaum committed
364

365
  let domain_text ~corpus ast =
bguillaum's avatar
bguillaum committed
366 367 368
    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
    let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
bguillaum's avatar
bguillaum committed
369 370

    let title = sprintf "Grew -- Features domain" in
bguillaum's avatar
bguillaum committed
371
    html_header ~css_file:"style.css" ~title buff;
bguillaum's avatar
bguillaum committed
372

bguillaum's avatar
bguillaum committed
373
    wnl "  <body>";
374 375
    if corpus
    then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
bguillaum's avatar
bguillaum committed
376

bguillaum's avatar
bguillaum committed
377 378 379 380 381 382
    wnl "  <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";

    wnl "  <h6>Features</h6>";
    wnl "  <code class=\"code\">";
    List.iter
      (function
383 384 385
        | Ast.Closed (feat_name,values) -> wnl "<b>%s</b> : %s<br/>" feat_name (String.concat " | " values)
        | Ast.Open feat_name -> wnl "    <b>%s</b> : *<br/>" feat_name
        | Ast.Num feat_name -> wnl "    <b>%s</b> : #<br/>" feat_name
386
      ) ast.Ast.feature_domain;
bguillaum's avatar
bguillaum committed
387 388 389 390
    wnl "  </code>";

    wnl "  <h6>Labels</h6>";
    wnl "  <code class=\"code\">";
391
    (match ast.Ast.label_domain with
bguillaum's avatar
bguillaum committed
392
      | [] -> wnl "No labels defined!"
bguillaum's avatar
bguillaum committed
393
      | (l,c)::t -> w "<font color=\"%s\">%s</font>" (of_opt_color c) l;
bguillaum's avatar
bguillaum committed
394
        List.iter
bguillaum's avatar
bguillaum committed
395 396
          (fun (lab,color) ->
            w ", <font color=\"%s\">%s</font>" (of_opt_color color) lab;
bguillaum's avatar
bguillaum committed
397 398 399
          ) t;
        wnl "");
    wnl "  </code>";
bguillaum's avatar
bguillaum committed
400

bguillaum's avatar
bguillaum committed
401 402 403 404
    wnl "  </body>";
    wnl "</html>";
    Buffer.contents buff

405
  let build ~dep ~corpus output_dir grs =
406 407
    let filename = Old_grs.get_filename grs in
    let ast = Old_grs.get_ast grs in
bguillaum's avatar
bguillaum committed
408 409
    ignore(Sys.command ("rm -rf "^output_dir));
    ignore(Sys.command ("mkdir "^output_dir));
bguillaum's avatar
bguillaum committed
410
    (* ignore(Sys.command ("cp "^DATA_DIR^"/style.css "^output_dir)); *)
bguillaum's avatar
bguillaum committed
411

bguillaum's avatar
bguillaum committed
412 413
    (** index.html **)
    let index = Filename.concat output_dir "index.html" in
bguillaum's avatar
bguillaum committed
414

bguillaum's avatar
bguillaum committed
415 416 417 418
    (* let table = create_modules_table ast.Ast.modules in *)

    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
bguillaum's avatar
bguillaum committed
419

bguillaum's avatar
bguillaum committed
420
    let title = sprintf "Grew -- Graph Rewriting System: %s" (Filename.basename filename) in
bguillaum's avatar
bguillaum committed
421
    html_header ~css_file:"style.css" ~title buff;
422

bguillaum's avatar
bguillaum committed
423
    wnl "  <body>";
424 425
    if corpus
    then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
426

bguillaum's avatar
bguillaum committed
427 428
    wnl "<h1>Graph Rewriting System: %s</h1>" (Filename.basename filename);
    wnl "<center><b>full path</b>: %s</center>" filename;
429

bguillaum's avatar
bguillaum committed
430 431 432 433 434 435 436
    wnl "<a href=domain.html>Domain</a><br/>";
    wnl "<a href=modules.html>Index of modules</a><br/>";
    wnl "<a href=sequences.html>List of sequences</a><br/>";

    wnl "<h6>Modules</h6>";
    wnl "<table class=\"indextable\">";
    List.iter
bguillaum's avatar
bguillaum committed
437
      (fun m ->
bguillaum's avatar
bguillaum committed
438 439 440 441 442
        wnl "<tr>";
        wnl "<td width=\"200px\"><a href=\"%s.html\">%s</a></td>" m.Ast.module_id m.Ast.module_id;
        (match m.Ast.module_doc with [] -> () | h::_ -> wnl "<td>%s</td>\n" (doc_to_html h));
        wnl "</tr>"
      ) ast.Ast.modules;
bguillaum's avatar
bguillaum committed
443

bguillaum's avatar
bguillaum committed
444 445 446 447 448 449 450
    wnl "</table>";
    wnl "</body>";
    wnl "</html>";

    let index_out_ch = open_out index in
    output_string index_out_ch (Buffer.contents buff);
    close_out index_out_ch;
bguillaum's avatar
bguillaum committed
451

bguillaum's avatar
bguillaum committed
452 453
    (** Sequences.html **)
    let sequences = Filename.concat output_dir "sequences.html" in
bguillaum's avatar
bguillaum committed
454

bguillaum's avatar
bguillaum committed
455
    let sequences_out_ch = open_out sequences in
456
    output_string sequences_out_ch (sequences_text ~corpus ast);
bguillaum's avatar
bguillaum committed
457
    close_out sequences_out_ch;
bguillaum's avatar
bguillaum committed
458

bguillaum's avatar
bguillaum committed
459 460
    (** Modules.html **)
    let modules = Filename.concat output_dir "modules.html" in
bguillaum's avatar
bguillaum committed
461

bguillaum's avatar
bguillaum committed
462 463 464
    let modules_out_ch = open_out modules in
    output_string modules_out_ch (index_modules_text ast);
    close_out modules_out_ch;
bguillaum's avatar
bguillaum committed
465

bguillaum's avatar
bguillaum committed
466 467
    (** domain.html **)
    let domain = Filename.concat output_dir "domain.html" in
bguillaum's avatar
bguillaum committed
468

bguillaum's avatar
bguillaum committed
469
    let domain_out_ch = open_out domain in
bguillaum's avatar
bguillaum committed
470 471 472 473 474
    begin
      match ast.Ast.domain with
      | Some dom -> output_string domain_out_ch (domain_text ~corpus dom)
      | None -> output_string domain_out_ch "No domain defined"
    end;
bguillaum's avatar
bguillaum committed
475
    close_out domain_out_ch;
bguillaum's avatar
bguillaum committed
476

bguillaum's avatar
bguillaum committed
477 478 479 480 481
    (** Modules + rules **)
    let modules_array = Array.of_list ast.Ast.modules in
    for i = 0 to (Array.length modules_array -1) do
      let page = Filename.concat output_dir (modules_array.(i).Ast.module_id^".html") in
      let page_out_ch = open_out page in
bguillaum's avatar
bguillaum committed
482
      output_string page_out_ch
483
        (module_page_text ~corpus
bguillaum's avatar
bguillaum committed
484
           (try Some (modules_array.(i-1).Ast.module_id) with _ -> None)
bguillaum's avatar
bguillaum committed
485 486 487 488
           (try Some (modules_array.(i+1).Ast.module_id) with _ -> None)
           modules_array.(i)
        );
      close_out page_out_ch;
bguillaum's avatar
bguillaum committed
489

bguillaum's avatar
bguillaum committed
490 491
      let rules_array = Array.of_list modules_array.(i).Ast.rules in
      for j = 0 to (Array.length rules_array -1) do
bguillaum's avatar
bguillaum committed
492

bguillaum's avatar
bguillaum committed
493 494
        let page = Filename.concat output_dir (modules_array.(i).Ast.module_id^"_"^rules_array.(j).Ast.rule_id^".html") in
        let page_out_ch = open_out page in
bguillaum's avatar
bguillaum committed
495
        output_string page_out_ch
496
          (rule_page_text ~corpus
bguillaum's avatar
bguillaum committed
497
             ~dep
bguillaum's avatar
bguillaum committed
498
             (try Some (rules_array.(j-1).Ast.rule_id) with _ -> None)
bguillaum's avatar
bguillaum committed
499 500 501
             (try Some (rules_array.(j+1).Ast.rule_id) with _ -> None)
             rules_array.(j)
             modules_array.(i)
bguillaum's avatar
bguillaum committed
502 503 504
          );
        close_out page_out_ch;
      done;
bguillaum's avatar
bguillaum committed
505
    done
bguillaum's avatar
bguillaum committed
506 507
end (* module Html_doc *)

bguillaum's avatar
bguillaum committed
508
(* ================================================================================ *)
bguillaum's avatar
bguillaum committed
509
module Html_rh = struct
bguillaum's avatar
bguillaum committed
510
  let build ?domain ?filter ?main_feat ?(dot=false) ?(init_graph=true) ?(out_gr=false) ?header ?graph_file prefix t =
bguillaum's avatar
bguillaum committed
511 512 513 514 515 516

    (* remove files from previous runs *)
    let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
    let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
    let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in

bguillaum's avatar
bguillaum committed
517 518
    (
      if init_graph
bguillaum's avatar
bguillaum committed
519
      then ignore (Instance.save_dep_png ?domain ?filter ?main_feat prefix t.Rewrite_history.instance)
bguillaum's avatar
bguillaum committed
520
    );
bguillaum's avatar
bguillaum committed
521

bguillaum's avatar
bguillaum committed
522
    let nf_files = Rewrite_history.save_nfs ?domain ?filter ?main_feat ~dot prefix t in
bguillaum's avatar
bguillaum committed
523 524 525 526 527 528 529 530 531

    let l = List.length nf_files in

    let local = Filename.basename prefix in

    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in

    let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
bguillaum's avatar
bguillaum committed
532
    html_header ~css_file:"style.css" ~title buff;
bguillaum's avatar
bguillaum committed
533 534 535 536 537 538 539 540

    wnl "<body>";
    wnl "<a href=\"sentences.html\">Sentences</a> -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";

    wnl "<h1>%s</h1>" title;

    begin
      match header with
bguillaum's avatar
bguillaum committed
541
        | Some h -> wnl "%s<br/>" h
bguillaum's avatar
bguillaum committed
542 543 544
        | None -> ()
    end;

bguillaum's avatar
bguillaum committed
545 546 547 548 549 550 551
    begin
      match graph_file with
        | Some gf ->
          wnl "<b>Input file</b>: <a href=\"%s\">%s</a><br/>"
            gf (Filename.basename gf)
        | None -> ()
    end;
bguillaum's avatar
bguillaum committed
552 553 554 555 556 557 558 559 560 561 562

    wnl "<b>Input sentence</b>: <font color=\"green\"><i>%s</i></font></p><br/>"
      (G_graph.to_sentence ?main_feat t.Rewrite_history.instance.Instance.graph);

    if init_graph
    then
      begin
        wnl "<h6>Initial graph</h6>";
        wnl "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>" local
      end;

563
    List.iteri
bguillaum's avatar
bguillaum committed
564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608
      (fun i (rules_list,file_name) ->
        wnl "<h6>Solution %d</h6>" (i+1);

        let local_name = Filename.basename file_name in

        if out_gr
        then wnl "<p><a href=\"%s.gr\">gr file</a>" local_name;

        (* the png file *)
        wnl "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>" local_name;

        (* the modules list *)
        wnl "<b>Modules applied</b>: %d<br/>" (List.length rules_list);

        let id = sprintf "id_%d" (i+1) in

        wnl "<a style=\"cursor:pointer;\"";
        wnl "  onClick=\"if (document.getElementById('%s').style.display == 'none')" id;
        wnl "      { document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = 'Hide applied rules'; }" id id;
        wnl " else { document.getElementById('%s').style.display = 'none';; document.getElementById('p_%s').innerHTML = 'Show applied rules'; }\">" id id;
        wnl "         <b><p id=\"p_%s\">Show applied rules</p></b>" id;
        wnl "</a>";

        wnl " <div id=\"%s\" style=\"display:none;\">" id;

        List.iter
          (fun (mod_name,rules) ->
            wnl "<p><b><font color=\"red\">%s: </font></b><font color=\"green\">%s</font></p>"
              mod_name
              (List_.to_string (fun x -> x) ", " rules);
          )
          rules_list;
        wnl " </div>"

      ) nf_files;

    wnl "</body>";
    wnl "</html>";

    let out_ch = open_out (sprintf "%s.html" prefix) in
    fprintf out_ch "%s" (Buffer.contents buff);
    close_out out_ch



bguillaum's avatar
bguillaum committed
609
  let error ?domain ?main_feat ?(dot=false) ?(init_graph=true) ?header prefix msg graph_opt =
bguillaum's avatar
bguillaum committed
610 611 612 613 614
    (* remove files from previous runs *)
    let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
    let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
    let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in

615
    (match graph_opt, init_graph with
bguillaum's avatar
bguillaum committed
616 617
      | (Some graph, true) when dot -> Instance.save_dot_png ?domain ?main_feat prefix (Instance.from_graph graph)
      | (Some graph, true) -> ignore (Instance.save_dep_png ?domain ?main_feat prefix (Instance.from_graph graph))
bguillaum's avatar
bguillaum committed
618 619 620 621 622 623 624 625 626
      | _ -> ()
    );

    let local = Filename.basename prefix in

    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in

    let title = sprintf "Sentence: %s --- ERROR" local in
bguillaum's avatar
bguillaum committed
627
    html_header ~css_file:"style.css" ~title buff;
bguillaum's avatar
bguillaum committed
628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646

    wnl "<body>";
    wnl "<a href=\"sentences.html\">Sentences</a> -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";

    wnl "<h1>%s</h1>" title;

    if init_graph
    then
      begin
        wnl "<h6>Initial graph</h6>";
        wnl "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>" local
      end;

    wnl "<h2>ERROR: %s</h2>" msg;
    wnl "</body>\n</html>";

    let out_ch = open_out (sprintf "%s.html" prefix) in
    fprintf out_ch "%s" (Buffer.contents buff);
    close_out out_ch
bguillaum's avatar
bguillaum committed
647
end (* module Html_rh *)
bguillaum's avatar
bguillaum committed
648

bguillaum's avatar
bguillaum committed
649
(* ================================================================================*)
bguillaum's avatar
bguillaum committed
650
module Html_sentences = struct
bguillaum's avatar
bguillaum committed
651
  let build ~title output_dir sentences =
bguillaum's avatar
bguillaum committed
652
    let buff = Buffer.create 32 in
bguillaum's avatar
bguillaum committed
653
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
bguillaum's avatar
bguillaum committed
654

bguillaum's avatar
bguillaum committed
655
    html_header ~css_file:"style.css" ~title buff;
bguillaum's avatar
bguillaum committed
656 657 658

    wnl "  <body>";
    wnl "Sentences -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";
bguillaum's avatar
bguillaum committed
659 660 661
    wnl "<h1>%s</h1>" (Str.global_replace (Str.regexp "#") " " title);

     wnl "<h2>Sentences list</h2>";
bguillaum's avatar
bguillaum committed
662

bguillaum's avatar
bguillaum committed
663
    wnl "<center><table cellpadding=3 cellspacing=0 width=\"95%%\">";
bguillaum's avatar
bguillaum committed
664
    wnl "<tr><th class=\"first\">Number of normal forms</th><th>Sentence Id</th><th>Sentence</th></tr>";
bguillaum's avatar
bguillaum committed
665 666

    List.iter
bguillaum's avatar
bguillaum committed
667
      (fun (rewrited, base_name, amb, sentence) ->
bguillaum's avatar
bguillaum committed
668 669
        wnl "<tr>";
        wnl "    <td class=\"first_stats\">%d</td>" amb;
bguillaum's avatar
bguillaum committed
670 671 672 673
        if rewrited
        then wnl "    <td class=\"stats\"><a href=\"%s.html\">%s</a></td>" base_name base_name
        else wnl "    <td class=\"stats\">%s</td>" base_name;
        wnl "  <td class=\"stats\">%s</td>" sentence;
bguillaum's avatar
bguillaum committed
674
        wnl "</tr>";
bguillaum's avatar
bguillaum committed
675 676
      ) sentences;

bguillaum's avatar
bguillaum committed
677 678 679
    wnl "</table></center>";
    wnl "</body>";
    wnl "</html>";
bguillaum's avatar
bguillaum committed
680 681 682 683

    let out_ch = open_out (Filename.concat output_dir "sentences.html") in
    fprintf out_ch "%s" (Buffer.contents buff);
    close_out out_ch
bguillaum's avatar
bguillaum committed
684 685
end (* module Html_sentences *)

bguillaum's avatar
bguillaum committed
686
(* ================================================================================*)
bguillaum's avatar
bguillaum committed
687 688 689 690
module Gr_stat = struct

  (** the type [gr] stores the stats for the rewriting of one gr file *)
  type t =
bguillaum's avatar
bguillaum committed
691
    | Stat of ((int * int) String_map.t * int) (* map: rule_name |-> (min,max) occ, number of solution *)
bguillaum's avatar
bguillaum committed
692 693 694 695 696 697 698 699 700
    | Error of string

  let opt_incr = function None -> Some 1 | Some x -> Some (x+1)
  let add_one_module modul_opt rules stat =
    match modul_opt with
      | Some modul ->
        List.fold_left
          (fun acc rule ->
            let key = sprintf "%s.%s" modul rule in
bguillaum's avatar
bguillaum committed
701 702
            let (old_min, old_max) = try String_map.find key acc with Not_found -> (None, None) in
            String_map.add key (opt_incr old_min, opt_incr old_max) acc
bguillaum's avatar
bguillaum committed
703 704 705 706 707
          ) stat rules
      | None when rules = [] -> stat
      | None -> Log.fcritical "Unconsistent rewrite history"

  let max_stat stat1 stat2 =
bguillaum's avatar
bguillaum committed
708
    String_map.fold
bguillaum's avatar
bguillaum committed
709
      (fun key value acc ->
bguillaum's avatar
bguillaum committed
710 711
        let old = try String_map.find key acc with Not_found -> 0 in
        String_map.add key (max old value) acc
bguillaum's avatar
bguillaum committed
712 713 714 715 716 717 718 719 720 721 722
      ) stat1 stat2

  let opt_max x y = match (x,y) with
    | None, v | v, None -> v
    | Some v1, Some v2 -> Some (max v1 v2)

  let opt_min x y = match (x,y) with
    | None, v | v, None -> v
    | Some v1, Some v2 -> Some (min v1 v2)

  let min_max_stat stat1 stat2 =
bguillaum's avatar
bguillaum committed
723
    String_map.fold
bguillaum's avatar
bguillaum committed
724
      (fun key (vmin, vmax) acc ->
bguillaum's avatar
bguillaum committed
725 726
        let (old_min, old_max) = try String_map.find key acc with Not_found -> (Some 0, Some 0) in
        String_map.add key (opt_min old_min vmin, opt_max old_max vmax) acc
bguillaum's avatar
bguillaum committed
727 728 729 730 731 732 733 734
      ) stat1 stat2



  let from_rew_history rew_history =
    let rec loop prev_module rh =
      let sub_stat =
        match List.map (loop (Some rh.Rewrite_history.module_name)) rh.Rewrite_history.good_nf with
bguillaum's avatar
bguillaum committed
735
          | [] -> String_map.empty
bguillaum's avatar
bguillaum committed
736 737 738 739
          | h::t -> List.fold_left min_max_stat h t in
      add_one_module prev_module rh.Rewrite_history.instance.Instance.rules sub_stat
    in
    Stat
bguillaum's avatar
bguillaum committed
740
      (String_map.map
bguillaum's avatar
bguillaum committed
741 742 743 744 745 746 747 748
         (function | Some i, Some j -> (i,j) | _ -> Log.critical "None in stat")
         (loop None rew_history),
       (Rewrite_history.num_sol rew_history)
      )

  let from_rew_history rew_history =
    let rec loop prev_module rh =
      let sub_stat =
Bruno Guillaume's avatar
Bruno Guillaume committed
749 750 751
        match rh.Rewrite_history.good_nf with
          | [] -> Some (String_map.empty)
          | l ->
bguillaum's avatar
bguillaum committed
752 753 754 755 756 757 758 759
            match List_.opt_map (loop (Some rh.Rewrite_history.module_name)) l with
              | [] -> None
              | h::t -> Some (List.fold_left min_max_stat h t) in
      match sub_stat with
        | None -> None
        | Some stat -> Some (add_one_module prev_module rh.Rewrite_history.instance.Instance.rules stat)
    in
    match loop None rew_history with
bguillaum's avatar
bguillaum committed
760
      | None -> Stat (String_map.empty, Rewrite_history.num_sol rew_history)
bguillaum's avatar
bguillaum committed
761 762 763
      | Some map ->
        Stat
          (
bguillaum's avatar
bguillaum committed
764
            String_map.map (function Some i, Some j -> (i,j) | _ -> Log.critical "None in stat") map,
bguillaum's avatar
bguillaum committed
765 766 767 768 769 770 771 772 773 774 775
            Rewrite_history.num_sol rew_history
          )



  let save stat_file t =
    let out_ch = open_out stat_file in
    (match t with
      | Error msg -> fprintf out_ch "ERROR\n%s" msg
      | Stat (map, num) ->
        fprintf out_ch "NUM_SOL:%d\n%!" num;
bguillaum's avatar
bguillaum committed
776
        String_map.iter
bguillaum's avatar
bguillaum committed
777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793
          (fun rule_name (min_occ,max_occ) ->  fprintf out_ch "%s:%d:%d\n%!" rule_name min_occ max_occ) map
    );

    close_out out_ch

  let load stat_file =
    let sol = ref 0 in
    try
      let lines = File.read stat_file in
      match lines with
        | "ERROR" :: msg_lines -> Error (List_.to_string (fun x->x) "\n" msg_lines)
        | _ ->
          let map =
            List.fold_left
              (fun acc line ->
                match Str.split (Str.regexp ":") line with
                  | ["NUM_SOL"; num] -> sol := int_of_string num; acc
bguillaum's avatar
bguillaum committed
794
                  | [modu_rule; vmin; vmax] -> String_map.add modu_rule (int_of_string vmin, int_of_string vmax) acc
bguillaum's avatar
bguillaum committed
795
                  | _ -> Log.fcritical "invalid stat line: %s" line
bguillaum's avatar
bguillaum committed
796
              ) String_map.empty lines in
bguillaum's avatar
bguillaum committed
797 798 799 800
          Stat (map, !sol)
    with Sys_error msg -> Error (sprintf "Sys_error: %s" msg)
end (* module Gr_stat *)

bguillaum's avatar
bguillaum committed
801
(* ================================================================================*)
bguillaum's avatar
bguillaum committed
802 803 804 805 806 807 808 809
module Corpus_stat = struct
  (** the [t] type stores stats for a corpus of gr_files *)
  (*
     first key: [m] module name
     second key: [r] rule name
     value: [occ_num, file_list] the total number of rule applications and the set of gr files concerned *)
  type t = {
    modules: Modul.t list;                                   (* ordered list of modules in the sequence *)
bguillaum's avatar
bguillaum committed
810 811
    map: ((int*int) * String_set.t) String_map.t String_map.t;  (* map: see above *)
    amb: String_set.t Int_map.t;                               (* key: nb of sols |-> set: sentence concerned *)
bguillaum's avatar
bguillaum committed
812
    error: (string * string) list;                           (* (file, msg) *)
bguillaum's avatar
bguillaum committed
813 814 815 816 817
    num: int;                                                (* an integer id relative to the corpus *)
  }

  let empty ~grs ~seq =
    (* let modules = try List.assoc seq grs.Grs.sequences with Not_found -> [seq] in *)
bguillaum's avatar
bguillaum committed
818
    let modules = [] (* Grs.modules_of_sequence grs seq *) in
bguillaum's avatar
bguillaum committed
819 820 821 822 823 824 825
    let map = List.fold_left
      (fun acc modul ->
        if List.exists (fun m -> modul.Modul.name = m.Modul.name) modules
        then
          let rule_map =
            List.fold_left
              (fun acc2 rule ->
bguillaum's avatar
bguillaum committed
826 827 828
                String_map.add (Rule.get_name rule) ((0,0),String_set.empty) acc2
              ) String_map.empty modul.Modul.rules in
          String_map.add modul.Modul.name rule_map acc
bguillaum's avatar
bguillaum committed
829
        else acc
830
      ) String_map.empty (Old_grs.get_modules grs) in
bguillaum's avatar
bguillaum committed
831
    { modules=modules; map = map; amb = Int_map.empty; error = []; num = 0 }
bguillaum's avatar
bguillaum committed
832 833

  let add modul rule file (min_occ,max_occ) map =
bguillaum's avatar
bguillaum committed
834 835 836
    let old_rule_map = String_map.find modul map in
    let ((old_min,old_max), old_file_set) = String_map.find rule old_rule_map in
    String_map.add
bguillaum's avatar
bguillaum committed
837
      modul
bguillaum's avatar
bguillaum committed
838
      (String_map.add
bguillaum's avatar
bguillaum committed
839
         rule
bguillaum's avatar
bguillaum committed
840
           ((old_min + min_occ, old_max + max_occ), String_set.add file old_file_set)
bguillaum's avatar
bguillaum committed
841 842 843 844 845 846 847 848
             old_rule_map
      ) map

  let add_gr_stat base_name gr_stat t =
    match gr_stat with
      | Gr_stat.Error msg -> { t with error = (base_name, msg) :: t.error; num = t.num+1 }
      | Gr_stat.Stat (map, sol) ->
        let new_map =
bguillaum's avatar
bguillaum committed
849
          String_map.fold
bguillaum's avatar
bguillaum committed
850 851 852 853 854 855
            (fun modul_rule (min_occ,max_occ) acc ->
              match Str.split (Str.regexp "\\.") modul_rule with
                | [modul; rule] -> add modul rule base_name (min_occ,max_occ) acc
                | _ -> Log.fcritical "illegal modul_rule spec \"%s\"" modul_rule
            ) map t.map in
        let new_amb =
bguillaum's avatar
bguillaum committed
856 857
          let old = try Int_map.find sol t.amb with Not_found -> String_set.empty in
          Int_map.add sol (String_set.add base_name old) t.amb in
bguillaum's avatar
bguillaum committed
858 859
        { t with map = new_map; num = t.num+1; amb=new_amb; }

bguillaum's avatar
bguillaum committed
860
  let unfoldable_set output_dir buff ?(bound=10) id file_set =
bguillaum's avatar
bguillaum committed
861 862
    let counter = ref 0 in

bguillaum's avatar
bguillaum committed
863
    String_set.iter
bguillaum's avatar
bguillaum committed
864 865
      (fun file ->
        if !counter = bound
bguillaum's avatar
bguillaum committed
866
        then bprintf buff "<div id=\"%s\" style=\"display:none;\">\n" id;
bguillaum's avatar
bguillaum committed
867 868 869 870 871 872 873
        incr counter;

        let link =
          if Sys.file_exists (Filename.concat output_dir (sprintf "%s.html" file))
          then sprintf "<a href=\"%s.html\">%s</a>" file file
          else file in

bguillaum's avatar
bguillaum committed
874
        bprintf buff "%s &nbsp;&nbsp;\n" link
bguillaum's avatar
bguillaum committed
875 876 877 878 879
      ) file_set;

    if (!counter > bound)
    then
      begin
bguillaum's avatar
bguillaum committed
880
        bprintf buff "</div>\n";
bguillaum's avatar
bguillaum committed
881 882
        let if_part = sprintf "document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = '- Show first %d -';" id id bound in
        let else_part = sprintf "document.getElementById('%s').style.display = 'none'; document.getElementById('p_%s').innerHTML = '+ Show all +';" id id in
bguillaum's avatar
bguillaum committed
883 884 885 886 887
        bprintf buff "  <div>\n";
        bprintf buff "    <a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s').style.display == 'none') { %s } else { %s }\">\n" id if_part else_part;
        bprintf buff "      <b><p id=\"p_%s\">+ Show all +</p></b>\n" id;
        bprintf buff "    </a>\n";
        bprintf buff "  </div>\n";
bguillaum's avatar
bguillaum committed
888 889
      end

bguillaum's avatar
bguillaum committed
890

bguillaum's avatar
bguillaum committed
891

bguillaum's avatar
bguillaum committed
892 893 894 895 896 897 898


  let save_html ~title ~grs_file ~input_dir ~output_dir t =
   (*  a fucntion to get the ration wrt the full set [t] *)
    let ratio nb = (float nb) /. (float t.num) *. 100. in

   (* put the css file the [output_dir] *)
bguillaum's avatar
bguillaum committed
899
    (* ignore(Sys.command("cp "^(Filename.concat DATA_DIR "style.css")^" "^(Filename.concat output_dir "style.css"))); *)
bguillaum's avatar
bguillaum committed
900

bguillaum's avatar
bguillaum committed
901 902 903
    let buff = Buffer.create 32 in
    let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
    let w fmt  = Printf.ksprintf (fun x -> Printf