grew_grs.ml 24.1 KB
Newer Older
pj2m's avatar
pj2m committed
1 2 3
open Printf
open Log

4
open Grew_fs
bguillaum's avatar
bguillaum committed
5 6
open Grew_utils
open Grew_ast
pj2m's avatar
pj2m committed
7
open Grew_edge 
bguillaum's avatar
bguillaum committed
8 9 10
open Grew_command
open Grew_graph
open Grew_rule
pj2m's avatar
pj2m committed
11 12 13 14 15 16 17 18 19 20 21


module Rewrite_history = struct

  type t = {
      instance: Instance.t;
      module_name: string; 
      good_nf: t list; 
      bad_nf: Instance.t list;
    }

bguillaum's avatar
bguillaum committed
22 23
  let rec is_empty t = 
    (t.instance.Instance.rules = []) && List.for_all is_empty t.good_nf
bguillaum's avatar
bguillaum committed
24 25

  let rec num_sol = function
26 27
    | { good_nf = []; bad_nf = [] } -> 1
    | { good_nf = [] } -> 0 (* dead branch *)
bguillaum's avatar
bguillaum committed
28
    | { good_nf = l} -> List.fold_left (fun acc t -> acc + (num_sol t)) 0 l
bguillaum's avatar
bguillaum committed
29
      
pj2m's avatar
pj2m committed
30
IFDEF DEP2PICT THEN
31

32 33 34 35 36 37
  (** [save_nfs ?main_feat base_name t] does two things:
      - write PNG files of normal forms
      - returns a list of couples (rules, file)
   *)
  let save_nfs ?main_feat base_name t = 
    let rec loop file_name rules t =
38 39 40 41
      match (t.good_nf, t.bad_nf) with
      | [],[] -> Instance.save_dep_png ?main_feat file_name t.instance; [rules, file_name] 
      | [],_ -> []
      | l, _ -> 
42 43 44 45 46 47 48 49 50 51 52 53
          List_.foldi_left
            (fun i acc son -> 
              (* Instance.save_dep_png ?main_feat (sprintf "%s_%d" file_name i) son.instance; *)
              let nfs = loop 
                  (sprintf "%s_%d" file_name i) 
                  (rules @ [t.module_name, son.instance.Instance.rules]) 
                  son in
              nfs @ acc
            )
            [] l
    in loop base_name [] t

54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
  let error_html ?main_feat ?(init_graph=true) ?header prefix msg inst_opt =
    (* 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

    (match inst_opt, init_graph with
    | (Some inst, true) -> Instance.save_dep_png ?main_feat prefix inst
    | _ -> ());

    let local = Filename.basename prefix in
    
    (* All normal forms view *)
    let html_ch = open_out (sprintf "%s.html" prefix) in

    let title = sprintf "Sentence: %s --- ERROR" local in
    let () = Html.enter html_ch ~title ?header prefix in

    if init_graph
    then
      begin
        fprintf html_ch "<h6>Initial graph</h6>\n";
        fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local
      end;
    fprintf html_ch "<h2>ERROR: %s</h2>\n" msg;
    Html.leave html_ch;
    close_out html_ch

bguillaum's avatar
bguillaum committed
82
  let save_html ?main_feat ?(init_graph=true) ?header prefix t =
pj2m's avatar
pj2m committed
83 84 85 86 87
    (* 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
    
88 89
    (if init_graph then Instance.save_dep_png ?main_feat prefix t.instance);

90
    let nf_files = save_nfs ?main_feat prefix t in
91
    
92 93
    let l = List.length nf_files in

pj2m's avatar
pj2m committed
94 95 96 97 98
    let local = Filename.basename prefix in
    
    (* All normal forms view *)
    let html_ch = open_out (sprintf "%s.html" prefix) in

bguillaum's avatar
bguillaum committed
99
    let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
100
    let () = Html.enter html_ch ~title ?header prefix in
pj2m's avatar
pj2m committed
101

bguillaum's avatar
bguillaum committed
102
    if init_graph
pj2m's avatar
pj2m committed
103 104
    then
      begin
105 106
        fprintf html_ch "<h6>Initial graph</h6>\n";
        fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local
pj2m's avatar
pj2m committed
107 108
      end;
    
bguillaum's avatar
bguillaum committed
109
    List_.iteri 
110
      (fun i (rules_list,file_name) -> 
bguillaum's avatar
bguillaum committed
111
        fprintf html_ch "<h6>Solution %d</h6>\n" (i+1);
pj2m's avatar
pj2m committed
112

113
        let local_name = Filename.basename file_name in
bguillaum's avatar
bguillaum committed
114 115 116 117 118
        
        (* the png file *)
        fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local_name;

        (* the modules list *)
119
        fprintf html_ch "<b>Modules applied</b>: %d<br/>\n" (List.length rules_list);
bguillaum's avatar
bguillaum committed
120
        
bguillaum's avatar
bguillaum committed
121
        let id = sprintf "id_%d" (i+1) in
bguillaum's avatar
bguillaum committed
122
        
123 124
        fprintf html_ch "<a style=\"cursor:pointer;\"\n";
        fprintf html_ch "  onClick=\"if (document.getElementById('%s').style.display == 'none')\n" id;
bguillaum's avatar
bguillaum committed
125 126 127
        fprintf html_ch "      { document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = 'Hide applied rules'; }\n" id id;
        fprintf html_ch " else { document.getElementById('%s').style.display = 'none';; document.getElementById('p_%s').innerHTML = 'Show applied rules'; }\">" id id;
        fprintf html_ch "         <b><p id=\"p_%s\">Show applied rules</p></b>\n" id;
128
        fprintf html_ch "</a>\n";
bguillaum's avatar
bguillaum committed
129 130 131

        fprintf html_ch " <div id=\"%s\" style=\"display:none;\">\n" id;

132 133 134 135 136 137 138
        List.iter 
          (fun (mod_name,rules) -> 
            fprintf html_ch "<p><b><font color=\"red\">%s: </font></b><font color=\"green\">%s</font></p>\n" 
              mod_name
              (List_.to_string (fun x -> x) ", " rules);
          )
          rules_list;
bguillaum's avatar
bguillaum committed
139 140 141
        fprintf html_ch " </div>\n"

        
pj2m's avatar
pj2m committed
142 143
      ) nf_files;
    Html.leave html_ch;
bguillaum's avatar
bguillaum committed
144
    close_out html_ch
pj2m's avatar
pj2m committed
145
ENDIF
pj2m's avatar
pj2m committed
146 147 148 149 150 151 152 153 154 155
end




module Modul = struct
  type t = {
      name: string;
      local_labels: (string * string option) array;
      rules: Rule.t list;
156
      filters: Rule.t list;
pj2m's avatar
pj2m committed
157
      confluent: bool;
158
      loc: Loc.t;
pj2m's avatar
pj2m committed
159 160
    }

161 162 163 164 165 166 167 168
  let check t =
    (* check for duplicate rules *)
    let rec loop already_defined = function
      | [] -> ()
      | r::_ when List.mem (Rule.get_name r) already_defined -> 
          Error.build ~loc:(Rule.get_loc r) "Rule '%s' is defined twice in the same module" (Rule.get_name r)
      | r::tail -> loop ((Rule.get_name r) :: already_defined) tail in
    loop [] t.rules
pj2m's avatar
pj2m committed
169

170
  let build ast_module =
171 172
    let locals = Array.of_list ast_module.Ast.local_labels in
    Array.sort compare locals;
173 174
    let rules_or_filters = List.map (Rule.build ~locals ast_module.Ast.mod_dir) ast_module.Ast.rules in
    let (filters, rules) = List.partition Rule.is_filter rules_or_filters in 
175 176 177 178
    let modul = 
      {
       name = ast_module.Ast.module_id;
       local_labels = locals; 
179 180
       rules = rules; 
       filters = filters;
181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209
       confluent = ast_module.Ast.confluent;
       loc = ast_module.Ast.mod_loc;
     } in
    check modul; modul
end

module Sequence = struct
  type t = {
      name: string;
      def: string list;
      loc: Loc.t;
    }

  let check module_list t =
    List.iter
      (fun module_name -> 
        if not (List.exists (fun modul -> modul.Modul.name = module_name) module_list)
        then Error.build ~loc:t.loc "sequence \"%s\", refers to the unknown module \"%s\"."
            t.name module_name
      ) t.def

  let build module_list ast_sequence = 
    let sequence = 
      {
       name = ast_sequence.Ast.seq_name;
       def = ast_sequence.Ast.seq_mod;
       loc = ast_sequence.Ast.seq_loc;
     } in
    check module_list sequence; sequence
pj2m's avatar
pj2m committed
210 211 212
end

module Grs = struct
213
        
pj2m's avatar
pj2m committed
214 215 216
  type t = {
      labels: Label.t list;    (* the list of global edge labels *)
      modules: Modul.t list;          (* the ordered list of modules used from rewriting *)
217
      sequences: Sequence.t list;
pj2m's avatar
pj2m committed
218
    }
219
        
220 221
  let sequence_names t = List.map (fun s -> s.Sequence.name) t.sequences

pj2m's avatar
pj2m committed
222 223
  let empty = {labels=[]; modules=[]; sequences=[];}

224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240
  let check t =
    (* check for duplicate modules *)
    let rec loop already_defined = function
      | [] -> ()
      | m::_ when List.mem m.Modul.name already_defined -> 
          Error.build ~loc:m.Modul.loc "Module '%s' is defined twice" m.Modul.name
      | m::tail -> loop (m.Modul.name :: already_defined) tail in
    loop [] t.modules;

    (* check for duplicate sequences *)
    let rec loop already_defined = function
      | [] -> ()
      | s::_ when List.mem s.Sequence.name already_defined -> 
          Error.build ~loc:s.Sequence.loc "Sequence '%s' is defined twice" s.Sequence.name
      | s::tail -> loop (s.Sequence.name :: already_defined) tail in
    loop [] t.sequences

pj2m's avatar
pj2m committed
241
  let build ast_grs =
242
    Label.init ast_grs.Ast.labels;
243 244
    Domain.init ast_grs.Ast.domain;
    let modules = List.map Modul.build ast_grs.Ast.modules in
245 246 247 248 249 250
    let grs = {
      labels = List.map (fun (l,_) -> Label.from_string l) ast_grs.Ast.labels;
      modules = modules;
      sequences = List.map (Sequence.build modules) ast_grs.Ast.sequences;
    } in
    check grs; grs
pj2m's avatar
pj2m committed
251

bguillaum's avatar
bguillaum committed
252
  let modules_of_sequence grs sequence =
253 254 255 256
    let module_names =
      try 
        let seq = List.find (fun s -> s.Sequence.name = sequence) grs.sequences in
        seq.Sequence.def
bguillaum's avatar
bguillaum committed
257 258 259 260 261 262 263 264 265 266 267
      with Not_found -> [sequence] in (* a module name can be used as a singleton sequence *)

    List.map 
      (fun name -> 
        try List.find (fun m -> m.Modul.name=name) grs.modules 
        with Not_found -> Log.fcritical "No sequence or module named '%s'" name
      )
      module_names

  let rewrite grs sequence instance = 
    let modules_to_apply = modules_of_sequence grs sequence in
pj2m's avatar
pj2m committed
268 269 270
    
    let rec loop instance = function
      | [] -> (* no more modules to apply *) 
271
          {Rewrite_history.instance = instance; module_name = ""; good_nf = []; bad_nf = []; }
pj2m's avatar
pj2m committed
272
      | next::tail -> 
273 274 275 276
          let (good_set, bad_set) = 
            Rule.normalize
              ~confluent: next.Modul.confluent
              next.Modul.rules 
277
              next.Modul.filters
278 279 280 281 282 283 284 285
              (Instance.clear instance) in
          let good_list = Instance_set.elements good_set 
          and bad_list = Instance_set.elements bad_set in
          {
           Rewrite_history.instance = instance; 
           module_name = next.Modul.name;
           good_nf = List.map (fun i -> loop i tail) good_list;
           bad_nf = bad_list;
bguillaum's avatar
bguillaum committed
286 287 288 289 290
         } in
    loop instance modules_to_apply
      
  let build_rew_display grs sequence instance =
    let modules_to_apply = modules_of_sequence grs sequence in
pj2m's avatar
pj2m committed
291 292 293

    let rec loop instance = function
      | [] -> Grew_types.Leaf instance.Instance.graph
294 295
      | next :: tail ->
          let (good_set, bad_set) =
296 297
            Rule.normalize
              ~confluent: next.Modul.confluent
298
              next.Modul.rules
299
              next.Modul.filters
300
              (Instance.clear instance) in
301
          let inst_list = Instance_set.elements good_set
302
              (* and bad_list = Instance_set.elements bad_set *) in
pj2m's avatar
pj2m committed
303

304
          match inst_list with
305
          | [{Instance.big_step = None}] ->
306
              Grew_types.Local_normal_form (instance.Instance.graph, next.Modul.name, loop instance tail)
307
          | _ -> Grew_types.Node
308 309 310
                (
                 instance.Instance.graph,
                 next.Modul.name,
311 312
                 List.map
                   (fun inst ->
313 314 315 316
                     match inst.Instance.big_step with
                     | None -> Error.bug "Cannot have no big_steps and more than one reducts at the same time"
                     | Some bs -> (bs, loop inst tail)
                   ) inst_list
317
                )
pj2m's avatar
pj2m committed
318
    in loop instance modules_to_apply
bguillaum's avatar
bguillaum committed
319

bguillaum's avatar
bguillaum committed
320 321 322
  let rule_iter fct grs =
    List.iter
      (fun modul ->
bguillaum's avatar
bguillaum committed
323 324 325 326 327 328 329
        List.iter (fun rule -> fct modul.Modul.name rule) modul.Modul.rules
      ) grs.modules

  let filter_iter fct grs =
    List.iter
      (fun modul ->
        List.iter (fun filter -> fct modul.Modul.name filter) modul.Modul.filters
bguillaum's avatar
bguillaum committed
330
      ) grs.modules
pj2m's avatar
pj2m committed
331 332
end  

bguillaum's avatar
bguillaum committed
333 334 335
module Gr_stat = struct

  (** the type [gr] stores the stats for the rewriting of one gr file *)
336
  type t = 
337
    | Stat of ((int * int) StringMap.t * int) (* map: rule_name |-> (min,max) occ, number of solution *) 
338
    | Error of string
bguillaum's avatar
bguillaum committed
339

340
  let opt_incr = function None -> Some 1 | Some x -> Some (x+1)
bguillaum's avatar
bguillaum committed
341 342 343 344 345 346
  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
347 348
            let (old_min, old_max) = try StringMap.find key acc with Not_found -> (None, None) in
            StringMap.add key (opt_incr old_min, opt_incr old_max) acc
bguillaum's avatar
bguillaum committed
349 350 351
          ) stat rules
    | None when rules = [] -> stat
    | None -> Log.fcritical "Unconsistent rewrite history"
352
          
bguillaum's avatar
bguillaum committed
353 354 355 356 357 358
  let max_stat stat1 stat2 =
    StringMap.fold
      (fun key value acc ->
        let old = try StringMap.find key acc with Not_found -> 0 in
        StringMap.add key (max old value) acc
      ) stat1 stat2
359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375

  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 =
    StringMap.fold
      (fun key (vmin, vmax) acc ->
        let (old_min, old_max) = try StringMap.find key acc with Not_found -> (Some 0, Some 0) in
        StringMap.add key (opt_min old_min vmin, opt_max old_max vmax) acc
      ) stat1 stat2


bguillaum's avatar
bguillaum committed
376 377 378 379 380 381
      
  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 
        | [] -> StringMap.empty
382
        | h::t -> List.fold_left min_max_stat h t in
bguillaum's avatar
bguillaum committed
383
      add_one_module prev_module rh.Rewrite_history.instance.Instance.rules sub_stat
384 385 386 387 388
    in 
    Stat
      (StringMap.map 
         (function | Some i, Some j -> (i,j) | _ -> Log.critical "None in stat")
         (loop None rew_history),
389
       (Rewrite_history.num_sol rew_history)
390
      )
bguillaum's avatar
bguillaum committed
391

392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416
  let from_rew_history rew_history =
    let rec loop prev_module rh =
      let sub_stat = 
        match (rh.Rewrite_history.good_nf, rh.Rewrite_history.bad_nf) with
        | [],[] -> Some (StringMap.empty)
        | [], _ -> None
        | l, _ -> 
            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
    | None -> Stat (StringMap.empty, Rewrite_history.num_sol rew_history)
    | Some map -> 
        Stat
          (
           StringMap.map (function Some i, Some j -> (i,j) | _ -> Log.critical "None in stat") map,
           Rewrite_history.num_sol rew_history
          )



417
  let save stat_file t =
bguillaum's avatar
bguillaum committed
418
    let out_ch = open_out stat_file in
419 420
    (match t with
    | Error msg -> fprintf out_ch "ERROR\n%s" msg 
bguillaum's avatar
bguillaum committed
421
    | Stat (map, num) ->
422
        fprintf out_ch "NUM_SOL:%d\n%!" num;
423 424 425 426
        StringMap.iter 
          (fun rule_name (min_occ,max_occ) ->  fprintf out_ch "%s:%d:%d\n%!" rule_name min_occ max_occ) map
    );
    
bguillaum's avatar
bguillaum committed
427 428
    close_out out_ch

429
  let load stat_file = 
430
    let sol = ref 0 in
bguillaum's avatar
bguillaum committed
431 432 433 434 435
    try
      let lines = File.read stat_file in
      match lines with
      | "ERROR" :: msg_lines -> Error (List_.to_string (fun x->x) "\n" msg_lines)
      | _ -> 
bguillaum's avatar
bguillaum committed
436 437 438 439
          let map =
            List.fold_left 
              (fun acc line ->
                match Str.split (Str.regexp ":") line with
440
                | ["NUM_SOL"; num] -> sol := int_of_string num; acc 
441
                | [modu_rule; vmin; vmax] -> StringMap.add modu_rule (int_of_string vmin, int_of_string vmax) acc
bguillaum's avatar
bguillaum committed
442 443 444 445
                | _ -> Log.fcritical "invalid stat line: %s" line
              ) StringMap.empty lines in
          Stat (map, !sol)
            
bguillaum's avatar
bguillaum committed
446
    with Sys_error msg -> Error (sprintf "Sys_error: %s" msg)
bguillaum's avatar
bguillaum committed
447 448 449 450 451 452 453
end (* module Gr_stat *)

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
bguillaum's avatar
bguillaum committed
454
     value: [occ_num, file_list] the total number of rule applications and the set of gr files concerned *)
bguillaum's avatar
bguillaum committed
455
  type t = {
456 457 458 459 460
      modules: Modul.t list;                                   (* ordered list of modules in the sequence *)
      map: ((int*int) * StringSet.t) StringMap.t StringMap.t;  (* map: see above *)
      amb: StringSet.t IntMap.t;                               (* key: nb of sols |-> set: sentence concerned *)
      error: (string * string) list;                           (* (file, msg) *)
      num: int;                                                (* an integer id relative to the corpus *)
bguillaum's avatar
bguillaum committed
461 462
    }

bguillaum's avatar
bguillaum committed
463
  let empty ~grs ~seq =
464 465
    (* let modules = try List.assoc seq grs.Grs.sequences with Not_found -> [seq] in *)
    let modules = Grs.modules_of_sequence grs seq in 
bguillaum's avatar
bguillaum committed
466 467
    let map = List.fold_left 
        (fun acc modul ->
468
          if List.exists (fun m -> modul.Modul.name = m.Modul.name) modules 
bguillaum's avatar
bguillaum committed
469 470 471 472
          then
            let rule_map = 
              List.fold_left
                (fun acc2 rule ->
473
                  StringMap.add (Rule.get_name rule) ((0,0),StringSet.empty) acc2
bguillaum's avatar
bguillaum committed
474 475 476
                ) StringMap.empty modul.Modul.rules in
            StringMap.add modul.Modul.name rule_map acc
          else acc
bguillaum's avatar
bguillaum committed
477
        ) StringMap.empty grs.Grs.modules in
bguillaum's avatar
bguillaum committed
478
    { modules=modules; map = map; amb = IntMap.empty; error = []; num = 0 }
bguillaum's avatar
bguillaum committed
479
      
480
  let add modul rule file (min_occ,max_occ) map = 
bguillaum's avatar
bguillaum committed
481
    let old_rule_map = StringMap.find modul map in
482
    let ((old_min,old_max), old_file_set) = StringMap.find rule old_rule_map in
bguillaum's avatar
bguillaum committed
483 484 485 486
    StringMap.add 
      modul 
      (StringMap.add
         rule
487
         ((old_min + min_occ, old_max + max_occ), StringSet.add file old_file_set)
bguillaum's avatar
bguillaum committed
488 489
         old_rule_map
      ) map
490
        
bguillaum's avatar
bguillaum committed
491
  let add_gr_stat base_name gr_stat t = 
492 493
    match gr_stat with
    | Gr_stat.Error msg -> { t with error = (base_name, msg) :: t.error; num = t.num+1 }
494
    | Gr_stat.Stat (map, sol) -> 
495 496
        let new_map = 
          StringMap.fold
497
            (fun modul_rule (min_occ,max_occ) acc ->
498
              match Str.split (Str.regexp "\\.") modul_rule with
499
              | [modul; rule] -> add modul rule base_name (min_occ,max_occ) acc
500 501
              | _ -> Log.fcritical "illegal modul_rule spec \"%s\"" modul_rule 
            ) map t.map in
bguillaum's avatar
bguillaum committed
502 503 504 505
        let new_amb = 
              let old = try IntMap.find sol t.amb with Not_found -> StringSet.empty in
              IntMap.add sol (StringSet.add base_name old) t.amb in
        { t with map = new_map; num = t.num+1; amb=new_amb; }
bguillaum's avatar
bguillaum committed
506 507 508



bguillaum's avatar
bguillaum committed
509 510
  let unfoldable_set out_ch ?(bound=10) html id file_set =
    let counter = ref 0 in
bguillaum's avatar
bguillaum committed
511
    
bguillaum's avatar
bguillaum committed
512 513 514 515 516 517 518 519
    StringSet.iter
      (fun file -> 
        if !counter = bound
        then fprintf out_ch "<div id=\"%s\" style=\"display:none;\">\n" id;
        incr counter;
        let link = if html then sprintf "<a href=\"%s.html\">%s</a>" file file else file in
        fprintf out_ch "%s &nbsp;&nbsp;\n" link
      ) file_set;
bguillaum's avatar
bguillaum committed
520
    
bguillaum's avatar
bguillaum committed
521 522 523 524 525 526 527 528 529 530 531 532
    if (!counter > bound)
    then 
      begin
        fprintf out_ch "</div>\n";
        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
        fprintf out_ch "  <div>\n";
        fprintf out_ch "    <a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s').style.display == 'none') { %s } else { %s }\">\n" id if_part else_part;
        fprintf out_ch "      <b><p id=\"p_%s\">+ Show all +</p></b>\n" id;
        fprintf out_ch "    </a>\n";
        fprintf out_ch "  </div>\n";
      end
bguillaum's avatar
bguillaum committed
533

534

bguillaum's avatar
bguillaum committed
535

bguillaum's avatar
bguillaum committed
536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563


  let save_html ~title ~grs_file ~html ~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] *)
   ignore(Sys.command("cp "^(Filename.concat DATA_DIR "style.css")^" "^(Filename.concat output_dir "style.css")));
   
   (* output of index.html *)
   let out_ch = open_out (Filename.concat output_dir "index.html") in    
   
   fprintf out_ch "<head>\n";
   fprintf out_ch "  <link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">\n";
   fprintf out_ch "  <title>%s</title>\n" title;
   fprintf out_ch "  <meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" />\n";
   fprintf out_ch "</head>\n";

   fprintf out_ch "<h1>%s</h1>\n" title;
   fprintf out_ch "<b>Grs file</b>:<a href =\"%s\">%s</a>\n<br/>\n" (Filename.basename grs_file) (Filename.basename grs_file);
   fprintf out_ch "<b>%d Sentences</b><br/>\n<br/>\n" t.num;

   fprintf out_ch "<center><table cellpadding=3 cellspacing=0 width=95%%>\n";
   List.iter
     (fun modul ->
       let modul = modul.Modul.name in
       let rules = StringMap.find modul t.map in
       fprintf out_ch "<tr><td colspan=\"5\" style=\"padding: 0px;\"><h6>Module %s</h6></td></tr>\n" modul;
564 565
       fprintf out_ch "<tr><th class=\"first\">Rule</th><th>#occ(min/max)</th><th>#files</th><th>Ratio</th><th>Files</th></tr>\n";
       let ((min_occ, max_occ), full_sent) = 
bguillaum's avatar
bguillaum committed
566
         StringMap.fold
567 568
           (fun _ ((v_min,v_max), file_set) ((acc_min,acc_max), acc_sent) -> ((acc_min+v_min, acc_max+v_max), StringSet.union acc_sent file_set))
           rules ((0,0),StringSet.empty) in
bguillaum's avatar
bguillaum committed
569 570 571
       let tot_sent = StringSet.cardinal full_sent in
       fprintf out_ch "<tr>\n";
       fprintf out_ch "<td class=\"first_total\">Total for module</td>\n";
572
       fprintf out_ch "<td class=\"total\">%d/%d</td>" min_occ max_occ;
bguillaum's avatar
bguillaum committed
573 574 575 576 577 578
       fprintf out_ch "<td class=\"total\">%d</td>" tot_sent;
       fprintf out_ch "<td class=\"total\">%.2f%%</td>" (ratio tot_sent);
       fprintf out_ch "<td class=\"total\">&nbsp;</td>\n";
       fprintf out_ch "</tr>\n";
       
        StringMap.iter
579
         (fun rule ((min_occ, max_occ), file_set) ->
bguillaum's avatar
bguillaum committed
580 581 582 583
           let id = sprintf "%s_%s" modul rule in
           let file_num = StringSet.cardinal file_set in
           
           fprintf out_ch "<tr>\n";
584 585 586
           fprintf out_ch "  <td class=\"first_stats\"  valign=top><a href=\"doc/%s.html\">%s</a></td>\n" 
             id
             rule;
587
           fprintf out_ch "  <td class=\"stats\"  valign=top>%d/%d</td>\n" min_occ max_occ;
bguillaum's avatar
bguillaum committed
588 589 590 591 592 593 594 595 596 597 598 599
           fprintf out_ch "  <td class=\"stats\"  valign=top>%d</td>\n" file_num;
           fprintf out_ch "  <td class=\"stats\"  valign=top>%.2f%%</td>\n" (ratio file_num);
           
           fprintf out_ch "  <td class=\"stats\">\n";
           (if file_num = 0
           then fprintf out_ch "  &nbsp;"
           else unfoldable_set out_ch html id file_set);
           fprintf out_ch "  </td>\n";
           fprintf out_ch "</tr>\n";
         ) rules;

     ) t.modules;
bguillaum's avatar
bguillaum committed
600 601


bguillaum's avatar
bguillaum committed
602 603 604 605
    (* add a subtlabe for sentence ambiguity *)
    if not (IntMap.is_empty t.amb)
    then
      begin
bguillaum's avatar
bguillaum committed
606
        fprintf out_ch "<tr><td colspan=5><h6>Rewriting ambiguity</h6></td></tr>\n";
bguillaum's avatar
bguillaum committed
607 608 609 610
        fprintf out_ch "<tr><th class=\"first\" >Number of normal forms</th><th colspan=2 width=20>#files</th><th >Ratio</th><th>Files</th></tr>\n";
        
        IntMap.iter
          (fun num set -> 
bguillaum's avatar
bguillaum committed
611
            let id = sprintf "amb_%d" num in
bguillaum's avatar
bguillaum committed
612 613
            let num_files = StringSet.cardinal set in
            fprintf out_ch "<tr>\n";
bguillaum's avatar
bguillaum committed
614 615 616 617 618 619 620 621 622 623 624 625
            fprintf out_ch "  <td class=\"first_stats\">%d</td>\n" num;
            fprintf out_ch "  <td class=\"stats\" colspan=2>%d</td>\n" num_files;
            fprintf out_ch "  <td class=\"stats\">%.2f%%</td>\n" (ratio num_files);
            fprintf out_ch "  <td class=\"stats\">";
            
            (* StringSet.iter *)
            (*   (fun (file) -> *)
            (*     if html  *)
            (*     then fprintf out_ch "<a href=\"%s.html\">%s</a><br/>" file file *)
            (*     else fprintf out_ch "%s<br/>" file *)
            (*   ) set; *)
            unfoldable_set out_ch html id set;
bguillaum's avatar
bguillaum committed
626
            
bguillaum's avatar
bguillaum committed
627 628
            fprintf out_ch "  </td>\n";
            fprintf out_ch "</tr>\n") t.amb
bguillaum's avatar
bguillaum committed
629 630 631
      end;
    

632
    (* add a subtable for sentence that produces an error *)
bguillaum's avatar
bguillaum committed
633 634 635
    (match List.length t.error with
    | 0 -> ()
    | nb_errors ->
bguillaum's avatar
bguillaum committed
636
        fprintf out_ch "<tr><td colspan=5><h6>ERRORS</h6></td></tr>\n";
bguillaum's avatar
bguillaum committed
637
        fprintf out_ch "<tr><th class=\"first\" >Rule</th><th colspan=2 width=20>#files</th><th >Ratio</th><th>Files</th></tr>\n";
638
        
bguillaum's avatar
bguillaum committed
639 640 641 642 643
        fprintf out_ch "<tr>\n";
        fprintf out_ch "<td class=\"first_stats\">Errors</td>\n";
        fprintf out_ch "<td class=\"stats\" colspan=2>%d</td>\n" nb_errors;
        fprintf out_ch "<td class=\"stats\">%.2f%%</td>\n" (ratio nb_errors);
        fprintf out_ch "<td class=\"stats\">";
644
        
bguillaum's avatar
bguillaum committed
645 646 647 648 649 650 651 652 653 654 655 656
        match t.error with 
        | [] -> fprintf out_ch "&nbsp;"
        | l ->
            List.iter
              (fun (file,err) ->
                if html 
                then fprintf out_ch "<a href=\"%s.html\">%s</a>: %s<br/>" file file err
                else fprintf out_ch "%s: %s<br/>" file err
              ) (List.rev l);
            
            fprintf out_ch "</td>\n";
            fprintf out_ch "</tr>");
bguillaum's avatar
bguillaum committed
657

bguillaum's avatar
bguillaum committed
658
    fprintf out_ch "</table></center>\n";
bguillaum's avatar
bguillaum committed
659 660


bguillaum's avatar
bguillaum committed
661 662
    close_out out_ch;
    ()
bguillaum's avatar
bguillaum committed
663
end (* module Stat *)