Attention une mise à jour du serveur va être effectuée le vendredi 16 avril entre 12h et 12h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit 90011abf authored by bguillaum's avatar bguillaum

code review for corpus and stats

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6637 7838e531-6607-4d57-9587-6c381814729c
parent 126a59b9
......@@ -28,7 +28,7 @@ INFO = @INFO@
OCAMLFIND_DIR=`ocamlfind printconf destdir`
VERSION = 0.9.1
VERSION = 0.9.2
cleanup:
rm -rf *.cmo *.cmx *.cmi *.annot *.o *.*~
......
......@@ -36,27 +36,6 @@ module Rewrite_history = struct
| [] -> [local]
| l -> local :: (List.flatten (List.map rules l))
let add_one_module modul rules stat =
List.fold_left
(fun acc rule ->
let key = sprintf "%s.%s" modul rule in
let old = try StringMap.find key acc with Not_found -> 0 in
StringMap.add key (old+1) acc
) stat rules
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 rec rules_stat t =
let sub_stat =
match List.map rules_stat t.good_nf with
| [] -> StringMap.empty
| h::t -> List.fold_left max_stat h t in
add_one_module t.module_name t.instance.Instance.rules sub_stat
IFDEF DEP2PICT THEN
(* warning: path are returned in reverse order *)
......@@ -87,10 +66,7 @@ IFDEF DEP2PICT THEN
loop true ([],[]) t;
List.rev !nfs
let save_html ?main_feat ?(init_graph=true) ?header prefix number t =
let stats = ref [] in
let save_html ?main_feat ?(init_graph=true) ?header prefix t =
(* 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
......@@ -104,7 +80,7 @@ IFDEF DEP2PICT THEN
(* All normal forms view *)
let html_ch = open_out (sprintf "%s.html" prefix) in
let title = sprintf "Sentence %d : %s --- %d Normal form%s" number local l (if l>1 then "s" else "") in
let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
let () = Html.enter html_ch ~title ?header prefix in
if init_graph
......@@ -126,7 +102,7 @@ IFDEF DEP2PICT THEN
(* the modules list *)
fprintf html_ch "<b>Modules applied</b>: %d<br/>\n" (List.length rules_list);
let id =sprintf "id_%d" (i+1) in
let id = sprintf "id_%d" (i+1) in
fprintf html_ch "<a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s').style.display == 'none') { document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = 'Hide'; } else { document.getElementById('%s').style.display = 'none';; document.getElementById('p_%s').innerHTML = 'Show'; }\"><b><p id=\"p_%s\">Show</p></b></a>\n" id id id id id id;
......@@ -137,7 +113,6 @@ IFDEF DEP2PICT THEN
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);
stats := (mod_name,rules)::(!stats)
)
rules_list;
fprintf html_ch " </div>\n"
......@@ -145,10 +120,7 @@ IFDEF DEP2PICT THEN
) nf_files;
Html.leave html_ch;
close_out html_ch;
List.rev !stats
close_out html_ch
ENDIF
end
......@@ -198,18 +170,20 @@ module Grs = struct
sequences = List.map (fun s -> (s.Ast.seq_name, s.Ast.seq_mod)) ast_grs.Ast.sequences;
}
let rewrite grs sequence instance =
let module_names_to_apply =
let modules_of_sequence grs sequence =
let module_names =
try List.assoc sequence grs.sequences
with Not_found -> [sequence] in
let modules_to_apply =
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_to_apply in
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
let rec loop instance = function
| [] -> (* no more modules to apply *)
......@@ -228,22 +202,12 @@ module Grs = struct
module_name = next.Modul.name;
good_nf = List.map (fun i -> loop i tail) good_list;
bad_nf = bad_list;
}
in loop instance modules_to_apply
} in
loop instance modules_to_apply
let build_rew_display grs sequence instance =
let modules_to_apply = modules_of_sequence grs sequence in
let build_rew_display grs sequence instance =
let module_names_to_apply =
try List.assoc sequence grs.sequences
with Not_found -> [sequence] in
let modules_to_apply =
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_to_apply in
let rec loop instance = function
| [] -> Grew_types.Leaf instance.Instance.graph
| next :: tail ->
......@@ -271,5 +235,207 @@ module Grs = struct
) inst_list
)
in loop instance modules_to_apply
end
module Gr_stat = struct
(** the type [gr] stores the stats for the rewriting of one gr file *)
type t = int StringMap.t
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 = try StringMap.find key acc with Not_found -> 0 in
StringMap.add key (old+1) 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 rec from_rew_history t = *)
(* let sub_stat = *)
(* match List.map from_rew_history t.Rewrite_history.good_nf with *)
(* | [] -> StringMap.empty *)
(* | h::t -> List.fold_left max_stat h t in *)
(* add_one_module t.Rewrite_history.module_name t.Rewrite_history.instance.Instance.rules sub_stat *)
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 max_stat h t in
add_one_module prev_module rh.Rewrite_history.instance.Instance.rules sub_stat
in loop None rew_history
let save stat_file t =
let out_ch = open_out stat_file in
StringMap.iter (fun rule_name occ -> fprintf out_ch "%s:%d\n%!" rule_name occ) t;
close_out out_ch
let load stat_file =
List.fold_left
(fun acc line ->
match Str.split (Str.regexp ":") line with
| [modu_rule; num] -> StringMap.add modu_rule (int_of_string num) acc
| _ -> Log.fcritical "invalid stat line: %s" line
) StringMap.empty (File.read stat_file)
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_nul, file_list] the totat number of rule applications and the set of gr files concerned *)
type t = {
map: (int * StringSet.t) StringMap.t StringMap.t;
num: int;
}
let empty grs =
let map = List.fold_left
(fun acc modul ->
let rule_map =
List.fold_left
(fun acc2 rule ->
StringMap.add (Rule.get_name rule) (0,StringSet.empty) acc2
) StringMap.empty modul.Modul.rules in
StringMap.add modul.Modul.name rule_map acc
) StringMap.empty grs.Grs.modules in
{ map = map; num = 0 }
let add modul rule file num map =
let old_rule_map = StringMap.find modul map in
let (old_num, old_file_set) = StringMap.find rule old_rule_map in
StringMap.add
modul
(StringMap.add
rule
(old_num + num, StringSet.add file old_file_set)
old_rule_map
) map
let add_gr_stat base_name gr_stat t =
let new_map =
StringMap.fold
(fun modul_rule num_occ acc ->
match Str.split (Str.regexp "\\.") modul_rule with
| [modul; rule] -> add modul rule base_name num_occ acc
| _ -> Log.fcritical "illegal modul_rule spec \"%s\"" modul_rule
) gr_stat t.map in
{ map = new_map; num = t.num+1 }
let save_html ~title ~grs_file ~html ~output_dir t =
let ratio nb = (float nb) /. (float t.num) *. 100. in
let out_ch = open_out (Filename.concat output_dir "index.html") in
let css = "<link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">" in
ignore(Sys.command("cp "^(Filename.concat DATA_DIR "style.css")^" "^(Filename.concat output_dir "style.css")));
fprintf out_ch "<head>\n%s\n<title>%s</title>\n<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" /></head>\n" css title;
fprintf out_ch "<h1>%s</h1>\n" title;
fprintf out_ch "<b>Grs file</b>:<a href =\"%s\">%s</a>\n<br/>\n" 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=10 cellspacing=0 width=90%%>\n";
StringMap.iter
(fun modul rules ->
fprintf out_ch "<tr><td colspan=5><h6>Module %s</h6></td>\n" modul;
fprintf out_ch "<tr><th class=\"first\" width=10>Rule</th><th width=10>#occ</th><th width=10>#files</th><th width=10>Ratio</th><th width=10>Files</th></tr>\n";
StringMap.iter
(fun rule (occ_num, file_set) ->
let file_list = StringSet.elements file_set in
let tmp = ref "" in
let counter = ref 0 in
let rec compute list = match list with
| [] -> ()
| h::[] ->
if (!counter = 10) then (
tmp := sprintf "%s<div id=\"%s_%s\" style=\"display:none;\">\n" !tmp modul rule
);
incr counter;
if html
then tmp := sprintf "%s<a href=\"%s.html\">%s</a>" !tmp h h
else tmp := sprintf "%s%s" !tmp h
| h::t ->
if (not (List.mem h t)) then ( (*avoid doublons*)
if (!counter = 10) then (
tmp := sprintf "%s<div id=\"%s_%s\" style=\"display:none;\">\n" !tmp modul rule
);
incr counter;
if html
then tmp := sprintf "%s<a href=\"%s.html\">%s</a>" !tmp h h
else tmp := sprintf "%s%s" !tmp h
);
compute t
in compute (List.rev file_list);
if file_list = [] then tmp := "&nbsp;";
let file_num = List.length file_list in
fprintf out_ch "<tr>\n";
fprintf out_ch "<td class=\"first_stats\" width=10 valign=top>%s</td>\n" rule;
fprintf out_ch "<td class=\"stats\" width=10 valign=top>%d</td>\n" occ_num;
fprintf out_ch "<td class=\"stats\" width=10 valign=top>%d</td>\n" file_num;
fprintf out_ch "<td class=\"stats\" width=10 valign=top>%.2f%%</td>\n" (ratio file_num);
fprintf out_ch "<td class=\"stats\">%s" !tmp;
if (!counter > 10)
then (
fprintf out_ch "</div><a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s_%s').style.display == 'none') { %s } else { %s }\"><b><p id=\"p_%s_%s\">+ Show more +</p></b></a>\n"
modul rule
(sprintf "document.getElementById('%s_%s').style.display = 'block'; document.getElementById('p_%s_%s').innerHTML = '- Show less -';" modul rule modul rule)
(sprintf "document.getElementById('%s_%s').style.display = 'none';; document.getElementById('p_%s_%s').innerHTML = '+ Show more +';" modul rule modul rule)
modul rule;
);
fprintf out_ch "</td></tr>\n";
) rules;
) t.map;
(* FIXME error in index.html *)
(* (\* add a subtalbe for sentence that produces an error *\) *)
(* let nb_errors = List.length !errors in *)
(* fprintf out_ch "<tr><td colspan=5><h6>ERRORS</h6></td>\n"; *)
(* fprintf out_ch "<tr><th class=\"first\" width=10>Rule</th><th colspan=2 width=20>#files</th><th width=10>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\">"; *)
(* List.iter *)
(* (fun err -> *)
(* fprintf out_ch "<a href=\"%s.html\">%s</a><br/>" (Filename.chop_extension err) (Filename.chop_extension err) *)
(* ) (List.rev !errors); *)
(* fprintf out_ch "</td>\n"; *)
(* fprintf out_ch "</tr>"; *)
fprintf out_ch "</table></center>\n";
close_out out_ch;
()
end (* module Stat *)
......@@ -2,6 +2,8 @@ open Utils
open Graph
open Rule
module Rewrite_history: sig
type t = {
instance: Instance.t;
......@@ -12,10 +14,9 @@ module Rewrite_history: sig
val rules: t -> (string * string list) list
val rules_stat: t -> int StringMap.t
IFDEF DEP2PICT THEN
val save_html: ?main_feat:string -> ?init_graph:bool -> ?header:string -> string -> int -> t -> (string*string list) list
val save_html: ?main_feat:string -> ?init_graph:bool -> ?header:string -> string -> t -> unit
ENDIF
end
......@@ -36,3 +37,34 @@ module Grs: sig
(* only externeal strucutre is returned, each edge contains a "dummy" big_step *)
val build_rew_display: t -> string -> Instance.t -> Grew_types.rew_display
end
module Gr_stat: sig
(** the type [gr] stores the stats for the rewriting of one gr file:
map of [mod.rule] to the max usage in applied during a rewriting. *)
type t = int StringMap.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.t -> t
val add_gr_stat: string -> Gr_stat.t -> t -> t
val save_html:
title: string ->
grs_file: string ->
html:bool -> (* if [html] put hlinks on files *)
output_dir:string ->
t -> unit
end
This diff is collapsed.
......@@ -20,8 +20,20 @@ exception Bug of string * (string * int) option
(**/**)
type grs = Grs.t
type gr = Instance.t
type rew_history
(**/**)
val rewrite: gr:gr -> grs:grs -> seq:string -> rew_history
(** display a gr with a grs in a rew_display
@param gr the grapth to rewrite
@param grs the graph rewriting system
@param seq the name of the sequence to apply
@return a structure {b {i easily}} displayable *)
val display: gr:gr -> grs:grs -> seq:string -> rew_display
val write_stat: string -> rew_history -> unit
val empty_grs : grs
(** get a graph rewriting system from a file
......@@ -41,23 +53,23 @@ val empty_gr : gr
*)
val load_gr : string -> gr
(** rewrite a gr with a grs in a rew_display
@param gr the grapth to rewrite
@param grs the graph rewriting system
@param seq the name of the sequence to apply
@return a structure {b {i easily}} displayable *)
val rewrite : gr:gr -> grs:grs -> seq:string -> rew_display
(* OLD val rules_stat: Grs.t -> string -> string -> (string * int) list *)
val rules_stat: string -> Grs.t -> string -> string -> (string * int) list
IFDEF DEP2PICT THEN
val write_html:
?no_init:bool -> ?main_feat:string -> header: string -> rew_history -> string -> unit
val make_index:
title: string ->
grs_file: string ->
html: bool ->
grs: grs ->
output_dir: string ->
base_names: string list ->
unit
val rewrite_to_html_intern :
?no_init:bool -> ?main_feat:string -> string -> Grs.t -> string -> string -> string -> int -> string -> string -> (string * string list) list option
val rewrite_to_html :
?main_feat:string -> string -> string -> string -> bool -> string -> Grs.t -> string -> string -> unit
IFDEF DEP2PICT THEN
val dummy: unit
(* FIXME: build whitout dep2pict *)
ENDIF
val get_css_file: string
......@@ -114,6 +114,8 @@ module Rule = struct
commands: Command.t list;
}
let get_name t = t.name
let build ?domain ?(locals=[||]) rule_ast =
(* (\* DEBUG *\) Printf.printf "==<Rule.build |neg|=%d>==\n%!" (List.length rule_ast.Ast.neg_patterns); *)
......
......@@ -34,6 +34,8 @@ module Instance_set : Set.S with type elt = Instance.t
module Rule : sig
type t
val get_name: t -> string
val build: ?domain:Ast.domain -> ?locals:Label.decl array -> Ast.rule -> t
(* raise Stop if some command fails to apply *)
......
open Log
open Printf
module StringSet = Set.Make (String)
module StringMap = Map.Make (String)
module IntSet = Set.Make (struct type t = int let compare = Pervasives.compare end)
......@@ -73,6 +74,17 @@ module File = struct
let out_ch = open_out name in
fprintf out_ch "%s\n" data;
close_out out_ch
let read file =
let in_ch = open_in file in
let rev_lines = ref [] in
try
while true do
rev_lines := (input_line in_ch) :: !rev_lines
done; assert false
with End_of_file ->
close_in in_ch;
List.rev !rev_lines
end
......
......@@ -9,6 +9,7 @@ module IntMap : sig
end
module StringMap : Map.S with type key = string
module StringSet : Set.S with type elt = string
module Loc: sig
type t = string * int
......@@ -20,6 +21,8 @@ end
module File: sig
val write: string -> string -> unit
val read: string -> string list
end
module Array_: sig
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment