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

config/Makefile.in

-VERSION = 0.10.0
+VERSION = 0.11.0
 
 INSTALL_DIR_LIB = @OCAMLLIB@
 INSTALL_DIR = @prefix@/bin/

src/grew_fs.ml

@@ -163,6 +163,11 @@ module G_fs = struct
     | (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)
           
+  let to_word ?main_feat t =
+    match get_main ?main_feat t with
+      | (None, _) -> "#"
+      | (Some atom, _) -> atom
+        
   let to_dep ?main_feat t =
     let (main_opt, sub) = get_main ?main_feat t in
     sprintf " word=\"%s\"; subword=\"%s\"; " 

src/grew_fs.mli

@@ -27,6 +27,7 @@ module G_fs: sig
 
   val to_gr: 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_string: t -> string

src/grew_graph.ml

@@ -478,6 +478,28 @@ module G_graph = struct
     bprintf buff "}\n";
     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 buff = Buffer.create 32 in
     bprintf buff "[GRAPH] { opacity=0; scale = 200; fontname=\"Arial\"; }\n";

src/grew_graph.mli

@@ -65,6 +65,7 @@ module G_graph: sig
 
   val to_gr: 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
 
 

src/grew_grs.mli

@@ -13,11 +13,11 @@ module Rewrite_history: sig
     }
 
   val is_empty: t -> bool
-
+    
 IFDEF DEP2PICT THEN
   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
 end
 
@@ -67,7 +67,7 @@ module Corpus_stat: sig
   val save_html: 
     title: string -> 
     grs_file: string ->
-    html:bool -> (* if [html] put hlinks on files *) 
+    input_dir:string -> 
     output_dir:string -> 
       t -> unit
 end

src/grew_html.ml

@@ -252,7 +252,6 @@ module Html = struct
     let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
     
     header buff;
-    
     wnl "  <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
     wnl "  <center><h1>Index of modules</h1></center>";
     wnl "  <table width=100%%>";
@@ -309,7 +308,7 @@ module Html = struct
     Buffer.contents buff
 
     
-  let proceed output_dir ast = 
+  let proceed 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));
@@ -323,7 +322,12 @@ module Html = struct
     let buff = Buffer.create 32 in
     let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
     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=modules.html>Index of modules</a><br/>";
     wnl "<a href=sequences.html>List of sequences</a><br/>";

src/grew_html.mli

@@ -2,5 +2,5 @@ open Grew_ast
 
 module Html :
   sig
-    val proceed : string -> Ast.grs -> unit
+    val proceed : string -> string -> Ast.grs -> unit
   end

src/grew_rule.ml

@@ -157,7 +157,7 @@ module Rule = struct
           :: acc
         ) 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
     
     bprintf buff "[WORDS] {\n";
@@ -728,11 +728,12 @@ module Rule = struct
 
 (** filter nfs being equal *)
   let rec filter_equal_nfs nfs =
-    Instance_set.fold (fun nf acc ->
-      if Instance_set.exists (fun e -> G_graph.equals e.Instance.graph nf.Instance.graph) acc
-      then (printf "two normal equal normal forms"; acc)
-      else Instance_set.add nf acc)
-      nfs Instance_set.empty
+    Instance_set.fold 
+      (fun nf acc ->
+        if Instance_set.exists (fun e -> G_graph.equals e.Instance.graph nf.Instance.graph) acc
+        then acc
+        else Instance_set.add nf acc
+      ) nfs Instance_set.empty
       
 (** normalize [t] according to the [rules]
  * [t] is a raw graph
@@ -740,7 +741,7 @@ module Rule = struct
  *)
 
   (* 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 = 
       if to_do = Instance_set.empty
       then nf
@@ -756,7 +757,14 @@ module Rule = struct
             to_do (Instance_set.empty,nf) in
         loop new_to_do new_nf 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:
      - true iff the instance does NOT match any pattern in [filters] *)
@@ -793,9 +801,7 @@ module Rule = struct
     | Some new_instance -> conf_normalize new_instance rules
     | None -> Instance.rev_steps instance
 
-          (* type: t list -> (Instance_set.elt -> bool) -> Instance.t -> Instance_set.t * Instance_set.t *)
-
-  let normalize ?(confluent=false) rules filters instance =
+  let normalize modul_name ?(confluent=false) rules filters instance =
     Timeout.start ();
     if confluent
     then
@@ -804,7 +810,7 @@ module Rule = struct
       then (Instance_set.singleton output, Instance_set.empty)
       else (Instance_set.empty, Instance_set.singleton output)
     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
       (good_set, bad_set)
 

src/grew_rule.mli

@@ -51,7 +51,8 @@ module Rule : sig
   val build: ?locals:Label.decl array -> string -> Ast.rule -> t
 
   (* raise Stop if some command fails to apply *)
-  val normalize: 
+  val normalize:
+    string -> (* module name *)
     ?confluent:bool -> 
     t list -> (* rule list *)
     t list -> (* filter list *)

src/libgrew.ml

@@ -41,7 +41,7 @@ let load_grs ?doc_output_dir file =
       (match doc_output_dir with
         | None -> ()
         | Some dir -> 
-          Html.proceed dir grs_ast;
+          Html.proceed file dir grs_ast;
           
           (* draw pattern graphs for all rules and all filters *)
           let fct module_ rule_ = 
@@ -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
     end
 
-
 let rewrite ~gr ~grs ~seq = 
   try Grs.rewrite grs seq gr
   with
@@ -139,6 +138,7 @@ let save_index ~dirname ~base_names =
 let write_html 
     ?(no_init=false) ?main_feat 
     ~header
+    ~graph_file
     rew_hist
     output_base =
 IFDEF DEP2PICT THEN
@@ -147,6 +147,7 @@ IFDEF DEP2PICT THEN
     ?main_feat 
     ~init_graph: (not no_init)
     ~header
+    ~graph_file
     output_base rew_hist
     )
 ELSE
@@ -170,14 +171,14 @@ ELSE
     Log.critical "[error_html] The \"libcaml-grew\" library is compiled without Dep2pict"
 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 corpus_stat =
     List.fold_left
       (fun acc base_name -> 
         Corpus_stat.add_gr_stat base_name (Gr_stat.load (Filename.concat output_dir (base_name^".stat"))) acc
       ) 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"
 

src/libgrew_.mli

@@ -59,7 +59,11 @@ val load_graph: string -> Instance.t
 val save_index: dirname:string -> base_names: string list -> unit
 
 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: 
     ?no_init:bool -> ?main_feat:string -> header: string -> string -> ?init:Instance.t -> string -> unit
@@ -70,6 +74,7 @@ val make_index:
     html: bool -> 
     grs: Grs.t -> 
     seq: string ->
+    input_dir: string -> 
     output_dir: string -> 
     base_names: string list -> 
       unit