Skip to content
GitLab
Commit 4289282b authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files

new “grew grep” mode (JSON output)

parent 56558a7c
Hide whitespace changes
Inline Side-by-side
.merlin
View file @ 4289282b
S src
B _build/src
PKG yojson log svg conll dep2pict libgrew_dev lablgtk2 lablwebkit
PKG yojson log svg conll dep2pict libgrew_dev lablgtk2 lablwebkit containers
src/grew_args.ml
View file @ 4289282b
......@@ -28,7 +28,7 @@ module Grew_args = struct
let quiet = ref false
let timeout = ref None
let (pattern : string option ref) = ref None
let (node_id : string option ref) = ref None
let html = ref false
let help () = List.iter (fun x -> Printf.printf "%s\n" x) [
"----------------------------------------------------------";
......@@ -66,12 +66,11 @@ module Grew_args = struct
"----------------------------------------------------------";
"usage: grew grep [<args>]";
"";
"This subcommand search for a patten in a corpus.";
"This subcommand search for a pattern in a corpus.";
"";
"args are optionnal and can be change in the GUI:";
" -pattern <pat> The pattern to search for";
" -i <corp> The input data";
" -node_id <id> One of the node of the pattern";
"";
"For additional information, see http://grew.loria.fr";
"----------------------------------------------------------";
......@@ -102,7 +101,7 @@ module Grew_args = struct
| "-o" :: file :: args -> output_file := Some file; loop args
| "-strat" :: s :: args -> strat := s; loop args
| "-pattern" :: file :: args -> pattern := Some file; loop args
| "-node_id" :: id :: args -> node_id := Some id; loop args
| "-html" :: args -> html := true; loop args
| "-timeout" :: f :: args -> timeout := Some (float_of_string f); Rewrite.set_timeout (Some (float_of_string f)); loop args
| "-max_depth_det" :: i :: args -> Log.warning "max_depth_det not implemented, skip the arg"; loop args
......@@ -113,8 +112,8 @@ module Grew_args = struct
| "-safe_commands" :: args -> Libgrew.set_safe_commands true; loop args
| "-debug" :: args -> Libgrew.set_debug_mode true; loop args
| "-debug_loop" :: args -> Rewrite.set_debug_loop ()
| "-dep_dir" :: dir :: args -> dep_dir := Some dir
| "-debug_loop" :: args -> Rewrite.set_debug_loop (); loop args
| "-dep_dir" :: dir :: args -> dep_dir := Some dir; loop args
| x -> Log.fwarning "Ignored arguments: %s" (String.concat " " x)
......
src/grew_corpus.ml
View file @ 4289282b
......@@ -71,11 +71,10 @@ let transform () =
(* -------------------------------------------------------------------------------- *)
let grep () = handle
(fun () ->
match (!Grew_args.input_data, !Grew_args.pattern, !Grew_args.node_id) with
| (None,_,_) -> Log.message "No input data specified: use -i option"; exit 1
| (_,None,_) -> Log.message "No pattern file specified: use -pattern option"; exit 1;
| (_,_,None) -> Log.message "No node_id specified: use -node_id option"; exit 1;
| (Some data_file, Some pattern_file, Some node_id) ->
match (!Grew_args.input_data, !Grew_args.pattern) with
| (None,_) -> Log.message "No input data specified: use -i option"; exit 1
| (_,None) -> Log.message "No pattern file specified: use -pattern option"; exit 1;
| (Some data_file, Some pattern_file) ->
let domain = match !Grew_args.grs with
| None -> None
......@@ -83,10 +82,6 @@ let transform () =
let pattern = Pattern.load ?domain pattern_file in
if not (List.mem node_id (Pattern.pid_name_list pattern))
then (Log.fmessage "The requested node_id \"%s\" is not defined in the pattern" node_id; exit 1)
else
(* get the array of graphs to explore *)
let graph_array = Corpus.get_graphs ?domain data_file in
......@@ -97,30 +92,49 @@ let transform () =
(* printf "%s\n" (String.concat "_" (Pattern.pid_name_list pattern)); *)
let pattern_ids = Pattern.pid_name_list pattern in
Array.iter
(fun (name,graph) ->
let matchings = Graph.search_pattern ?domain pattern graph in
List.iter
(fun matching ->
let node_matching = Graph.node_matching pattern graph matching in
let graph_node_ids = List.map snd node_matching in
let deco = Deco.build pattern matching in
let html = Graph.to_sentence ~deco graph in
let id = sprintf "%s__%s"
name
(String.concat "_" (List.map2 (sprintf "%s:%g") pattern_ids graph_node_ids)) in
(* let graph_node_id = List.assoc node_id node_matching in *)
(* printf "%s\t%g\n" name graph_node_id; *)
printf "%s@@%s\n" id html;
(match !Grew_args.dep_dir with
| None -> ()
| Some dir ->
let dep = Graph.to_dep ~deco graph in
let filename = sprintf "%s.dep" id in
let out_ch = open_out (Filename.concat dir filename) in
fprintf out_ch "%s" dep;
close_out out_ch
)
) matchings
) graph_array
let final_json =
Array.fold_left
(fun acc (name,graph) ->
let matchings = Graph.search_pattern ?domain pattern graph in
List.fold_left
(fun acc2 matching ->
let node_matching = Graph.node_matching pattern graph matching in
let graph_node_ids = List.map snd node_matching in
let deco = Deco.build pattern matching in
(* write the dep file if needed *)
let dep_file =
match !Grew_args.dep_dir with
| None -> None
| Some dir ->
let id = sprintf "%s__%s"
name
(String.concat "_" (List.map2 (sprintf "%s:%g") pattern_ids graph_node_ids)) in
let dep = Graph.to_dep ~deco graph in
let filename = Filename.concat dir (sprintf "%s.dep" id) in
let out_ch = open_out filename in
fprintf out_ch "%s" dep;
close_out out_ch;
Some filename in
let json_matching = `Assoc (List.map2 (fun pid gid -> (pid, `String (sprintf "%g" gid))) pattern_ids graph_node_ids) in
let opt_list = [
Some ("sent_id", `String name);
Some ("matching", json_matching);
(
if !Grew_args.html
then Some ("html", `String (Graph.to_sentence ~deco graph))
else None
);
(
match dep_file with
| None -> None
| Some f -> Some ("dep_file", `String f)
)
] in
let json = `Assoc (CCList.filter_map (fun x -> x) opt_list) in
json :: acc2
) acc matchings
) [] graph_array in
Printf.printf "%s\n" (Yojson.pretty_to_string (`List final_json))
) ()
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment