Skip to content

GitLab

L
libcaml-grew
Commit 6f112b30 authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files
Options

remove Dep2pict / Html code

parent f9efdaec
Show whitespace changes
Inline Side-by-side
Showing with 0 additions and 1209 deletions
src/grew_grs.ml
View file @ 6f112b30
......@@ -41,24 +41,6 @@ module Rewrite_history = struct
| { good_nf = [] } -> 1
| { good_nf = l} -> List.fold_left (fun acc t -> acc + (num_sol t)) 0 l
let save_nfs ?domain ?filter ?main_feat ~dot base_name t =
let rec loop file_name rules t =
match t.good_nf with
| [] when dot -> Instance.save_dot_png ?domain ?filter ?main_feat file_name t.instance; [rules, file_name]
| [] -> ignore (Instance.save_dep_png ?domain ?filter ?main_feat file_name t.instance); [rules, file_name]
| l ->
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
let save_gr ?domain base t =
let rec loop file_name t =
match t.good_nf with
......
src/grew_grs.mli
View file @ 6f112b30
......@@ -29,19 +29,6 @@ module Rewrite_history: sig
val num_sol: t -> int
(** [save_nfs ?main_feat base_name t] does two things:
- write PNG files of normal forms
- returns a list of couples (rules, file)
*)
val save_nfs:
?domain:Domain.t ->
?filter: string list ->
?main_feat: string ->
dot: bool ->
string ->
t ->
((string * string list) list * string) list
(** [save_gr base_name t] saves one gr_file for each normal form defined in [t].
Output files are named according to [base_name] and the Gorn adress in the rewriting tree. *)
val save_gr: ?domain:Domain.t -> string -> t -> unit
......
src/grew_html.ml deleted 100644 → 0
View file @ f9efdaec
(**********************************************************************************)
(* Libcaml-grew - a Graph Rewriting library dedicated to NLP applications *)
(* *)
(* Copyright 2011-2013 Inria, Université de Lorraine *)
(* *)
(* Webpage: http://grew.loria.fr *)
(* License: CeCILL (see LICENSE folder or "http://www.cecill.info") *)
(* Authors: see AUTHORS file *)
(**********************************************************************************)
open Printf
open Log
open Grew_base
open Grew_types
open Grew_ast
open Grew_domain
open Grew_graph
open Grew_rule
open Grew_grs
let html_header ?css_file ?title ?(add_lines=[]) 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\">";
(match css_file with
| Some file -> wnl " <link rel=\"stylesheet\" href=\"%s\" type=\"text/css\">" file
| None -> ()
);
(match title with
| Some t -> wnl " <title>%s</title>" (Str.global_replace (Str.regexp "#") " " t)
| None -> ()
);
List.iter (fun line -> wnl " %s" line) add_lines;
wnl " </head>";
(* ================================================================================*)
module Html_doc = struct
let string_of_concat_item = function
| Ast.Qfn_item id -> sprintf "%s" (Ast.dump_feature_ident id)
| Ast.String_item s -> sprintf "\"%s\"" s
| Ast.Param_item var -> sprintf "%s" var
let buff_html_command ?(li_html=false) buff (u_command,_) =
bprintf buff " ";
if li_html then bprintf buff "<li>";
bprintf buff "%s" (Ast.string_of_u_command u_command);
if li_html then bprintf buff "</li>\n" else bprintf buff ";\n"
let html_feature (u_feature,_) =
match u_feature.Ast.kind with
| Ast.Equality values ->
sprintf "%s=%s" u_feature.Ast.name (List_.to_string (fun x->x) "|" values)
| Ast.Disequality [] ->
sprintf "%s=*" u_feature.Ast.name
| Ast.Absent ->
sprintf "!%s" u_feature.Ast.name
| Ast.Disequality values ->
sprintf "%s<>%s" u_feature.Ast.name (List_.to_string (fun x->x) "|" values)
| Ast.Equal_param index ->
sprintf "%s=%s" u_feature.Ast.name index
let buff_html_node buff (u_node,_) =
bprintf buff " %s [" u_node.Ast.node_id;
bprintf buff "%s" (String.concat ", " (List.map html_feature u_node.Ast.fs));
bprintf buff "];\n"
let buff_html_edge buff (u_edge,_) =
bprintf buff " ";
bprintf buff "%s" (match u_edge.Ast.edge_id with Some n -> n^": " | None -> "");
match u_edge.Ast.edge_label_cst with
| Ast.Pos_list l -> bprintf buff "%s -[%s]-> %s;\n" u_edge.Ast.src (List_.to_string (fun x->x) "|" l) u_edge.Ast.tar
| Ast.Neg_list l -> bprintf buff "%s -[^%s]-> %s;\n" u_edge.Ast.src (List_.to_string (fun x->x) "|" l) u_edge.Ast.tar
| Ast.Regexp re -> bprintf buff "%s -[re\"%s\"]-> %s;\n" u_edge.Ast.src re u_edge.Ast.tar
let buff_html_const buff (u_const,_) =
bprintf buff " ";
(match u_const with
| Ast.Cst_out (ident, Ast.Neg_list []) ->
bprintf buff "%s -> *" ident
| Ast.Cst_out (ident, Ast.Pos_list labels) ->
bprintf buff "%s -[%s]-> *" ident (List_.to_string (fun x->x) "|" labels)
| Ast.Cst_out (ident, Ast.Neg_list labels) ->
bprintf buff "%s -[^%s]-> *" ident (List_.to_string (fun x->x) "|" labels)
| Ast.Cst_out (ident, Ast.Regexp re) ->
bprintf buff "%s -[re\"%s\"]-> *" ident re
| Ast.Cst_in (ident, Ast.Neg_list []) ->
bprintf buff "* -> %s" ident
| Ast.Cst_in (ident, Ast.Pos_list labels) ->
bprintf buff "* -[%s]-> %s" (List_.to_string (fun x->x) "|" labels) ident
| Ast.Cst_in (ident, Ast.Neg_list labels) ->
bprintf buff "* -[^%s]-> %s" (List_.to_string (fun x->x) "|" labels) ident
| Ast.Cst_in (ident, Ast.Regexp re) ->
bprintf buff "* -[re\"%s\"]-> %s" re ident
| Ast.Features_eq (feat_id_l, feat_id_r) ->
bprintf buff "%s = %s" (Ast.dump_feature_ident feat_id_l) (Ast.dump_feature_ident feat_id_r);
| Ast.Features_diseq (feat_id_l, feat_id_r) ->
bprintf buff "%s <> %s" (Ast.dump_feature_ident feat_id_l) (Ast.dump_feature_ident feat_id_r);
| Ast.Features_ineq (ineq, feat_id_l, feat_id_r) ->
bprintf buff "%s %s %s" (Ast.dump_feature_ident feat_id_l) (Ast.string_of_ineq ineq) (Ast.dump_feature_ident feat_id_r)
| Ast.Feature_ineq_cst (ineq, feat_id_l, constant) ->
bprintf buff "%s %s %f" (Ast.dump_feature_ident feat_id_l) (Ast.string_of_ineq ineq) constant
| Ast.Feature_eq_cst (feat_id_l, value) ->
bprintf buff "%s = \"%s\"" (Ast.dump_feature_ident feat_id_l) value;
| Ast.Feature_diff_cst (feat_id_l, value) ->
bprintf buff "%s ≠ \"%s\"" (Ast.dump_feature_ident feat_id_l) value;
| Ast.Feature_eq_float (feat_id_l, value) ->
bprintf buff "%s = %g" (Ast.dump_feature_ident feat_id_l) value;
| Ast.Feature_diff_float (feat_id_l, value) ->
bprintf buff "%s ≠ %g" (Ast.dump_feature_ident feat_id_l) value;
| Ast.Feature_eq_regexp (feat_id, regexp) ->
bprintf buff "%s == \"%s\"" (Ast.dump_feature_ident feat_id) regexp
| Ast.Immediate_prec (id1, id2) ->
bprintf buff "%s < %s" id1 id2
| Ast.Large_prec (id1, id2) ->
bprintf buff "%s << %s" id1 id2
);
bprintf buff "\n"
let buff_html_pos_basic buff pos_basic =
bprintf buff " <font color=\"purple\">match</font> <b>{</b>\n";
List.iter (buff_html_node buff) pos_basic.Ast.pat_nodes;
List.iter (buff_html_edge buff) pos_basic.Ast.pat_edges;
List.iter (buff_html_const buff) pos_basic.Ast.pat_const;
bprintf buff " <b>}</b>\n"
let buff_html_neg_basic buff neg_basic =
bprintf buff " <font color=\"purple\">without</font> <b>{</b>\n";
List.iter (buff_html_node buff) neg_basic.Ast.pat_nodes;
List.iter (buff_html_edge buff) neg_basic.Ast.pat_edges;
List.iter (buff_html_const buff) neg_basic.Ast.pat_const;
bprintf buff " <b>}</b>\n"
let to_html_rules rules =
let buff = Buffer.create 32 in
List.iter
(fun rule ->
(* the first line: (lex_)rule / filter *)
(match (rule.Ast.commands, rule.Ast.param) with
| (_,None) ->
bprintf buff "<font color=\"purple\">rule</font> %s <b>{</b>\n" rule.Ast.rule_id
| (_,Some (files, vars)) ->
let param =
match files with
| [] -> sprintf "(feature %s)" (String.concat ", " vars)
| l -> sprintf "(feature %s; %s)"
(String.concat ", " vars)
(String.concat ", " (List.map (fun f -> sprintf "file \"%s\"" f) l)) in
bprintf buff "<font color=\"purple\">lex_rule</font> %s %s <b>{</b>\n" rule.Ast.rule_id param
);
(* the match part *)
buff_html_pos_basic buff rule.Ast.pattern.Ast.pat_pos;
(* the without parts *)
List.iter (buff_html_neg_basic buff) rule.Ast.pattern.Ast.pat_negs;
(* the commands part *)
bprintf buff " <font color=\"purple\">commands</font> <b>{</b>\n";
List.iter (buff_html_command buff) rule.Ast.commands;
bprintf buff " <b>}</b>\n";
bprintf buff "<b>}</b>\n";
) rules;
Buffer.contents buff
let doc_to_html string =
if Str.string_match (Str.regexp "^ \\* ") string 0
then sprintf "<font color=\"green\"><i>%s</i></font>" (String.sub string 4 ((String.length string)-4))
else
List.fold_left
(fun acc (re,str) -> Str.global_replace (Str.regexp re) str acc)
string
[
"\\[", "<b>";
"\\]", "</b>";
"~", "&nbsp;";
]
let of_opt_color = function
| [] -> "black"
| c::_ -> String.sub c 1 ((String.length c) - 1)
let module_page_text ~corpus prev next module_ =
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Module %s" module_.Ast.module_id in
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
wnl " <div class=\"navbar\">";
w " ";
(match prev with Some p -> w "&nbsp;<a href=\"%s.html\">Previous</a>" p | _ -> ());
w "&nbsp;<a href=\"index.html\">Up</a>";
(match next with Some n -> w "&nbsp;<a href=\"%s.html\">Next</a>" n | _ -> ());
wnl " </div>";
wnl " <center><h1>Module <div class=\"module_title\">%s</div></h1></center><br/>" module_.Ast.module_id;
List.iter (fun s -> wnl " %s<br/>" (doc_to_html s)) module_.Ast.module_doc;
wnl " <h6>%d Rules</h6>" (List.length module_.Ast.rules);
wnl " <table class=\"indextable\">";
List.iter
(fun rule ->
wnl " <tr>";
wnl " <td width=\"200px\"><a href=\"%s_%s.html\">%s</a></td>" module_.Ast.module_id rule.Ast.rule_id rule.Ast.rule_id;
(match rule.Ast.rule_doc with [] -> () | l::_ -> wnl " <td>%s</td>" (doc_to_html l));
wnl " </tr>";
) module_.Ast.rules;
wnl " </table>";
wnl " </body>";
wnl "</html>";
Buffer.contents buff
let rule_page_text ~corpus ~dep prev next rule_ module_ =
let rid = rule_.Ast.rule_id in
let mid = module_.Ast.module_id in
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Rule %s/%s" mid rid in
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
wnl " <div class=\"navbar\">";
w " ";
(match prev with Some p -> w "&nbsp;<a href=\"%s_%s.html\">Previous</a>" mid p | _ -> ());
w "&nbsp;<a href=\"%s.html\">Up</a>" mid;
(match next with Some n -> w "&nbsp;<a href=\"%s_%s.html\">Next</a>" mid n | _ -> ());
wnl " </div>";
wnl "<center><h1>Rule <a href=\"%s.html\">%s</a>.<div class=\"module_title\">%s</div></h1></center>" mid mid rid;
List.iter (fun s -> wnl " %s<br/>" (doc_to_html s)) rule_.Ast.rule_doc;
wnl "<h6>Code</h6>";
wnl "<pre>";
w "%s" (to_html_rules [rule_]);
wnl "</pre>";
if dep
then
begin
wnl "<h6>Pattern</h6>";
wnl "<pre>";
w "<IMG src=\"%s\">" (sprintf "%s_%s-patt.png" mid rid);
wnl "</pre>"
end;
let output_table args lines =
wnl " <table border=\"1\" cellspacing=\"0\" cellpadding=\"3\">";
wnl " <tr>%s</tr>" (List_.to_string (fun x -> sprintf "<th bgcolor=\"#cccccc\">%s</th>" x) "" args);
List.iter
(fun l -> wnl "<tr>%s</tr>"
(List_.to_string (fun x -> sprintf "<td>%s</td>" x) "" (Str.split (Str.regexp "#+") l))
) lines;
wnl " </table>" in
(match rule_.Ast.param with
| None -> ()
| Some (files, args) ->
wnl "<h6>Lexical parameters</h6>";
(* output local lexical parameters (if any) *)
(match rule_.Ast.lex_par with
| None -> ()
| Some lines ->
wnl "<b>Local parameters</b><br/>";
output_table args lines
);
(* output external lexical parameters (if any) *)
List.iter
(fun file ->
let filename = Filename.concat module_.Ast.mod_dir file in
wnl "<b>File:</b> %s<br/>" file;
let lines =
try File.read filename
with Sys_error msg -> wnl "<font color=\"red\">Error: %s</font>" msg; [] in
output_table args lines
) files
);
wnl " </body>";
wnl "</html>";
Buffer.contents buff
let sequences_text ~corpus ast =
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- List of sequences" in
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
wnl " <center><h1>List of sequences</h1></center>";
List.iter
(fun ast_seq ->
wnl "<h6>%s</h6>" ast_seq.Ast.strat_name;
List.iter (fun l -> wnl "<p>%s</p>" (doc_to_html l)) ast_seq.Ast.strat_doc;
wnl "<div class=\"code\">";
wnl "%s" (Ast.strat_def_to_string ast_seq.Ast.strat_def);
wnl "</div>";
) ast.Ast.strategies;
wnl " </body>";
wnl "</html>";
Buffer.contents buff
let index_modules_text ast =
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- Index of modules" in
html_header ~css_file:"style.css" ~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%%>";
List.iter
(fun initial ->
match List.filter (fun mod_ -> Char.uppercase_ascii mod_.Ast.module_id.[0] = initial) ast.Ast.modules with
| [] -> ()
| l ->
wnl "<tr><td colspan=2 ><h6>%s</h6></td></tr>" (Char.escaped initial);
List.iter
(fun mod_ ->
wnl "<tr>";
wnl "<td width=\"200px\"><a href=\"%s.html\">%s</a></td>" mod_.Ast.module_id mod_.Ast.module_id;
(match mod_.Ast.module_doc with [] -> () | h::_ -> wnl "<td>%s</td>\n" (doc_to_html h));
wnl "</tr>";
) l
) ['A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P';'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z'];
wnl " </body>";
wnl "</html>";
Buffer.contents buff
let domain_text ~corpus ast =
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Features domain" in
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
then wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
wnl " <h6>Features</h6>";
wnl " <code class=\"code\">";
List.iter
(function
| Ast.Closed (feat_name,values) -> wnl "<b>%s</b> : %s<br/>" feat_name (String.concat " | " values)
| Ast.Open feat_name -> wnl " <b>%s</b> : *<br/>" feat_name
| Ast.Num feat_name -> wnl " <b>%s</b> : #<br/>" feat_name
) ast.Ast.feature_domain;
wnl " </code>";
wnl " <h6>Labels</h6>";
wnl " <code class=\"code\">";
(match ast.Ast.label_domain with
| [] -> wnl "No labels defined!"
| (l,c)::t -> w "<font color=\"%s\">%s</font>" (of_opt_color c) l;
List.iter
(fun (lab,color) ->
w ", <font color=\"%s\">%s</font>" (of_opt_color color) lab;
) t;
wnl "");
wnl " </code>";
wnl " </body>";
wnl "</html>";
Buffer.contents buff
let build ~dep ~corpus output_dir grs =
let filename = Old_grs.get_filename grs in
let ast = Old_grs.get_ast grs in
ignore(Sys.command ("rm -rf "^output_dir));
ignore(Sys.command ("mkdir "^output_dir));
(* ignore(Sys.command ("cp "^DATA_DIR^"/style.css "^output_dir)); *)
(** index.html **)
let index = Filename.concat output_dir "index.html" in
(* let table = create_modules_table ast.Ast.modules in *)
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- Graph Rewriting System: %s" (Filename.basename filename) in
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
then 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 filename);
wnl "<center><b>full path</b>: %s</center>" filename;
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/>";
wnl "<h6>Modules</h6>";
wnl "<table class=\"indextable\">";
List.iter
(fun m ->
wnl "<tr>";
wnl "<td width=\"200px\"><a href=\"%s.html\">%s</a></td>" m.Ast.module_id m.Ast.module_id;
(match m.Ast.module_doc with [] -> () | h::_ -> wnl "<td>%s</td>\n" (doc_to_html h));
wnl "</tr>"
) ast.Ast.modules;
wnl "</table>";
wnl "</body>";
wnl "</html>";
let index_out_ch = open_out index in
output_string index_out_ch (Buffer.contents buff);
close_out index_out_ch;
(** Sequences.html **)
let sequences = Filename.concat output_dir "sequences.html" in
let sequences_out_ch = open_out sequences in
output_string sequences_out_ch (sequences_text ~corpus ast);
close_out sequences_out_ch;
(** Modules.html **)
let modules = Filename.concat output_dir "modules.html" in
let modules_out_ch = open_out modules in
output_string modules_out_ch (index_modules_text ast);
close_out modules_out_ch;
(** domain.html **)
let domain = Filename.concat output_dir "domain.html" in
let domain_out_ch = open_out domain in
begin
match ast.Ast.domain with
| Some dom -> output_string domain_out_ch (domain_text ~corpus dom)
| None -> output_string domain_out_ch "No domain defined"
end;
close_out domain_out_ch;
(** Modules + rules **)
let modules_array = Array.of_list ast.Ast.modules in
for i = 0 to (Array.length modules_array -1) do
let page = Filename.concat output_dir (modules_array.(i).Ast.module_id^".html") in
let page_out_ch = open_out page in
output_string page_out_ch
(module_page_text ~corpus
(try Some (modules_array.(i-1).Ast.module_id) with _ -> None)
(try Some (modules_array.(i+1).Ast.module_id) with _ -> None)
modules_array.(i)
);
close_out page_out_ch;
let rules_array = Array.of_list modules_array.(i).Ast.rules in
for j = 0 to (Array.length rules_array -1) do
let page = Filename.concat output_dir (modules_array.(i).Ast.module_id^"_"^rules_array.(j).Ast.rule_id^".html") in
let page_out_ch = open_out page in
output_string page_out_ch
(rule_page_text ~corpus
~dep
(try Some (rules_array.(j-1).Ast.rule_id) with _ -> None)
(try Some (rules_array.(j+1).Ast.rule_id) with _ -> None)
rules_array.(j)
modules_array.(i)
);
close_out page_out_ch;
done;
done
end (* module Html_doc *)
(* ================================================================================ *)
module Html_rh = struct
let build ?domain ?filter ?main_feat ?(dot=false) ?(init_graph=true) ?(out_gr=false) ?header ?graph_file 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
let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in
(
if init_graph
then ignore (Instance.save_dep_png ?domain ?filter ?main_feat prefix t.Rewrite_history.instance)
);
let nf_files = Rewrite_history.save_nfs ?domain ?filter ?main_feat ~dot prefix t in
let l = List.length nf_files in
let local = Filename.basename prefix in
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
html_header ~css_file:"style.css" ~title buff;
wnl "<body>";
wnl "<a href=\"sentences.html\">Sentences</a> -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";
wnl "<h1>%s</h1>" title;
begin
match header with
| Some h -> wnl "%s<br/>" h
| None -> ()
end;
begin
match graph_file with
| Some gf ->
wnl "<b>Input file</b>: <a href=\"%s\">%s</a><br/>"
gf (Filename.basename gf)
| None -> ()
end;
wnl "<b>Input sentence</b>: <font color=\"green\"><i>%s</i></font></p><br/>"
(G_graph.to_sentence ?main_feat t.Rewrite_history.instance.Instance.graph);
if init_graph
then
begin
wnl "<h6>Initial graph</h6>";
wnl "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>" local
end;
List.iteri
(fun i (rules_list,file_name) ->
wnl "<h6>Solution %d</h6>" (i+1);
let local_name = Filename.basename file_name in
if out_gr
then wnl "<p><a href=\"%s.gr\">gr file</a>" local_name;
(* the png file *)
wnl "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>" local_name;
(* the modules list *)
wnl "<b>Modules applied</b>: %d<br/>" (List.length rules_list);
let id = sprintf "id_%d" (i+1) in
wnl "<a style=\"cursor:pointer;\"";
wnl " onClick=\"if (document.getElementById('%s').style.display == 'none')" id;
wnl " { document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = 'Hide applied rules'; }" id id;
wnl " else { document.getElementById('%s').style.display = 'none';; document.getElementById('p_%s').innerHTML = 'Show applied rules'; }\">" id id;
wnl " <b><p id=\"p_%s\">Show applied rules</p></b>" id;
wnl "</a>";
wnl " <div id=\"%s\" style=\"display:none;\">" id;
List.iter
(fun (mod_name,rules) ->
wnl "<p><b><font color=\"red\">%s: </font></b><font color=\"green\">%s</font></p>"
mod_name
(List_.to_string (fun x -> x) ", " rules);
)
rules_list;
wnl " </div>"
) nf_files;
wnl "</body>";
wnl "</html>";
let out_ch = open_out (sprintf "%s.html" prefix) in
fprintf out_ch "%s" (Buffer.contents buff);
close_out out_ch
let error ?domain ?main_feat ?(dot=false) ?(init_graph=true) ?header prefix msg graph_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 graph_opt, init_graph with
| (Some graph, true) when dot -> Instance.save_dot_png ?domain ?main_feat prefix (Instance.from_graph graph)