libgrew.ml 8.88 KB
Newer Older
bguillaum's avatar
bguillaum committed
1 2 3 4 5 6 7 8 9 10
(**********************************************************************************)
(*    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                                                   *)
(**********************************************************************************)

11
open Libgrew_types
pj2m's avatar
pj2m committed
12

bguillaum's avatar
bguillaum committed
13
open Printf
pj2m's avatar
pj2m committed
14 15
open Log

16 17 18 19
IFDEF DEP2PICT THEN
open Dep2pict
ENDIF

20
open Grew_fs
21
open Grew_base
22 23
open Grew_types

bguillaum's avatar
bguillaum committed
24 25 26 27
open Grew_graph
open Grew_rule
open Grew_grs

bguillaum's avatar
bguillaum committed
28
open Grew_loader
bguillaum's avatar
bguillaum committed
29
open Grew_html
pj2m's avatar
pj2m committed
30

31 32 33 34 35 36
let css_file = Filename.concat DATA_DIR "style.css"

let empty_grs = Grs.empty

let set_timeout t = Timeout.timeout := t

bguillaum's avatar
bguillaum committed
37 38
type loc = Loc.t
let string_of_loc = Loc.to_string
39
let line_of_loc = Loc.to_line
bguillaum's avatar
bguillaum committed
40

41 42
type graph = G_graph.t

pj2m's avatar
pj2m committed
43 44
exception File_dont_exists of string

bguillaum's avatar
bguillaum committed
45 46 47 48
exception Parsing_err of string * loc option
exception Build of string * loc option
exception Run of string * loc option
exception Bug of string * loc option
pj2m's avatar
pj2m committed
49

50 51
let handle ?(name="") ?(file="No file defined") fct () =
  try fct () with
52
    (* Raise again already catched exceptions *)
bguillaum's avatar
bguillaum committed
53 54 55 56
    | Parsing_err (msg,loc_opt) -> raise (Parsing_err (msg,loc_opt))
    | Build (msg,loc_opt) -> raise (Build (msg,loc_opt))
    | Bug (msg, loc_opt) -> raise (Bug (msg,loc_opt))
    | Run (msg, loc_opt) -> raise (Run (msg,loc_opt))
57 58

    (* Catch new exceptions *)
bguillaum's avatar
bguillaum committed
59
    | Loader.Error (msg, loc_opt) -> raise (Parsing_err (msg, loc_opt))
bguillaum's avatar
bguillaum committed
60 61 62
    | Error.Build (msg, loc_opt) -> raise (Build (msg, loc_opt))
    | Error.Bug (msg, loc_opt) -> raise (Bug (msg,loc_opt))
    | Error.Run (msg, loc_opt) -> raise (Run (msg,loc_opt))
63

64
    | exc -> raise (Bug (sprintf "[Libgrew.%s] UNCATCHED EXCEPTION: %s" name (Printexc.to_string exc), None))
pj2m's avatar
pj2m committed
65

66
let is_empty rh =
bguillaum's avatar
bguillaum committed
67
  handle ~name:"is_empty" (fun () -> Rewrite_history.is_empty rh) ()
bguillaum's avatar
bguillaum committed
68

69 70
let num_sol rh =
  handle ~name:"num_sol" (fun () -> Rewrite_history.num_sol rh) ()
pj2m's avatar
pj2m committed
71

bguillaum's avatar
bguillaum committed
72

73
IFDEF DEP2PICT THEN
74
let build_html_doc ?(corpus=false) dir grs =
75
  handle ~name:"build_doc [with Dep2pict]"
76
    (fun () ->
77
      Html_doc.build ~corpus ~dep:true dir grs;
78 79 80 81

      (* draw pattern graphs for all rules and all filters *)
      let fct module_ rule_ =
        let dep_code = Rule.to_dep rule_ in
82
        let dep_png_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in
83 84
        let d2p = Dep2pict.from_dep ~dep:dep_code in
        Dep2pict.save_png ~filename:dep_png_file d2p in
85 86 87
      Grs.rule_iter fct grs;
      Grs.filter_iter fct grs
    ) ()
88
ELSE
89
let build_html_doc ?(corpus=false) dir grs =
90
  handle ~name:"build_doc [without Dep2pict]" (fun () -> Html_doc.build ~corpus ~dep:false dir grs) ()
91 92
END

93
let load_grs file =
94 95 96 97
  handle ~name:"load_grs" ~file
    (fun () ->
      if not (Sys.file_exists file)
      then raise (File_dont_exists file)
98
      else Grs.build file
99
    ) ()
bguillaum's avatar
bguillaum committed
100

bguillaum's avatar
bguillaum committed
101
let to_sentence ?main_feat gr =
102 103
  handle ~name:"to_sentence"
    (fun () ->
104
      G_graph.to_sentence ?main_feat gr
105 106 107 108 109 110 111
    ) ()

let get_sequence_names grs =
  handle ~name:"get_sequence_names"
    (fun () ->
      Grs.sequence_names grs
    ) ()
bguillaum's avatar
bguillaum committed
112 113

let load_gr file =
114 115 116 117 118
  if not (Sys.file_exists file)
  then raise (File_dont_exists file)
  else
    handle ~name:"load_gr" ~file
      (fun () ->
bguillaum's avatar
bguillaum committed
119
        let gr_ast = Loader.gr file in
120
        G_graph.build gr_ast
121
      ) ()
pj2m's avatar
pj2m committed
122

bguillaum's avatar
bguillaum committed
123
let load_conll file =
124 125
  handle ~name:"load_conll" ~file
    (fun () ->
126
      G_graph.of_conll ~loc:(Loc.file file) (Conll.load file)
127 128
    ) ()

bguillaum's avatar
bguillaum committed
129 130 131
let of_conll file_name line_list =
  handle ~name:"of_conll"
    (fun () ->
132
      G_graph.of_conll ~loc:(Loc.file file_name) (Conll.parse file_name line_list)
bguillaum's avatar
bguillaum committed
133 134
    ) ()

135
let of_brown ?sentid brown =
136 137
  handle ~name:"of_brown"
    (fun () ->
138
      G_graph.of_brown ?sentid brown
139 140
    ) ()

bguillaum's avatar
bguillaum committed
141 142 143 144
let load_brown file =
  handle ~name:"load_brown"
    (fun () ->
      let brown = File.load file in
145
      G_graph.of_brown brown
bguillaum's avatar
bguillaum committed
146 147
    ) ()

148 149 150
let load_graph file =
  handle ~name:"load_graph" ~file
    (fun () ->
bguillaum's avatar
bguillaum committed
151 152 153 154 155
      match File.get_suffix file with
      | Some ".gr" -> load_gr file
      | Some ".conll" -> load_conll file
      | Some ".br" | Some ".melt" -> load_brown file 
      | _ ->
156
          Log.fwarning "Unknown file format for input graph '%s', try to guess..." file;
bguillaum's avatar
bguillaum committed
157 158 159 160
          let rec loop = function
          | [] -> Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file
          | load_fct :: tail -> try load_fct file with _ -> loop tail in
          loop [load_gr; load_conll; load_brown]
161
    ) ()
162

bguillaum's avatar
bguillaum committed
163
let xml_graph xml =
164
  handle ~name:"xml_graph" (fun () -> G_graph.of_xml xml) ()
bguillaum's avatar
bguillaum committed
165

166 167
let raw_graph gr =
  handle ~name:"raw_graph" (fun () -> G_graph.to_raw gr) ()
bguillaum's avatar
bguillaum committed
168

169 170
let rewrite ~gr ~grs ~seq =
  handle ~name:"rewrite" (fun () -> Grs.rewrite grs seq gr) ()
171

bguillaum's avatar
bguillaum committed
172
let display ~gr ~grs ~seq =
173
  handle ~name:"display" (fun () -> Grs.build_rew_display grs seq gr) ()
bguillaum's avatar
bguillaum committed
174

175 176
let write_stat filename rew_hist =
  handle ~name:"write_stat" (fun () -> Gr_stat.save filename (Gr_stat.from_rew_history rew_hist)) ()
bguillaum's avatar
bguillaum committed
177

178 179
let write_annot ~title static_dir annot_dir base_name_rew_hist_list =
  handle ~name:"write_annot" (fun () -> Html_annot.build ~title static_dir annot_dir base_name_rew_hist_list) ()
180

bguillaum's avatar
bguillaum committed
181
let save_index ~dirname ~base_names =
182 183 184 185 186
  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
  ) ()
187

bguillaum's avatar
bguillaum committed
188
let save_graph_conll filename graph =
189 190
  handle ~name:"save_graph_conll" (fun () ->
    let out_ch = open_out filename in
191
    fprintf out_ch "%s" (G_graph.to_conll graph);
192 193
    close_out out_ch
  ) ()
bguillaum's avatar
bguillaum committed
194

195 196
let save_gr base rew_hist =
  handle ~name:"save_gr" (fun () -> Rewrite_history.save_gr base rew_hist) ()
197

198 199
let save_conll base rew_hist =
  handle ~name:"save_conll" (fun () -> Rewrite_history.save_conll base rew_hist) ()
bguillaum's avatar
bguillaum committed
200

201 202 203
let save_full_conll base rew_hist =
  handle ~name:"save_full_conll" (fun () -> Rewrite_history.save_full_conll base rew_hist) ()

204 205
let save_det_gr base rew_hist =
  handle ~name:"save_det_gr" (fun () -> Rewrite_history.save_det_gr base rew_hist) ()
bguillaum's avatar
bguillaum committed
206

207
let save_det_conll ?header base rew_hist =
208
  handle ~name:"save_deeeet_conll" (fun () -> Rewrite_history.save_det_conll ?header base rew_hist) ()
209

210 211
let det_dep_string rew_hist =
  handle ~name:"det_dep_string" (fun () -> Rewrite_history.det_dep_string rew_hist) ()
bguillaum's avatar
bguillaum committed
212

bguillaum's avatar
bguillaum committed
213 214 215
let conll_dep_string ?keep_empty_rh rew_hist =
  handle ~name:"conll_dep_string" (fun () -> Rewrite_history.conll_dep_string ?keep_empty_rh rew_hist) ()

bguillaum's avatar
bguillaum committed
216
let write_html
217 218
    ?(no_init=false)
    ?(out_gr=false)
219 220
    ?filter
    ?main_feat
221
    ?dot
bguillaum's avatar
bguillaum committed
222
    ~header
bguillaum's avatar
bguillaum committed
223
    ?graph_file
bguillaum's avatar
bguillaum committed
224 225
    rew_hist
    output_base =
226 227 228 229 230 231 232 233 234
  handle ~name:"write_html" (fun () ->
    ignore (
      Html_rh.build
        ?filter
        ?main_feat
        ?dot
        ~out_gr
        ~init_graph: (not no_init)
        ~header
bguillaum's avatar
bguillaum committed
235
        ?graph_file
236
        output_base rew_hist
bguillaum's avatar
bguillaum committed
237
    )
238
  ) ()
239

bguillaum's avatar
bguillaum committed
240 241 242
let error_html
    ?(no_init=false)
    ?main_feat
243
    ?dot
244
    ~header
bguillaum's avatar
bguillaum committed
245
    msg
246
    ?init
247
    output_base =
248 249 250 251 252 253 254 255
  handle ~name:"error_html" (fun () ->
    ignore (
      Html_rh.error
        ?main_feat
        ?dot
        ~init_graph: (not no_init)
        ~header
        output_base msg init
256
    )
257
  ) ()
258

259
let make_index ~title ~grs_file ~html ~grs ~seq ~input_dir ~output_dir ~base_names  =
260 261 262 263 264 265 266 267 268 269 270 271 272
  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 feature_names () =  handle ~name:"feature_names" (fun () -> Domain.feature_names ()) ()
bguillaum's avatar
bguillaum committed
273

274 275
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) ()
bguillaum's avatar
bguillaum committed
276

277 278
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) ()
pj2m's avatar
pj2m committed
279

280 281
let to_gr_graph graph =
  handle ~name:"to_gr_graph" (fun () -> G_graph.to_gr graph) ()
282

283 284
let to_conll_graph graph =
  handle ~name:"to_conll_graph" (fun () -> G_graph.to_conll graph) ()
bguillaum's avatar
bguillaum committed
285

286 287 288
type pattern = Rule.pattern
type matching = Rule.matching

bguillaum's avatar
bguillaum committed
289
let load_pattern file =
bguillaum's avatar
bguillaum committed
290
  handle ~name:"load_pattern" (fun () -> Rule.build_pattern (Loader.pattern file)) ()
291 292 293

let match_in_graph pattern graph = Rule.match_in_graph pattern graph

bguillaum's avatar
bguillaum committed
294
let match_deco pattern matching = Rule.match_deco pattern matching