Commit 8a38da57 authored by bguillaum's avatar bguillaum

reorganize HTML production

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7456 7838e531-6607-4d57-9587-6c381814729c
parent 8b4de53c
FILES_DEP = grew_utils grew_ast grew_html grew_fs grew_edge grew_node grew_graph grew_types grew_command grew_rule grew_grs
FILES_DEP = grew_utils grew_ast grew_fs grew_edge grew_node grew_graph grew_types grew_command grew_rule grew_grs grew_html
FILES_ML = $(FILES_DEP:%=%.ml)
FILES_MLI = $(FILES_DEP:%=%.mli)
FILES_CMI = $(FILES_DEP:%=%.cmi)
......@@ -139,7 +139,7 @@ grew_ast.cmx: $(GREW_AST_CMX) grew_ast.cmi grew_ast.ml
###### grew_html.ml ##############################################################
GREW_HTML_DEP = grew_utils grew_ast
GREW_HTML_DEP = grew_utils grew_ast grew_rule grew_grs
GREW_HTML_CMI = $(GREW_HTML_DEP:%=%.cmi)
GREW_HTML_CMO = $(GREW_HTML_DEP:%=%.cmo)
GREW_HTML_CMX = $(GREW_HTML_DEP:%=%.cmx)
......
......@@ -235,6 +235,8 @@ module Grs = struct
sequences: Sequence.t list;
}
let get_modules t = t.modules
let sequence_names t = List.map (fun s -> s.Sequence.name) t.sequences
let empty = {labels=[]; modules=[]; sequences=[];}
......@@ -349,334 +351,3 @@ module Grs = struct
List.iter (fun filter -> fct modul.Modul.name filter) modul.Modul.filters
) grs.modules
end
module Gr_stat = struct
(** the type [gr] stores the stats for the rewriting of one gr file *)
type t =
| Stat of ((int * int) StringMap.t * int) (* map: rule_name |-> (min,max) occ, number of solution *)
| 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
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
) stat rules
| None when rules = [] -> stat
| None -> Log.fcritical "Unconsistent rewrite history"
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
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
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
| 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
(StringMap.map
(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 =
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
)
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;
StringMap.iter
(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
| [modu_rule; vmin; vmax] -> StringMap.add modu_rule (int_of_string vmin, int_of_string vmax) acc
| _ -> Log.fcritical "invalid stat line: %s" line
) StringMap.empty lines in
Stat (map, !sol)
with Sys_error msg -> Error (sprintf "Sys_error: %s" msg)
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
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 *)
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 *)
}
let empty ~grs ~seq =
(* let modules = try List.assoc seq grs.Grs.sequences with Not_found -> [seq] in *)
let modules = Grs.modules_of_sequence grs seq in
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 ->
StringMap.add (Rule.get_name rule) ((0,0),StringSet.empty) acc2
) StringMap.empty modul.Modul.rules in
StringMap.add modul.Modul.name rule_map acc
else acc
) StringMap.empty grs.Grs.modules in
{ modules=modules; map = map; amb = IntMap.empty; error = []; num = 0 }
let add modul rule file (min_occ,max_occ) map =
let old_rule_map = StringMap.find modul map in
let ((old_min,old_max), old_file_set) = StringMap.find rule old_rule_map in
StringMap.add
modul
(StringMap.add
rule
((old_min + min_occ, old_max + max_occ), StringSet.add file old_file_set)
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 =
StringMap.fold
(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 =
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; }
let unfoldable_set output_dir out_ch ?(bound=10) id file_set =
let counter = ref 0 in
StringSet.iter
(fun file ->
if !counter = bound
then fprintf out_ch "<div id=\"%s\" style=\"display:none;\">\n" id;
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
fprintf out_ch "%s &nbsp;&nbsp;\n" link
) file_set;
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
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] *)
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 "<a href=\"sentences.html\">Sentences</a> -- Rewriting stats -- <a href=\"doc/index.html\">GRS documentation</a>\n";
fprintf out_ch "<h1>%s</h1>\n" (Str.global_replace (Str.regexp "#") " " title);
fprintf out_ch "<h2>Rewriting stats</h2>\n";
fprintf out_ch "<center><table cellpadding=3 cellspacing=0 width=95%%>\n";
List.iter
(fun modul ->
let modul_name = modul.Modul.name in
let rules = StringMap.find modul_name t.map in
fprintf out_ch "<tr><td colspan=\"5\" style=\"padding: 0px;\"><h6>Module %s</h6></td></tr>\n" modul_name;
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) =
StringMap.fold
(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
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";
fprintf out_ch "<td class=\"total\">%d/%d</td>" min_occ max_occ;
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";
List.iter (* iteration on list to keep the same order in html output and in grs input *)
(fun rule ->
let rule_name = Rule.get_name rule in
let ((min_occ, max_occ), file_set) = StringMap.find rule_name rules in
let id = sprintf "%s_%s" modul_name rule_name in
let file_num = StringSet.cardinal file_set in
fprintf out_ch "<tr>\n";
fprintf out_ch " <td class=\"first_stats\" valign=top><a href=\"doc/%s.html\">%s</a></td>\n"
id
rule_name;
fprintf out_ch " <td class=\"stats\" valign=top>%d/%d</td>\n" min_occ max_occ;
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 output_dir out_ch id file_set);
fprintf out_ch " </td>\n";
fprintf out_ch "</tr>\n";
) modul.Modul.rules
) t.modules;
(* add a subtable for sentence ambiguity *)
if not (IntMap.is_empty t.amb)
then
begin
fprintf out_ch "<tr><td colspan=5><h6>Rewriting ambiguity</h6></td></tr>\n";
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 ->
let id = sprintf "amb_%d" num in
let num_files = StringSet.cardinal set in
fprintf out_ch "<tr>\n";
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\">";
unfoldable_set output_dir out_ch id set;
fprintf out_ch " </td>\n";
fprintf out_ch "</tr>\n") t.amb
end;
(* add a subtable for sentence that produces an error *)
(match List.length t.error with
| 0 -> ()
| nb_errors ->
fprintf out_ch "<tr><td colspan=5><h6>ERRORS</h6></td></tr>\n";
fprintf out_ch "<tr><th class=\"first\" >Rule</th><th colspan=2 width=20>#files</th><th >Ratio</th><th>Files</th></tr>\n";
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\">";
match t.error with
| [] -> fprintf out_ch "&nbsp;"
| l ->
List.iter
(fun (file,err) ->
if Sys.file_exists (Filename.concat output_dir (sprintf "%s.html" file))
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>");
fprintf out_ch "</table></center>\n";
close_out out_ch
end (* module Stat *)
......@@ -3,7 +3,6 @@ open Grew_graph
open Grew_rule
open Grew_ast
module Rewrite_history: sig
type t = {
instance: Instance.t;
......@@ -40,15 +39,26 @@ module Rewrite_history: sig
val save_gr: string -> t -> unit
end
module Sequence: sig
type t
module Modul: sig
type t = {
name: string;
local_labels: (string * string option) array;
rules: Rule.t list;
filters: Rule.t list;
confluent: bool;
loc: Loc.t;
}
end
module Grs: sig
type t
val empty:t
val get_modules: t -> Modul.t list
val sequence_names: t -> string list
val build: Ast.grs -> t
......@@ -60,33 +70,6 @@ module Grs: sig
val rule_iter: (string -> Rule.t -> unit) -> t -> unit
val filter_iter: (string -> Rule.t -> unit) -> t -> unit
end
module Gr_stat: sig
type t
val from_rew_history: Rewrite_history.t -> t
val save: string -> t -> unit
val load: string -> t
end
module Corpus_stat: sig
type t
val empty: grs:Grs.t -> seq:string -> t
val add_gr_stat: string -> Gr_stat.t -> t -> t
val save_html:
title: string ->
grs_file: string ->
input_dir:string ->
output_dir:string ->
t -> unit
val modules_of_sequence: t -> string -> Modul.t list
end
open Printf
open Log
open Grew_utils
open Grew_ast
open Grew_rule
open Grew_grs
let header ?title buff =
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>";
wnl " <meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">\n";
wnl " <link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">";
(match title with
| Some t -> wnl " <title>%s</title>" (Str.global_replace (Str.regexp "#") " " t)
| None -> ()
);
wnl " </head>";
(* ====================================================================================================*)
module Html = struct
module Html_doc = struct
let string_of_concat_item = function
| Ast.Qfn_item (n,f) -> sprintf "%s.%s" n f
......@@ -136,21 +155,6 @@ module Html = struct
| None -> "black"
| Some c -> c
let header ?title buff =
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>";
wnl " <link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">";
(match title with
| Some t -> wnl " <title>%s</title>" (Str.global_replace (Str.regexp "#") " " t)
| None -> ()
);
wnl " </head>";
wnl " <body>"
let module_page_text prev next module_ =
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
......@@ -159,6 +163,7 @@ module Html = struct
let title = sprintf "Grew -- Module %s" module_.Ast.module_id in
header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">";
w " ";
(match prev with Some p -> w "&nbsp;<a href=\"%s.html\">Previous</a> " p | _ -> ());
......@@ -193,6 +198,7 @@ module Html = struct
let title = sprintf "Grew -- Rule %s/%s" mid rid in
header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">";
w " ";
(match prev with Some p -> w "&nbsp;<a href=\"%s_%s.html\">Previous</a> " mid p | _ -> ());
......@@ -262,6 +268,7 @@ module Html = struct
let title = sprintf "Grew -- List of sequences" in
header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
wnl " <center><h1>List of sequences</h1></center>";
List.iter
......@@ -287,6 +294,7 @@ module Html = struct
let title = sprintf "Grew -- Index of modules" in
header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
wnl " <center><h1>Index of modules</h1></center>";
wnl " <table width=100%%>";
......@@ -317,6 +325,7 @@ module Html = struct
let title = sprintf "Grew -- Features domain" in
header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
wnl " <h6>Features</h6>";
......@@ -345,7 +354,7 @@ module Html = struct
Buffer.contents buff
(* dep is a flag which is true iff dep file are shown in doc (iff dep2pict is available) *)
let proceed ~dep file output_dir ast =
let build ~dep file output_dir ast =
ignore(Sys.command ("rm -rf "^output_dir));
ignore(Sys.command ("mkdir "^output_dir));
ignore(Sys.command ("cp "^DATA_DIR^"/style.css "^output_dir));
......@@ -361,6 +370,7 @@ module Html = struct
let title = sprintf "Grew -- Graph Rewriting System: %s" (Filename.basename file) in
header ~title buff;
wnl " <body>";
wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
wnl "<h1>Graph Rewriting System: %s</h1>" (Filename.basename file);
......@@ -438,16 +448,18 @@ module Html = struct
close_out page_out_ch;
done;
done
end
let html_sentences output_dir sentences =
module Html_sentences = struct
let build output_dir sentences =
let buff = Buffer.create 32 in
header ~title:"Sentence list" buff;
bprintf buff " <body>";
bprintf buff "Sentences -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>\n";
bprintf buff "<h2>Sentences list</h2>\n";
bprintf buff "<center><table cellpadding=3 cellspacing=0 width=95%%>\n";
bprintf buff "<center><table cellpadding=3 cellspacing=0 width=\"95%%\">\n";
bprintf buff "<tr><th class=\"first\">Number of normal forms</th><th>Sentence</th></tr>\n";
List.iter
......@@ -465,6 +477,338 @@ module Html = struct
let out_ch = open_out (Filename.concat output_dir "sentences.html") in
fprintf out_ch "%s" (Buffer.contents buff);
close_out out_ch
end (* module Html_sentences *)
module Gr_stat = struct
(** the type [gr] stores the stats for the rewriting of one gr file *)
type t =
| Stat of ((int * int) StringMap.t * int) (* map: rule_name |-> (min,max) occ, number of solution *)
| 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
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
) stat rules
| None when rules = [] -> stat
| None -> Log.fcritical "Unconsistent rewrite history"
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
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