Commit b90bd7ce authored by bguillaum's avatar bguillaum

version 0.11.0: improve html produced in corpus mode

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7185 7838e531-6607-4d57-9587-6c381814729c
parent e23ddaa0
VERSION = 0.10.0 VERSION = 0.11.0
INSTALL_DIR_LIB = @OCAMLLIB@ INSTALL_DIR_LIB = @OCAMLLIB@
INSTALL_DIR = @prefix@/bin/ INSTALL_DIR = @prefix@/bin/
......
...@@ -163,6 +163,11 @@ module G_fs = struct ...@@ -163,6 +163,11 @@ module G_fs = struct
| (None, _) -> List_.to_string G_feature.to_dot "\\n" t | (None, _) -> List_.to_string G_feature.to_dot "\\n" t
| (Some atom, sub) -> sprintf "{%s|%s}" atom (List_.to_string G_feature.to_dot "\\n" sub) | (Some atom, sub) -> sprintf "{%s|%s}" atom (List_.to_string G_feature.to_dot "\\n" sub)
let to_word ?main_feat t =
match get_main ?main_feat t with
| (None, _) -> "#"
| (Some atom, _) -> atom
let to_dep ?main_feat t = let to_dep ?main_feat t =
let (main_opt, sub) = get_main ?main_feat t in let (main_opt, sub) = get_main ?main_feat t in
sprintf " word=\"%s\"; subword=\"%s\"; " sprintf " word=\"%s\"; subword=\"%s\"; "
......
...@@ -27,6 +27,7 @@ module G_fs: sig ...@@ -27,6 +27,7 @@ module G_fs: sig
val to_gr: t -> string val to_gr: t -> string
val to_dot: ?main_feat: string -> t -> string val to_dot: ?main_feat: string -> t -> string
val to_word: ?main_feat: string -> t -> string
val to_dep: ?main_feat: string -> t -> string val to_dep: ?main_feat: string -> t -> string
val to_string: t -> string val to_string: t -> string
......
...@@ -478,6 +478,28 @@ module G_graph = struct ...@@ -478,6 +478,28 @@ module G_graph = struct
bprintf buff "}\n"; bprintf buff "}\n";
Buffer.contents buff Buffer.contents buff
let to_sentence ?main_feat graph =
let nodes = Gid_map.fold (fun id elt acc -> (id,elt)::acc) graph.map [] in
let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.pos_comp n1 n2) nodes in
let words = List.map
(fun (id, node) -> G_fs.to_word ?main_feat (G_node.get_fs node)
) snodes in
List.fold_left
(fun acc (regexp,repl) ->
Str.global_replace (Str.regexp_string regexp) repl acc
)
(String.concat " " words)
[
"_", " ";
"' ", "'";
" ,", ",";
" .", ".";
"( ", "(";
" )", ")";
"\\\"", "\"";
]
let to_dep ?main_feat ?(deco=Deco.empty) graph = let to_dep ?main_feat ?(deco=Deco.empty) graph =
let buff = Buffer.create 32 in let buff = Buffer.create 32 in
bprintf buff "[GRAPH] { opacity=0; scale = 200; fontname=\"Arial\"; }\n"; bprintf buff "[GRAPH] { opacity=0; scale = 200; fontname=\"Arial\"; }\n";
......
...@@ -65,6 +65,7 @@ module G_graph: sig ...@@ -65,6 +65,7 @@ module G_graph: sig
val to_gr: t -> string val to_gr: t -> string
val to_dot: ?main_feat:string -> ?deco:Deco.t -> t -> string val to_dot: ?main_feat:string -> ?deco:Deco.t -> t -> string
val to_sentence: ?main_feat:string -> t -> string
val to_dep: ?main_feat:string -> ?deco:Deco.t -> t -> string val to_dep: ?main_feat:string -> ?deco:Deco.t -> t -> string
......
This diff is collapsed.
...@@ -13,11 +13,11 @@ module Rewrite_history: sig ...@@ -13,11 +13,11 @@ module Rewrite_history: sig
} }
val is_empty: t -> bool val is_empty: t -> bool
IFDEF DEP2PICT THEN IFDEF DEP2PICT THEN
val error_html: ?main_feat:string -> ?init_graph:bool -> ?header:string -> string -> string -> Instance.t option -> unit val error_html: ?main_feat:string -> ?init_graph:bool -> ?header:string -> string -> string -> Instance.t option -> unit
val save_html: ?main_feat:string -> ?init_graph:bool -> ?header:string -> string -> t -> unit val save_html: ?main_feat:string -> ?init_graph:bool -> ?header:string -> graph_file:string -> string -> t -> unit
ENDIF ENDIF
end end
...@@ -67,7 +67,7 @@ module Corpus_stat: sig ...@@ -67,7 +67,7 @@ module Corpus_stat: sig
val save_html: val save_html:
title: string -> title: string ->
grs_file: string -> grs_file: string ->
html:bool -> (* if [html] put hlinks on files *) input_dir:string ->
output_dir:string -> output_dir:string ->
t -> unit t -> unit
end end
...@@ -252,7 +252,6 @@ module Html = struct ...@@ -252,7 +252,6 @@ module Html = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
header buff; header buff;
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>"; wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
wnl " <center><h1>Index of modules</h1></center>"; wnl " <center><h1>Index of modules</h1></center>";
wnl " <table width=100%%>"; wnl " <table width=100%%>";
...@@ -309,7 +308,7 @@ module Html = struct ...@@ -309,7 +308,7 @@ module Html = struct
Buffer.contents buff Buffer.contents buff
let proceed output_dir ast = let proceed file output_dir ast =
ignore(Sys.command ("rm -rf "^output_dir)); ignore(Sys.command ("rm -rf "^output_dir));
ignore(Sys.command ("mkdir "^output_dir)); ignore(Sys.command ("mkdir "^output_dir));
ignore(Sys.command ("cp "^DATA_DIR^"/style.css "^output_dir)); ignore(Sys.command ("cp "^DATA_DIR^"/style.css "^output_dir));
...@@ -323,7 +322,12 @@ module Html = struct ...@@ -323,7 +322,12 @@ module Html = struct
let buff = Buffer.create 32 in let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
header buff; header buff;
wnl " <div class=\"navbar\">&nbsp;<a href=\"../index.html\">Rewriting Stats</a></div>";
wnl "<h1>Graph Rewriting System: %s</h1>" (Filename.basename file);
wnl "<center><b>full path</b>: %s</center>" file;
wnl "<a href=domain.html>Domain</a><br/>"; wnl "<a href=domain.html>Domain</a><br/>";
wnl "<a href=modules.html>Index of modules</a><br/>"; wnl "<a href=modules.html>Index of modules</a><br/>";
wnl "<a href=sequences.html>List of sequences</a><br/>"; wnl "<a href=sequences.html>List of sequences</a><br/>";
......
...@@ -2,5 +2,5 @@ open Grew_ast ...@@ -2,5 +2,5 @@ open Grew_ast
module Html : module Html :
sig sig
val proceed : string -> Ast.grs -> unit val proceed : string -> string -> Ast.grs -> unit
end end
...@@ -157,7 +157,7 @@ module Rule = struct ...@@ -157,7 +157,7 @@ module Rule = struct
:: acc :: acc
) t.pos.graph [] in ) t.pos.graph [] in
(* noodes are sorted to appear in the same order in dep picture and in input file *) (* nodes are sorted to appear in the same order in dep picture and in input file *)
let sorted_nodes = List.sort (fun (n1,_) (n2,_) -> P_node.compare_pos n1 n2) nodes in let sorted_nodes = List.sort (fun (n1,_) (n2,_) -> P_node.compare_pos n1 n2) nodes in
bprintf buff "[WORDS] {\n"; bprintf buff "[WORDS] {\n";
...@@ -728,11 +728,12 @@ module Rule = struct ...@@ -728,11 +728,12 @@ module Rule = struct
(** filter nfs being equal *) (** filter nfs being equal *)
let rec filter_equal_nfs nfs = let rec filter_equal_nfs nfs =
Instance_set.fold (fun nf acc -> Instance_set.fold
if Instance_set.exists (fun e -> G_graph.equals e.Instance.graph nf.Instance.graph) acc (fun nf acc ->
then (printf "two normal equal normal forms"; acc) if Instance_set.exists (fun e -> G_graph.equals e.Instance.graph nf.Instance.graph) acc
else Instance_set.add nf acc) then acc
nfs Instance_set.empty else Instance_set.add nf acc
) nfs Instance_set.empty
(** normalize [t] according to the [rules] (** normalize [t] according to the [rules]
* [t] is a raw graph * [t] is a raw graph
...@@ -740,7 +741,7 @@ module Rule = struct ...@@ -740,7 +741,7 @@ module Rule = struct
*) *)
(* type: Instance.t -> t list -> Instance_set.t *) (* type: Instance.t -> t list -> Instance_set.t *)
let normalize_instance instance rules = let normalize_instance modul_name instance rules =
let rec loop to_do nf = let rec loop to_do nf =
if to_do = Instance_set.empty if to_do = Instance_set.empty
then nf then nf
...@@ -756,7 +757,14 @@ module Rule = struct ...@@ -756,7 +757,14 @@ module Rule = struct
to_do (Instance_set.empty,nf) in to_do (Instance_set.empty,nf) in
loop new_to_do new_nf in loop new_to_do new_nf in
let nfs = loop (Instance_set.singleton instance) Instance_set.empty in let nfs = loop (Instance_set.singleton instance) Instance_set.empty in
filter_equal_nfs nfs let reduced_nfs = filter_equal_nfs nfs in
let reduced_nfs_card = Instance_set.cardinal reduced_nfs in
let nfs_card = Instance_set.cardinal nfs in
if reduced_nfs_card < nfs_card
then Log.fwarning "In module \"%s\", %d nf are produced, only %d different ones" modul_name nfs_card reduced_nfs_card;
reduced_nfs
(* [filter_instance instance filters] return a boolean: (* [filter_instance instance filters] return a boolean:
- true iff the instance does NOT match any pattern in [filters] *) - true iff the instance does NOT match any pattern in [filters] *)
...@@ -793,9 +801,7 @@ module Rule = struct ...@@ -793,9 +801,7 @@ module Rule = struct
| Some new_instance -> conf_normalize new_instance rules | Some new_instance -> conf_normalize new_instance rules
| None -> Instance.rev_steps instance | None -> Instance.rev_steps instance
(* type: t list -> (Instance_set.elt -> bool) -> Instance.t -> Instance_set.t * Instance_set.t *) let normalize modul_name ?(confluent=false) rules filters instance =
let normalize ?(confluent=false) rules filters instance =
Timeout.start (); Timeout.start ();
if confluent if confluent
then then
...@@ -804,7 +810,7 @@ module Rule = struct ...@@ -804,7 +810,7 @@ module Rule = struct
then (Instance_set.singleton output, Instance_set.empty) then (Instance_set.singleton output, Instance_set.empty)
else (Instance_set.empty, Instance_set.singleton output) else (Instance_set.empty, Instance_set.singleton output)
else else
let output_set = normalize_instance instance rules in let output_set = normalize_instance modul_name instance rules in
let (good_set, bad_set) = Instance_set.partition (filter_instance filters) output_set in let (good_set, bad_set) = Instance_set.partition (filter_instance filters) output_set in
(good_set, bad_set) (good_set, bad_set)
......
...@@ -51,7 +51,8 @@ module Rule : sig ...@@ -51,7 +51,8 @@ module Rule : sig
val build: ?locals:Label.decl array -> string -> Ast.rule -> t val build: ?locals:Label.decl array -> string -> Ast.rule -> t
(* raise Stop if some command fails to apply *) (* raise Stop if some command fails to apply *)
val normalize: val normalize:
string -> (* module name *)
?confluent:bool -> ?confluent:bool ->
t list -> (* rule list *) t list -> (* rule list *)
t list -> (* filter list *) t list -> (* filter list *)
......
...@@ -41,7 +41,7 @@ let load_grs ?doc_output_dir file = ...@@ -41,7 +41,7 @@ let load_grs ?doc_output_dir file =
(match doc_output_dir with (match doc_output_dir with
| None -> () | None -> ()
| Some dir -> | Some dir ->
Html.proceed dir grs_ast; Html.proceed file dir grs_ast;
(* draw pattern graphs for all rules and all filters *) (* draw pattern graphs for all rules and all filters *)
let fct module_ rule_ = let fct module_ rule_ =
...@@ -113,7 +113,6 @@ let load_graph file = ...@@ -113,7 +113,6 @@ let load_graph file =
Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file
end end
let rewrite ~gr ~grs ~seq = let rewrite ~gr ~grs ~seq =
try Grs.rewrite grs seq gr try Grs.rewrite grs seq gr
with with
...@@ -139,6 +138,7 @@ let save_index ~dirname ~base_names = ...@@ -139,6 +138,7 @@ let save_index ~dirname ~base_names =
let write_html let write_html
?(no_init=false) ?main_feat ?(no_init=false) ?main_feat
~header ~header
~graph_file
rew_hist rew_hist
output_base = output_base =
IFDEF DEP2PICT THEN IFDEF DEP2PICT THEN
...@@ -147,6 +147,7 @@ IFDEF DEP2PICT THEN ...@@ -147,6 +147,7 @@ IFDEF DEP2PICT THEN
?main_feat ?main_feat
~init_graph: (not no_init) ~init_graph: (not no_init)
~header ~header
~graph_file
output_base rew_hist output_base rew_hist
) )
ELSE ELSE
...@@ -170,14 +171,14 @@ ELSE ...@@ -170,14 +171,14 @@ ELSE
Log.critical "[error_html] The \"libcaml-grew\" library is compiled without Dep2pict" Log.critical "[error_html] The \"libcaml-grew\" library is compiled without Dep2pict"
ENDIF ENDIF
let make_index ~title ~grs_file ~html ~grs ~seq ~output_dir ~base_names = let make_index ~title ~grs_file ~html ~grs ~seq ~input_dir ~output_dir ~base_names =
let init = Corpus_stat.empty grs seq in let init = Corpus_stat.empty grs seq in
let corpus_stat = let corpus_stat =
List.fold_left List.fold_left
(fun acc base_name -> (fun acc base_name ->
Corpus_stat.add_gr_stat base_name (Gr_stat.load (Filename.concat output_dir (base_name^".stat"))) acc Corpus_stat.add_gr_stat base_name (Gr_stat.load (Filename.concat output_dir (base_name^".stat"))) acc
) init base_names in ) init base_names in
Corpus_stat.save_html title grs_file html output_dir corpus_stat Corpus_stat.save_html title grs_file input_dir output_dir corpus_stat
let get_css_file = Filename.concat DATA_DIR "style.css" let get_css_file = Filename.concat DATA_DIR "style.css"
......
...@@ -59,7 +59,11 @@ val load_graph: string -> Instance.t ...@@ -59,7 +59,11 @@ val load_graph: string -> Instance.t
val save_index: dirname:string -> base_names: string list -> unit val save_index: dirname:string -> base_names: string list -> unit
val write_html: val write_html:
?no_init:bool -> ?main_feat:string -> header: string -> Rewrite_history.t -> string -> unit ?no_init:bool ->
?main_feat:string ->
header: string ->
graph_file: string ->
Rewrite_history.t -> string -> unit
val error_html: val error_html:
?no_init:bool -> ?main_feat:string -> header: string -> string -> ?init:Instance.t -> string -> unit ?no_init:bool -> ?main_feat:string -> header: string -> string -> ?init:Instance.t -> string -> unit
...@@ -70,6 +74,7 @@ val make_index: ...@@ -70,6 +74,7 @@ val make_index:
html: bool -> html: bool ->
grs: Grs.t -> grs: Grs.t ->
seq: string -> seq: string ->
input_dir: string ->
output_dir: string -> output_dir: string ->
base_names: string list -> base_names: string list ->
unit unit
......
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