libgrew.ml 13.7 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                                                   *)
(**********************************************************************************)

bguillaum's avatar
bguillaum committed
11
open Printf
pj2m's avatar
pj2m committed
12
open Log
13
open Conll
pj2m's avatar
pj2m committed
14

bguillaum's avatar
bguillaum committed
15 16
let libgrew_debug_mode () = Grew_base.Global.debug := true

bguillaum's avatar
bguillaum committed
17
(* ==================================================================================================== *)
bguillaum's avatar
bguillaum committed
18
(** {2 Location} *)
bguillaum's avatar
bguillaum committed
19 20 21 22 23 24 25 26
(* ==================================================================================================== *)
module Loc = struct
  type t = Grew_base.Loc.t
  let to_string = Grew_base.Loc.to_string
  let to_line = Grew_base.Loc.to_line
end

(* ==================================================================================================== *)
bguillaum's avatar
bguillaum committed
27
(** {2 Exceptions} *)
bguillaum's avatar
bguillaum committed
28
(* ==================================================================================================== *)
29
exception File_not_found of string
bguillaum's avatar
bguillaum committed
30 31 32 33
exception Parsing_err of string * Loc.t option
exception Build of string * Loc.t option
exception Run of string * Loc.t option
exception Bug of string * Loc.t option
pj2m's avatar
pj2m committed
34

35 36
let handle ?(name="") ?(file="No file defined") fct () =
  try fct () with
bguillaum's avatar
typo  
bguillaum committed
37
    (* Raise again already caught exceptions *)
bguillaum's avatar
bguillaum committed
38 39 40 41
    | 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))
42
    | File_not_found file -> raise (File_not_found file)
43 44

    (* Catch new exceptions *)
45
    | Grew_base.Error.Parse (msg, loc_opt) -> raise (Parsing_err (msg, loc_opt))
bguillaum's avatar
bguillaum committed
46 47 48
    | Grew_base.Error.Build (msg, loc_opt) -> raise (Build (msg, loc_opt))
    | Grew_base.Error.Bug (msg, loc_opt) -> raise (Bug (msg,loc_opt))
    | Grew_base.Error.Run (msg, loc_opt) -> raise (Run (msg,loc_opt))
49

bguillaum's avatar
bguillaum committed
50 51
    | Conll.Error msg -> raise (Parsing_err (msg,None))

bguillaum's avatar
typo  
bguillaum committed
52
    | exc -> raise (Bug (sprintf "[Libgrew.%s] UNCAUGHT EXCEPTION: %s" name (Printexc.to_string exc), None))
pj2m's avatar
pj2m committed
53

bguillaum's avatar
bguillaum committed
54

bguillaum's avatar
bguillaum committed
55
(* ==================================================================================================== *)
56
(** {2 Domain} *)
bguillaum's avatar
bguillaum committed
57 58 59
(* ==================================================================================================== *)
module Domain = struct
  type t = Grew_types.Domain.t
60

bguillaum's avatar
bguillaum committed
61 62
  let load filename =
    let ast = Grew_loader.Loader.domain filename in
bguillaum's avatar
bguillaum committed
63
    Grew_grs.Grs.domain_build ast
64

bguillaum's avatar
bguillaum committed
65
  let feature_names domain =  handle ~name:"feature_names" (fun () -> Grew_types.Domain.feature_names domain) ()
bguillaum's avatar
bguillaum committed
66 67 68 69 70 71 72 73
end

(* ==================================================================================================== *)
(** {2 Patterns} *)
(* ==================================================================================================== *)
module Pattern = struct
  type t = Grew_rule.Rule.pattern

bguillaum's avatar
bguillaum committed
74 75
  let load ?domain file =
  handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain (Grew_loader.Loader.pattern file)) ()
bguillaum's avatar
bguillaum committed
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
end

(* ==================================================================================================== *)
(** {2 Matching} *)
(* ==================================================================================================== *)
module Matching = struct
  type t = Grew_rule.Rule.matching
end

(* ==================================================================================================== *)
(** {2 Deco} *)
(* ==================================================================================================== *)
module Deco = struct
  type t = Grew_graph.G_deco.t
  let build pattern matching = Grew_rule.Rule.match_deco pattern matching
end

(* ==================================================================================================== *)
bguillaum's avatar
bguillaum committed
94
(** {2 Graph} *)
bguillaum's avatar
bguillaum committed
95 96 97 98 99 100
(* ==================================================================================================== *)
module Graph = struct


type t = Grew_graph.G_graph.t

bguillaum's avatar
bguillaum committed
101
  let load_gr ?domain file =
bguillaum's avatar
bguillaum committed
102
    if not (Sys.file_exists file)
103
    then raise (File_not_found file)
bguillaum's avatar
bguillaum committed
104 105 106 107
    else
      handle ~name:"Graph.load_gr" ~file
        (fun () ->
          let gr_ast = Grew_loader.Loader.gr file in
bguillaum's avatar
bguillaum committed
108
          Grew_graph.G_graph.build ?domain gr_ast
bguillaum's avatar
bguillaum committed
109
        ) ()
bguillaum's avatar
bguillaum committed
110

bguillaum's avatar
bguillaum committed
111
  let load_conll ?domain file =
bguillaum's avatar
bguillaum committed
112
    handle ~name:"Graph.load_conll" ~file
113
      (fun () ->
bguillaum's avatar
bguillaum committed
114
        Grew_graph.G_graph.of_conll ?domain (Conll.load file)
115
      ) ()
pj2m's avatar
pj2m committed
116

bguillaum's avatar
bguillaum committed
117
  let load_brown ?domain file =
bguillaum's avatar
bguillaum committed
118 119 120
    handle ~name:"Graph.load_brown"
      (fun () ->
        let brown = Grew_base.File.load file in
bguillaum's avatar
bguillaum committed
121
        Grew_graph.G_graph.of_brown ?domain brown
bguillaum's avatar
bguillaum committed
122
      ) ()
123

124
  let load_pst ?domain file =
125 126 127
    if not (Sys.file_exists file)
    then raise (File_not_found file)
    else
128
      handle ~name:"load_pst" ~file
129
        (fun () ->
130 131
          let const_ast = Grew_loader.Loader.phrase_structure_tree file in
          Grew_graph.G_graph.of_pst ?domain const_ast
132 133
        ) ()

bguillaum's avatar
bguillaum committed
134
  let load ?domain file =
bguillaum's avatar
bguillaum committed
135 136 137
    handle ~name:"Graph.load_graph" ~file
      (fun () ->
        match Grew_base.File.get_suffix file with
bguillaum's avatar
bguillaum committed
138 139 140
        | Some ".gr" -> load_gr ?domain file
        | Some ".conll" -> load_conll ?domain file
        | Some ".br" | Some ".melt" -> load_brown ?domain file
141
        | Some ".cst" -> load_pst ?domain file
bguillaum's avatar
bguillaum committed
142 143 144 145
        | _ ->
            Log.fwarning "Unknown file format for input graph '%s', try to guess..." file;
            let rec loop = function
            | [] -> Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file
bguillaum's avatar
bguillaum committed
146
            | load_fct :: tail -> try load_fct ?domain file with _ -> loop tail in
147
            loop [load_gr; load_conll; load_brown; load_pst]
bguillaum's avatar
bguillaum committed
148
      ) ()
bguillaum's avatar
bguillaum committed
149

bguillaum's avatar
bguillaum committed
150 151
  let of_gr ?domain ?(grewpy=false) gr_string =
    handle ~name:"Graph.of_gr" (fun () -> Grew_graph.G_graph.build ?domain ~grewpy (Grew_loader.Parser.gr gr_string)) ()
152

bguillaum's avatar
bguillaum committed
153 154
  let of_conll ?domain conll =
    handle ~name:"Graph.of_conll" (fun () -> Grew_graph.G_graph.of_conll ?domain conll) ()
155

156 157
  let of_pst ?domain pst_string =
    handle ~name:"of_pst"
158
      (fun () ->
159 160 161 162 163 164 165 166 167 168
        let pst_ast = Grew_loader.Parser.phrase_structure_tree pst_string in
        (Grew_graph.G_graph.of_pst ?domain pst_ast)
      ) ()

  let sentence_of_pst ?domain pst_string =
    handle ~name:"of_pst"
      (fun () ->
        let pst_ast = Grew_loader.Parser.phrase_structure_tree pst_string in
        let word_list = Grew_ast.Ast.word_list pst_ast in
        Sentence.fr_clean_spaces (String.concat " " word_list)
169 170
      ) ()

bguillaum's avatar
bguillaum committed
171 172
  let of_brown ?domain ?sentid brown =
    handle ~name:"Graph.of_brown" (fun () -> Grew_graph.G_graph.of_brown ?domain ?sentid brown) ()
bguillaum's avatar
bguillaum committed
173

bguillaum's avatar
bguillaum committed
174 175
  let to_dot ?domain ?main_feat ?(deco=Grew_graph.G_deco.empty) graph =
    handle ~name:"Graph.to_dot" (fun () -> Grew_graph.G_graph.to_dot ?domain ?main_feat graph ~deco) ()
bguillaum's avatar
bguillaum committed
176

bguillaum's avatar
bguillaum committed
177 178
  let to_dep ?domain ?filter ?main_feat ?(deco=Grew_graph.G_deco.empty) graph =
    handle ~name:"Graph.to_dep" (fun () -> Grew_graph.G_graph.to_dep ?domain ?filter ?main_feat ~deco graph) ()
bguillaum's avatar
bguillaum committed
179

bguillaum's avatar
bguillaum committed
180 181
  let to_gr ?domain graph =
    handle ~name:"Graph.to_gr" (fun () -> Grew_graph.G_graph.to_gr ?domain graph) ()
bguillaum's avatar
bguillaum committed
182

bguillaum's avatar
bguillaum committed
183 184
  let to_conll_string ?domain graph =
    handle ~name:"Graph.to_conll_string" (fun () -> Grew_graph.G_graph.to_conll_string ?domain graph) ()
bguillaum's avatar
bguillaum committed
185

bguillaum's avatar
bguillaum committed
186 187 188 189 190
  let to_sentence ?main_feat gr =
    handle ~name:"Graph.to_sentence"
      (fun () ->
        Grew_graph.G_graph.to_sentence ?main_feat gr
      ) ()
bguillaum's avatar
bguillaum committed
191

bguillaum's avatar
bguillaum committed
192
  let save_conll ?domain filename graph =
bguillaum's avatar
bguillaum committed
193 194
    handle ~name:"Graph.save_conll" (fun () ->
      let out_ch = open_out filename in
bguillaum's avatar
bguillaum committed
195
      fprintf out_ch "%s" (Grew_graph.G_graph.to_conll_string ?domain graph);
bguillaum's avatar
bguillaum committed
196
      close_out out_ch
bguillaum's avatar
bguillaum committed
197 198
    ) ()

bguillaum's avatar
bguillaum committed
199
  let search_pattern ?domain pattern graph = Grew_rule.Rule.match_in_graph ?domain pattern graph
bguillaum's avatar
bguillaum committed
200

201 202
  let node_matching pattern graph matching  = Grew_rule.Rule.node_matching pattern graph matching

bguillaum's avatar
bguillaum committed
203
end
204

bguillaum's avatar
bguillaum committed
205
(* ==================================================================================================== *)
206
(** {2 Graph Rewriting System} *)
bguillaum's avatar
bguillaum committed
207 208 209
(* ==================================================================================================== *)
module Grs = struct
  type t = Grew_grs.Grs.t
210

bguillaum's avatar
bguillaum committed
211
  let empty = Grew_grs.Grs.empty
212

bguillaum's avatar
bguillaum committed
213 214 215 216
  let load file =
    handle ~name:"Grs.load" ~file
      (fun () ->
        if not (Sys.file_exists file)
217
        then raise (File_not_found file)
bguillaum's avatar
bguillaum committed
218 219
        else Grew_grs.Grs.build file
      ) ()
220

bguillaum's avatar
bguillaum committed
221 222 223 224 225
  let get_sequence_names grs =
    handle ~name:"Grs.get_sequence_names"
      (fun () ->
        Grew_grs.Grs.sequence_names grs
      ) ()
226

bguillaum's avatar
bguillaum committed
227 228 229 230 231 232 233
  let build_html_doc ?(corpus=false) dir grs =
    handle ~name:"Grs.build_doc [with Dep2pict]"
      (fun () ->
        Grew_html.Html_doc.build ~corpus ~dep:true dir grs;

        (* draw pattern graphs for all rules and all filters *)
        let fct module_ rule_ =
bguillaum's avatar
bguillaum committed
234
          let dep_code = Grew_rule.Rule.to_dep ?domain:(Grew_grs.Grs.get_domain grs) rule_ in
bguillaum's avatar
bguillaum committed
235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
          let dep_png_file = sprintf "%s/%s_%s-patt.png" dir module_ (Grew_rule.Rule.get_name rule_) in
          let d2p = Dep2pict.Dep2pict.from_dep ~dep:dep_code in
          Dep2pict.Dep2pict.save_png ~filename:dep_png_file d2p in
        Grew_grs.Grs.rule_iter fct grs;
        Grew_grs.Grs.filter_iter fct grs
      ) ()

  let get_domain grs = Grew_grs.Grs.get_domain grs
end

(* ==================================================================================================== *)
(** {2 Rewrite} *)
(* ==================================================================================================== *)
module Rewrite = struct
  type display = Libgrew_types.rew_display
  type history = Grew_grs.Rewrite_history.t

252 253 254
  let set_max_depth_det value = Grew_rule.Rule.set_max_depth_det value
  let set_max_depth_non_det value = Grew_rule.Rule.set_max_depth_non_det value

bguillaum's avatar
bguillaum committed
255 256
  let set_debug_loop () = Grew_rule.Rule.set_debug_loop ()

bguillaum's avatar
bguillaum committed
257 258 259 260 261 262 263 264
  let display ~gr ~grs ~seq =
    handle ~name:"Rewrite.display" (fun () -> Grew_grs.Grs.build_rew_display grs seq gr) ()

  let set_timeout t = Grew_base.Timeout.timeout := t

  let rewrite ~gr ~grs ~seq =
    handle ~name:"Rewrite.rewrite" (fun () -> Grew_grs.Grs.rewrite grs seq gr) ()

265 266 267
  let get_graphs rh =
    handle ~name:"Rewrite.get_graphs" (fun () -> Grew_grs.Rewrite_history.get_graphs rh) ()

bguillaum's avatar
bguillaum committed
268 269 270 271 272 273 274 275 276
  let is_empty rh =
    handle ~name:"Rewrite.is_empty" (fun () -> Grew_grs.Rewrite_history.is_empty rh) ()

  let num_sol rh =
    handle ~name:"Rewrite.num_sol" (fun () -> Grew_grs.Rewrite_history.num_sol rh) ()

  let write_stat filename rew_hist =
    handle ~name:"Rewrite.write_stat" (fun () -> Grew_html.Gr_stat.save filename (Grew_html.Gr_stat.from_rew_history rew_hist)) ()

bguillaum's avatar
bguillaum committed
277 278
  let write_annot ?domain ~title static_dir annot_dir base_name_rew_hist_list =
    handle ~name:"Rewrite.write_annot" (fun () -> Grew_html.Html_annot.build ?domain ~title static_dir annot_dir base_name_rew_hist_list) ()
bguillaum's avatar
bguillaum committed
279 280 281 282

  let save_index ~dirname ~base_names =
    handle ~name:"Rewrite.save_index" (fun () ->
      let out_ch = open_out (Filename.concat dirname "index") in
283
      Array.iter (fun f -> fprintf out_ch "%s\n" f) base_names;
bguillaum's avatar
bguillaum committed
284
      close_out out_ch
285 286
    ) ()

bguillaum's avatar
bguillaum committed
287 288
  let save_gr ?domain base rew_hist =
    handle ~name:"Rewrite.save_gr" (fun () -> Grew_grs.Rewrite_history.save_gr ?domain base rew_hist) ()
bguillaum's avatar
bguillaum committed
289

bguillaum's avatar
bguillaum committed
290 291
  let save_conll ?domain base rew_hist =
    handle ~name:"Rewrite.save_conll" (fun () -> Grew_grs.Rewrite_history.save_conll ?domain base rew_hist) ()
bguillaum's avatar
bguillaum committed
292

bguillaum's avatar
bguillaum committed
293 294
  let save_full_conll ?domain base rew_hist =
    handle ~name:"Rewrite.save_full_conll" (fun () -> Grew_grs.Rewrite_history.save_full_conll ?domain base rew_hist) ()
bguillaum's avatar
bguillaum committed
295

bguillaum's avatar
bguillaum committed
296 297
  let save_det_gr ?domain base rew_hist =
    handle ~name:"Rewrite.save_det_gr" (fun () -> Grew_grs.Rewrite_history.save_det_gr ?domain base rew_hist) ()
bguillaum's avatar
bguillaum committed
298

bguillaum's avatar
bguillaum committed
299 300
  let save_det_conll ?domain ?header base rew_hist =
    handle ~name:"Rewrite.save_det_conll" (fun () -> Grew_grs.Rewrite_history.save_det_conll ?domain ?header base rew_hist) ()
bguillaum's avatar
bguillaum committed
301

bguillaum's avatar
bguillaum committed
302 303
  let det_dep_string ?domain rew_hist =
    handle ~name:"Rewrite.det_dep_string" (fun () -> Grew_grs.Rewrite_history.det_dep_string ?domain rew_hist) ()
bguillaum's avatar
bguillaum committed
304

bguillaum's avatar
bguillaum committed
305 306
  let conll_dep_string ?domain ?keep_empty_rh rew_hist =
    handle ~name:"Rewrite.conll_dep_string" (fun () -> Grew_grs.Rewrite_history.conll_dep_string ?domain ?keep_empty_rh rew_hist) ()
bguillaum's avatar
bguillaum committed
307

bguillaum's avatar
bguillaum committed
308
  let write_html ?domain ?(no_init=false) ?(out_gr=false) ?filter ?main_feat ?dot ~header ?graph_file rew_hist output_base =
bguillaum's avatar
bguillaum committed
309 310
    handle ~name:"Rewrite.write_html" (fun () ->
      ignore (
bguillaum's avatar
bguillaum committed
311
        Grew_html.Html_rh.build ?domain ?filter ?main_feat ?dot ~out_gr ~init_graph: (not no_init) ~header ?graph_file output_base rew_hist
bguillaum's avatar
bguillaum committed
312 313 314
      )
    ) ()

bguillaum's avatar
bguillaum committed
315
  let error_html ?domain ?(no_init=false) ?main_feat ?dot ~header msg ?init output_base =
bguillaum's avatar
bguillaum committed
316 317
    handle ~name:"Rewrite.error_html" (fun () ->
      ignore (
bguillaum's avatar
bguillaum committed
318
        Grew_html.Html_rh.error ?domain ?main_feat ?dot ~init_graph: (not no_init) ~header output_base msg init
bguillaum's avatar
bguillaum committed
319 320 321 322 323 324 325
      )
    ) ()

  let make_index ~title ~grs_file ~html ~grs ~seq ~input_dir ~output_dir ~base_names  =
    handle ~name:"Rewrite.make_index" (fun () ->
      let init = Grew_html.Corpus_stat.empty grs seq in
      let corpus_stat =
326
        Array.fold_left
bguillaum's avatar
bguillaum committed
327 328 329 330 331
          (fun acc base_name ->
            Grew_html.Corpus_stat.add_gr_stat base_name (Grew_html.Gr_stat.load (Filename.concat output_dir (base_name^".stat"))) acc
          ) init base_names in
      Grew_html.Corpus_stat.save_html title grs_file input_dir output_dir corpus_stat
    ) ()
bguillaum's avatar
bguillaum committed
332

bguillaum's avatar
bguillaum committed
333 334
  let html_sentences ~title = handle ~name:"Rewrite.html_sentences" (fun () -> Grew_html.Html_sentences.build ~title) ()
end