From bc1dd696c4e94e27815360fbd3b0ee1863a1bd35 Mon Sep 17 00:00:00 2001 From: bguillaum Date: Wed, 29 May 2013 21:27:29 +0000 Subject: [PATCH] add a root node at pos 0 in CONLL fix CONLL output (empty fields, quote) sem=void ==> void=y git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7936 7838e531-6607-4d57-9587-6c381814729c --- src/grew_edge.ml | 4 +- src/grew_edge.mli | 2 + src/grew_fs.ml | 17 ++- src/grew_graph.ml | 67 ++++++----- src/grew_node.ml | 13 +- src/grew_types.ml | 5 - src/grew_types.mli | 7 -- src/grew_utils.ml | 7 +- src/grew_utils.mli | 2 + src/libgrew.ml | 294 ++++++++++++++++++++++++--------------------- src/libgrew_.mli | 10 +- 11 files changed, 236 insertions(+), 192 deletions(-) diff --git a/src/grew_edge.ml b/src/grew_edge.ml index 783be44..01ee8f5 100644 --- a/src/grew_edge.ml +++ b/src/grew_edge.ml @@ -28,7 +28,7 @@ module Label = struct let to_string ?(locals=[||]) t = match (!full, t) with - | (None, No_domain s) -> s + | (_, No_domain s) -> s | (Some table, Global i) -> table.(i) | (Some _, Local i) -> fst locals.(i) | _ -> Error.bug "[Label.to_string] inconsistent data" @@ -58,6 +58,8 @@ module G_edge = struct let to_string ?(locals=[||]) t = Label.to_string ~locals t + let root = Label.No_domain "root" + let make ?loc ?(locals=[||]) string = Label.from_string ?loc ~locals string let build ?locals (ast_edge, loc) = diff --git a/src/grew_edge.mli b/src/grew_edge.mli index 963612e..1c4b56a 100644 --- a/src/grew_edge.mli +++ b/src/grew_edge.mli @@ -28,6 +28,8 @@ module G_edge: sig val to_string: ?locals:Label.decl array -> t -> string + val root: t + val make: ?loc:Loc.t -> ?locals:Label.decl array -> string -> t val build: ?locals:Label.decl array -> Ast.edge -> t diff --git a/src/grew_fs.ml b/src/grew_fs.ml index e30ac3a..b08d8ca 100644 --- a/src/grew_fs.ml +++ b/src/grew_fs.ml @@ -8,6 +8,10 @@ open Grew_ast type value = String of string | Float of float let string_of_value = function + | String s -> Str.global_replace (Str.regexp "\"") "\\\"" s + | Float i -> String_.of_float i + +let conll_string_of_value = function | String s -> s | Float i -> String_.of_float i @@ -35,6 +39,7 @@ module Domain = struct | ((Ast.Closed (n,vs))::_) when n = name -> (match List_.sort_diff values vs with | [] -> List.map (fun s -> String s) values + | l when List.for_all (fun x -> x.[0] = '_') l -> List.map (fun s -> String s) values | l -> Error.build ?loc "Unknown feature values '%s' for feature name '%s'" (List_.to_string (fun x->x) ", " l) name @@ -150,7 +155,7 @@ module G_fs = struct let get_string_atom feat_name t = match List_.sort_assoc feat_name t with | None -> None - | Some v -> Some (string_of_value v) + | Some v -> Some (conll_string_of_value v) let get_float_feat feat_name t = match List_.sort_assoc feat_name t with @@ -219,14 +224,20 @@ module G_fs = struct | None -> sub | Some l -> List.filter (fun (fn,_) -> List.mem fn l) sub in sprintf " word=\"%s\"; subword=\"%s\"" - (match main_opt with Some atom -> string_of_value atom | None -> "") + (match main_opt with Some atom -> string_of_value atom | None -> "_") (List_.to_string G_feature.to_string "#" reduced_sub) let to_conll ?exclude t = let reduced_t = match exclude with | None -> t | Some list -> List.filter (fun (fn,_) -> not (List.mem fn list || fn.[0]='_')) t in - String.concat "|" (List.map (function (fn, String "true") -> fn | (fn, fv) -> fn^"="^(string_of_value fv)) reduced_t) + match reduced_t with + | [] -> "_" + | _ -> String.concat "|" + (List.map + (function (fn, String "true") -> fn | (fn, fv) -> fn^"="^(string_of_value fv)) + reduced_t + ) end (* module G_fs *) (* ==================================================================================================== *) diff --git a/src/grew_graph.ml b/src/grew_graph.ml index 7570080..fef2ef0 100644 --- a/src/grew_graph.ml +++ b/src/grew_graph.ml @@ -295,8 +295,9 @@ module G_graph = struct (* -------------------------------------------------------------------------------- *) let of_conll ?loc lines = - - let sorted_lines = List.sort (fun line1 line2 -> Pervasives.compare line1.Conll.num line2.Conll.num) lines in + let sorted_lines = + Conll.root :: + (List.sort (fun line1 line2 -> Pervasives.compare line1.Conll.num line2.Conll.num) lines) in let table = Array.of_list (List.map (fun line -> line.Conll.num) sorted_lines) in @@ -308,20 +309,17 @@ module G_graph = struct (fun acc line -> (* add line number information in loc *) let loc = Loc.opt_set_line line.Conll.line_num loc in + let dep_id = Id.build ?loc line.Conll.num table in List.fold_left (fun acc2 (gov, dep_lab) -> - if gov = "0" - then acc2 - else - let gov_id = Id.build ?loc gov table in - let dep_id = Id.build ?loc line.Conll.num table in - let edge = G_edge.make ?loc dep_lab in - (match map_add_edge acc2 (Gid.Old gov_id) edge (Gid.Old dep_id) with - | Some g -> g - | None -> Error.build "[GRS] [Graph.of_conll] try to build a graph with twice the same edge %s %s" - (G_edge.to_string edge) - (match loc with Some l -> Loc.to_string l | None -> "") - ) + let gov_id = Id.build ?loc gov table in + let edge = if gov = "0" then G_edge.root else G_edge.make ?loc dep_lab in + (match map_add_edge acc2 (Gid.Old gov_id) edge (Gid.Old dep_id) with + | Some g -> g + | None -> Error.build "[GRS] [Graph.of_conll] try to build a graph with twice the same edge %s %s" + (G_edge.to_string edge) + (match loc with Some l -> Loc.to_string l | None -> "") + ) ) acc line.Conll.deps ) map_without_edges lines in {meta=[]; map=map_with_edges} @@ -624,9 +622,9 @@ module G_graph = struct (fun (id, node) -> let fs = G_node.get_fs node in let dep_fs = G_fs.to_dep ?filter ?main_feat fs in - let style = match (List.mem id deco.G_deco.nodes, G_fs.get_string_atom "sem" fs) with + let style = match (List.mem id deco.G_deco.nodes, G_fs.get_string_atom "void" fs) with | (true, _) -> "; forecolor=red; subcolor=red; " - | (false, Some "void") -> "; forecolor=red; subcolor=red; " + | (false, Some "y") -> "; forecolor=red; subcolor=red; " | _ -> "" in bprintf buff "N_%s { %s%s }\n" (Gid.to_string id) dep_fs style ) snodes; @@ -698,10 +696,9 @@ module G_graph = struct (* -------------------------------------------------------------------------------- *) let to_conll graph = - let nodes = Gid_map.fold (fun gid node acc -> (gid,node)::acc) graph.map [] in let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.pos_comp n1 n2) nodes in - let get_num gid = (list_num (fun (x,_) -> x=gid) snodes) + 1 in + let get_num gid = (list_num (fun (x,_) -> x=gid) snodes) in (* Warning: [govs_labs] maps [gid]s to [num]s *) let govs_labs = @@ -718,19 +715,31 @@ module G_graph = struct let buff = Buffer.create 32 in List.iter (fun (gid, node) -> - let (govs,labs) = List.split (try Gid_map.find gid govs_labs with Not_found -> ["0","root"]) in + let gov_labs = try Gid_map.find gid govs_labs with Not_found -> [] in + + let sorted_gov_labs = + List.sort + (fun (g1,l1) (g2,l2) -> + if l1 <> "" && l1.[0] <> 'I' && l1.[0] <> 'D' + then -1 + else if l2 <> "" && l2.[0] <> 'I' && l2.[0] <> 'D' + then 1 + else compare (String_.to_float g1) (String_.to_float g2) + ) gov_labs in + + let (govs,labs) = List.split sorted_gov_labs in let fs = G_node.get_fs node in - bprintf buff "%d\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t_\t_\n" - (get_num gid) - (match G_fs.get_string_atom "phon" fs with Some p -> p | None -> "NO_PHON") - (match G_fs.get_string_atom "lemma" fs with Some p -> p | None -> "NO_LEMMA") - (match G_fs.get_string_atom "cat" fs with Some p -> p | None -> "NO_CAT") - (match G_fs.get_string_atom "pos" fs with Some p -> p | None -> "_") - (G_fs.to_conll ~exclude: ["phon"; "lemma"; "cat"; "pos"; "position"] fs) - (String.concat "|" govs) - (String.concat "|" labs) + bprintf buff "%d\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t_\t_\n" + (get_num gid) + (match G_fs.get_string_atom "phon" fs with Some p -> p | None -> "NO_PHON") + (match G_fs.get_string_atom "lemma" fs with Some p -> p | None -> "NO_LEMMA") + (match G_fs.get_string_atom "cat" fs with Some p -> p | None -> "NO_CAT") + (match G_fs.get_string_atom "pos" fs with Some p -> p | None -> "_") + (G_fs.to_conll ~exclude: ["phon"; "lemma"; "cat"; "pos"; "position"] fs) + (String.concat "|" govs) + (String.concat "|" labs) ) - snodes; + (List.tl snodes) (* do not consider the root node in CONLL output *); Buffer.contents buff end (* module G_graph *) diff --git a/src/grew_node.ml b/src/grew_node.ml index 97237cc..0f06ae9 100644 --- a/src/grew_node.ml +++ b/src/grew_node.ml @@ -48,11 +48,14 @@ module G_node = struct } ) let of_conll line = - { - fs = G_fs.of_conll line; - pos = Some (String_.to_float line.Conll.num); - next = Massoc_gid.empty; - } + if line = Conll.root + then { fs = G_fs.empty; pos = Some 0.; next = Massoc_gid.empty } + else + { + fs = G_fs.of_conll line; + pos = Some (String_.to_float line.Conll.num); + next = Massoc_gid.empty; + } let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next} diff --git a/src/grew_types.ml b/src/grew_types.ml index 48f746a..3462402 100644 --- a/src/grew_types.ml +++ b/src/grew_types.ml @@ -23,8 +23,3 @@ and big_step = { first: rule_app; small_step: (G_graph.t * rule_app) list; } - -let to_dot_graph ?main_feat ?(deco=G_deco.empty) graph = G_graph.to_dot ?main_feat graph ~deco -let to_dep_graph ?filter ?main_feat ?(deco=G_deco.empty) graph = G_graph.to_dep ?filter ?main_feat ~deco graph -let to_gr_graph graph = G_graph.to_gr graph -let to_conll_graph graph = G_graph.to_conll graph diff --git a/src/grew_types.mli b/src/grew_types.mli index afa89d7..4b8c9df 100644 --- a/src/grew_types.mli +++ b/src/grew_types.mli @@ -28,10 +28,3 @@ and big_step = { first: rule_app; small_step: (graph * rule_app) list; } - -(** {2 Types displaying} *) - -val to_dot_graph : ?main_feat:string -> ?deco:deco -> graph -> string -val to_dep_graph : ?filter: string list -> ?main_feat:string -> ?deco:deco -> graph -> string -val to_gr_graph: graph -> string -val to_conll_graph: graph -> string diff --git a/src/grew_utils.ml b/src/grew_utils.ml index 1c3684f..81cc053 100644 --- a/src/grew_utils.ml +++ b/src/grew_utils.ml @@ -608,8 +608,9 @@ module Conll = struct deps: (string * string ) list; } - let load file = + let root = { line_num = -1; num="0"; phon="ROOT"; lemma="__"; pos1="_X"; pos2=""; morph=[]; deps=[] } + let load file = let parse_morph line_num = function | "_" -> [] | morph -> @@ -631,8 +632,8 @@ module Conll = struct let deps = List.combine gov_list lab_list in {line_num = line_num; num = num; - phon = escape_quote phon; - lemma = escape_quote lemma; + phon = phon; + lemma = lemma; pos1 = pos1; pos2 = pos2; morph = parse_morph line_num morph; diff --git a/src/grew_utils.mli b/src/grew_utils.mli index fedc7fa..71d00fe 100644 --- a/src/grew_utils.mli +++ b/src/grew_utils.mli @@ -266,6 +266,8 @@ module Conll: sig deps: (string * string ) list; } + val root:line + val load: string -> line list end diff --git a/src/libgrew.ml b/src/libgrew.ml index bb20cd8..fe6cace 100644 --- a/src/libgrew.ml +++ b/src/libgrew.ml @@ -13,6 +13,12 @@ open Grew_parser open Grew_html +let css_file = Filename.concat DATA_DIR "style.css" + +let empty_grs = Grs.empty + +let set_timeout t = Timeout.timeout := t + exception File_dont_exists of string @@ -21,151 +27,149 @@ exception Build of string * (string * int) option exception Run of string * (string * int) option exception Bug of string * (string * int) option -type grs = Grs.t -type gr = Instance.t -type rew_history = Rewrite_history.t +let handle ?(name="") ?(file="No file defined") fct () = + (* Printf.printf " ==========> %s ...%!" name; *) + try fct () with + | Grew_parser.Parse_error (msg,Some (sub_file,l)) -> + raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg)) + | Grew_parser.Parse_error (msg,None) -> + raise (Parsing_err (sprintf "[file:%s] %s" file msg)) + | Error.Build (msg,loc) -> raise (Build (msg,loc)) + | Error.Bug (msg, loc) -> raise (Bug (msg,loc)) + | Error.Run (msg, loc) -> raise (Run (msg,loc)) + | exc -> raise (Bug (sprintf "[Libgrew.%s] UNCATCHED EXCEPTION: %s" name (Printexc.to_string exc), None)) -let is_empty = Rewrite_history.is_empty -let num_sol = Rewrite_history.num_sol +let is_empty rh = + handle ~name:"num_sol" (fun () -> Rewrite_history.is_empty rh) () -let empty_grs = Grs.empty +let num_sol rh = + handle ~name:"num_sol" (fun () -> Rewrite_history.num_sol rh) () -let set_timeout t = Timeout.timeout := t IFDEF DEP2PICT THEN let build_doc file dir grs_ast grs = - Html_doc.build ~dep:true file dir grs_ast; - - (* draw pattern graphs for all rules and all filters *) - let fct module_ rule_ = - let dep_code = Rule.to_dep rule_ in - let dep_svg_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in - ignore (Dep2pict.Dep2pict.fromDepStringToPng dep_code dep_svg_file) in - Grs.rule_iter fct grs; - Grs.filter_iter fct grs + handle ~name:"build_doc [with Dep2pict]" ~file + (fun () -> + Html_doc.build ~dep:true file dir grs_ast; + + (* draw pattern graphs for all rules and all filters *) + let fct module_ rule_ = + let dep_code = Rule.to_dep rule_ in + let dep_svg_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in + ignore (Dep2pict.Dep2pict.fromDepStringToPng dep_code dep_svg_file) in + Grs.rule_iter fct grs; + Grs.filter_iter fct grs + ) () ELSE let build_doc file dir grs_ast grs = - Html_doc.build ~dep:false file dir grs_ast + handle ~name:"build_doc [without Dep2pict]" (fun () -> Html_doc.build ~dep:false file dir grs_ast) () END let load_grs ?doc_output_dir file = - if not (Sys.file_exists file) - then raise (File_dont_exists file) - else - try - let grs_ast = Grew_parser.grs_of_file file in - let grs = Grs.build grs_ast in - (match doc_output_dir with - | None -> () - | Some dir -> build_doc file dir grs_ast grs); - grs - with - | Grew_parser.Parse_error (msg,Some (sub_file,l)) -> - raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg)) - | Grew_parser.Parse_error (msg,None) -> - raise (Parsing_err (sprintf "[file:%s] %s" file msg)) - | Error.Build (msg,loc) -> raise (Build (msg,loc)) - | Error.Bug (msg, loc) -> raise (Bug (msg,loc)) - | exc -> raise (Bug (sprintf "[Libgrew.load_grs] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) + handle ~name:"load_grs" ~file + (fun () -> + if not (Sys.file_exists file) + then raise (File_dont_exists file) + else + let grs_ast = Grew_parser.grs_of_file file in + let grs = Grs.build grs_ast in + (match doc_output_dir with + | None -> () + | Some dir -> build_doc file dir grs_ast grs); + grs + ) () let to_sentence ?main_feat gr = - let graph = gr.Instance.graph in - G_graph.to_sentence ?main_feat graph - -let get_sequence_names grs = Grs.sequence_names grs + handle ~name:"to_sentence" + (fun () -> + let graph = gr.Instance.graph in + G_graph.to_sentence ?main_feat graph + ) () + +let get_sequence_names grs = + handle ~name:"get_sequence_names" + (fun () -> + Grs.sequence_names grs + ) () let load_gr file = - if Sys.file_exists file - then - begin - try + if not (Sys.file_exists file) + then raise (File_dont_exists file) + else + handle ~name:"load_gr" ~file + (fun () -> let gr_ast = Grew_parser.gr_of_file file in Instance.from_graph (G_graph.build gr_ast) - with - | Grew_parser.Parse_error (msg,Some (sub_file,l)) -> - raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg)) - | Grew_parser.Parse_error (msg,None) -> - raise (Parsing_err (sprintf "[file:%s] %s" file msg)) - | Error.Build (msg,loc) -> raise (Build (msg,loc)) - | Error.Bug (msg, loc) -> raise (Bug (msg,loc)) - | exc -> raise (Bug (sprintf "[Libgrew.load_gr] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) - end - else raise (File_dont_exists file) + ) () let load_conll file = - try - let graph = G_graph.of_conll ~loc:(file,-1) (Conll.load file) in - Instance.from_graph graph - with - | Grew_parser.Parse_error (msg,Some (sub_file,l)) -> - raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg)) - | Grew_parser.Parse_error (msg,None) -> - raise (Parsing_err (sprintf "[file:%s] %s" file msg)) - | Error.Build (msg,loc) -> raise (Build (msg,loc)) - | Error.Bug (msg, loc) -> raise (Bug (msg,loc)) - | exc -> raise (Bug (sprintf "[Libgrew.load_conll] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) - -let load_graph file = - if Filename.check_suffix file ".gr" - then load_gr file - else if Filename.check_suffix file ".conll" - then load_conll file - else - begin - Log.fwarning "Unknown file format for input graph '%s', try to guess..." file; - try load_gr file with - Parsing_err _ -> - try load_conll file with - Parsing_err _ -> - Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file - end + handle ~name:"load_conll" ~file + (fun () -> + let graph = G_graph.of_conll ~loc:(file,-1) (Conll.load file) in + Instance.from_graph graph + ) () + +let load_graph file = + handle ~name:"load_graph" ~file + (fun () -> + if Filename.check_suffix file ".gr" + then load_gr file + else if Filename.check_suffix file ".conll" + then load_conll file + else + begin + Log.fwarning "Unknown file format for input graph '%s', try to guess..." file; + try load_gr file with + Parsing_err _ -> + try load_conll file with + Parsing_err _ -> + Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file + end + ) () let xml_graph xml = - try Instance.from_graph (G_graph.of_xml xml) with - | Error.Build (msg,loc) -> raise (Build (msg,loc)) - | Error.Bug (msg, loc) -> raise (Bug (msg,loc)) - | exc -> raise (Bug (sprintf "[Libgrew.load_conll] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) + handle ~name:"xml_graph" (fun () -> Instance.from_graph (G_graph.of_xml xml)) () let raw_graph instance = - G_graph.to_raw instance.Instance.graph + handle ~name:"raw_graph" (fun () -> G_graph.to_raw instance.Instance.graph) () -let rewrite ~gr ~grs ~seq = - try Grs.rewrite grs seq gr - with - | Error.Run (msg,loc) -> raise (Run (msg,loc)) - | Error.Bug (msg, loc) -> raise (Bug (msg,loc)) - | exc -> raise (Bug (sprintf "[Libgrew.rewrite] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) +let rewrite ~gr ~grs ~seq = + handle ~name:"rewrite" (fun () -> Grs.rewrite grs seq gr) () let display ~gr ~grs ~seq = - try Grs.build_rew_display grs seq gr - with - | Error.Run (msg,loc) -> raise (Run (msg,loc)) - | Error.Bug (msg, loc) -> raise (Bug (msg,loc)) - | Error.Build (msg, loc) -> raise (Build (msg,loc)) - | exc -> raise (Bug (sprintf "[Libgrew.display] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) + handle ~name:"display" (fun () -> Grs.build_rew_display grs seq gr) () -let write_stat filename rew_hist = Gr_stat.save filename (Gr_stat.from_rew_history rew_hist) +let write_stat filename rew_hist = + handle ~name:"write_stat" (fun () -> Gr_stat.save filename (Gr_stat.from_rew_history rew_hist)) () let save_index ~dirname ~base_names = - let out_ch = open_out (Filename.concat dirname "index") in - List.iter (fun f -> fprintf out_ch "%s\n" f) base_names; - close_out out_ch - + handle ~name:"save_index" (fun () -> + let out_ch = open_out (Filename.concat dirname "index") in + List.iter (fun f -> fprintf out_ch "%s\n" f) base_names; + close_out out_ch + ) () let save_graph_conll filename graph = - let out_ch = open_out filename in - fprintf out_ch "%s" (Instance.to_conll graph); - close_out out_ch + handle ~name:"save_graph_conll" (fun () -> + let out_ch = open_out filename in + fprintf out_ch "%s" (Instance.to_conll graph); + close_out out_ch + ) () -let save_gr base rew_hist = Rewrite_history.save_gr base rew_hist +let save_gr base rew_hist = + handle ~name:"save_gr" (fun () -> Rewrite_history.save_gr base rew_hist) () -let save_conll base rew_hist = Rewrite_history.save_conll base rew_hist +let save_conll base rew_hist = + handle ~name:"save_conll" (fun () -> Rewrite_history.save_conll base rew_hist) () -let save_det_gr base rew_hist = Rewrite_history.save_det_gr base rew_hist +let save_det_gr base rew_hist = + handle ~name:"save_det_gr" (fun () -> Rewrite_history.save_det_gr base rew_hist) () -let save_det_conll ?header base rew_hist = Rewrite_history.save_det_conll ?header base rew_hist +let save_det_conll ?header base rew_hist = + handle ~name:"save_det_conll" (fun () -> Rewrite_history.save_det_conll ?header base rew_hist) () -let det_dep_string rew_hist = Rewrite_history.det_dep_string rew_hist +let det_dep_string rew_hist = + handle ~name:"det_dep_string" (fun () -> Rewrite_history.det_dep_string rew_hist) () let write_html ?(no_init=false) @@ -177,17 +181,19 @@ let write_html ~graph_file rew_hist output_base = - ignore ( - Html_rh.build - ?filter - ?main_feat - ?dot - ~out_gr - ~init_graph: (not no_init) - ~header - ~graph_file - output_base rew_hist + handle ~name:"write_html" (fun () -> + ignore ( + Html_rh.build + ?filter + ?main_feat + ?dot + ~out_gr + ~init_graph: (not no_init) + ~header + ~graph_file + output_base rew_hist ) + ) () let error_html ?(no_init=false) @@ -197,28 +203,42 @@ let error_html msg ?init output_base = - ignore ( - Html_rh.error - ?main_feat - ?dot - ~init_graph: (not no_init) - ~header - output_base msg init + handle ~name:"error_html" (fun () -> + ignore ( + Html_rh.error + ?main_feat + ?dot + ~init_graph: (not no_init) + ~header + output_base msg init ) + ) () 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 input_dir output_dir corpus_stat + handle ~name:"make_index" (fun () -> + 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 input_dir output_dir corpus_stat + ) () + +let html_sentences ~title = handle ~name:"html_sentences" (fun () -> Html_sentences.build ~title) () + +let graph_of_instance instance = handle ~name:"graph_of_instance" (fun () -> instance.Instance.graph) () + +let feature_names () = handle ~name:"feature_names" (fun () -> Domain.feature_names ()) () -let html_sentences ~title = Html_sentences.build ~title +let to_dot_graph ?main_feat ?(deco=G_deco.empty) graph = + handle ~name:"to_dot_graph" (fun () -> G_graph.to_dot ?main_feat graph ~deco) () -let get_css_file = Filename.concat DATA_DIR "style.css" +let to_dep_graph ?filter ?main_feat ?(deco=G_deco.empty) graph = + handle ~name:"to_dep_graph" (fun () -> G_graph.to_dep ?filter ?main_feat ~deco graph) () -let graph_of_instance instance = instance.Instance.graph +let to_gr_graph graph = + handle ~name:"to_gr_graph" (fun () -> G_graph.to_gr graph) () -let feature_names () = Domain.feature_names () +let to_conll_graph graph = + handle ~name:"to_conll_graph" (fun () -> G_graph.to_conll graph) () diff --git a/src/libgrew_.mli b/src/libgrew_.mli index fed5488..f15c06a 100644 --- a/src/libgrew_.mli +++ b/src/libgrew_.mli @@ -6,6 +6,8 @@ open Grew_graph open Grew_rule open Grew_grs +val css_file: string + exception Parsing_err of string exception File_dont_exists of string @@ -116,8 +118,12 @@ val make_index: val html_sentences: title:string -> string -> (bool * string * int * string) list -> unit -val get_css_file: string - val graph_of_instance: Instance.t -> G_graph.t val feature_names: unit -> string list option + +val to_dot_graph : ?main_feat:string -> ?deco:deco -> graph -> string +val to_dep_graph : ?filter: string list -> ?main_feat:string -> ?deco:deco -> graph -> string +val to_gr_graph: graph -> string +val to_conll_graph: graph -> string + -- GitLab