Commit 4f467ce0 authored by Bruno Guillaume's avatar Bruno Guillaume

add pivot management for export in grew-match

parent 6106f058
......@@ -195,6 +195,7 @@ module Ast = struct
let empty_basic = { pat_nodes=[]; pat_edges=[]; pat_const=[]; }
type pattern = {
pivot: Id.name option;
pat_glob: string list;
pat_pos: basic;
pat_negs: basic list;
......@@ -245,10 +246,16 @@ module Ast = struct
{basic with pat_nodes=new_pat_nodes}
let complete_pattern pattern =
let pivot = match pattern.pat_pos.pat_nodes with
| (first_node,_) :: _ -> Some (first_node.node_id)
| [] ->
match pattern.pat_pos.pat_edges with
| (first_edge,_) :: _ -> Some (first_edge.src)
| [] -> None in
let new_pat_pos = complete_basic [] pattern.pat_pos in
let aux = new_pat_pos.pat_nodes in
let new_pat_negs = List.map (complete_basic aux) pattern.pat_negs in
{ pattern with pat_pos = new_pat_pos; pat_negs = new_pat_negs;}
{ pattern with pivot; pat_pos = new_pat_pos; pat_negs = new_pat_negs;}
type concat_item =
| Qfn_or_lex_item of pointed
......
......@@ -132,6 +132,7 @@ module Ast : sig
val empty_basic: basic
type pattern = {
pivot: Id.name option;
pat_glob: string list;
pat_pos: basic;
pat_negs: basic list;
......
......@@ -33,13 +33,18 @@ end (* module P_deco *)
(* ================================================================================ *)
module P_graph = struct
type t = P_node.t Pid_map.t
type map = P_node.t Pid_map.t
let empty = Pid_map.empty
type t = {
map: map;
pivot: Pid.t option;
}
let find = Pid_map.find
let empty = { map = Pid_map.empty; pivot = None }
let pid_name_list t = Pid_map.fold (fun _ node acc -> (P_node.get_name node)::acc) t []
let find pid t = Pid_map.find pid t.map
let pid_name_list t = Pid_map.fold (fun _ node acc -> (P_node.get_name node)::acc) t.map []
let to_json ?domain t =
`List (
......@@ -49,7 +54,7 @@ module P_graph = struct
("id", `String (Pid.to_string pid));
("node", P_node.to_json ?domain p_node)
]) :: acc
) t []
) t.map []
)
(* -------------------------------------------------------------------------------- *)
......@@ -62,7 +67,9 @@ module P_graph = struct
| Some new_node -> Some (Pid_map.add id_src new_node map)
(* -------------------------------------------------------------------------------- *)
let build ?domain lexicons (full_node_list : Ast.node list) full_edge_list =
let build ?domain lexicons pivot basic_ast =
let (full_node_list : Ast.node list) = basic_ast.Ast.pat_nodes
and full_edge_list = basic_ast.Ast.pat_edges in
(* NB: insert searches for a previous node with the Same name and uses unification rather than constraint *)
(* NB: insertion of new node at the end of the list: not efficient but graph building is not the hard part. *)
......@@ -91,7 +98,7 @@ module P_graph = struct
(fun i acc elt -> Pid_map.add (Pid.Pos i) elt acc)
Pid_map.empty node_list in
let (map : t) =
let (map : map) =
List.fold_left
(fun acc (ast_edge, loc) ->
let i1 = Id.build ~loc ast_edge.Ast.src pos_table in
......@@ -104,15 +111,16 @@ module P_graph = struct
(Loc.to_string loc)
)
) map_without_edges full_edge_list in
(map, pos_table)
let pivot = CCOpt.map (fun x -> Pid.Pos (Id.build x pos_table)) pivot in
({map; pivot}, pos_table)
(* -------------------------------------------------------------------------------- *)
(* a type for extension of graph (a former graph exists):
in grew the former is a positive basic and an extension is a negative basic ("without") *)
type extension = {
ext_map: P_node.t Pid_map.t; (* node description for new nodes and for edge "Old -> New" *)
old_map: P_node.t Pid_map.t; (* a partial map for new constraints on old nodes "Old [...]" *)
ext_map: map; (* node description for new nodes and for edge "Old -> New" *)
old_map: map; (* a partial map for new constraints on old nodes "Old [...]" *)
}
(* -------------------------------------------------------------------------------- *)
......@@ -188,7 +196,7 @@ module P_graph = struct
else Pid_set.add tar acc2
else Pid_set.add tar acc2
) acc (P_node.get_next node)
) graph Pid_set.empty in
) graph.map Pid_set.empty in
let roots =
Pid_map.fold
......@@ -196,7 +204,7 @@ module P_graph = struct
if Pid_set.mem id not_root
then acc
else id::acc
) graph [] in
) graph.map [] in
(!tree_prop, roots)
......@@ -210,11 +218,14 @@ module G_deco = struct
type highlighted_feat = string * string option
type t = {
nodes: (Gid.t * (string * highlighted_feat list)) list; (* a list of (node, (pattern_id, features of nodes implied in the step)) *)
edges: (Gid.t * G_edge.t * Gid.t) list; (* an edge list *)
(* a list of (node, (pattern_id, features of nodes implied in the step)) *)
nodes: (Gid.t * (string * highlighted_feat list)) list;
(* an edge list *)
edges: (Gid.t * G_edge.t * Gid.t) list;
pivot: Gid.t option;
}
let empty = {nodes=[]; edges=[]}
let empty = {nodes=[]; edges=[]; pivot=None;}
end (* module G_deco *)
(* ================================================================================ *)
......@@ -862,9 +873,14 @@ module G_graph = struct
let esc s = Str.global_replace (Str.regexp "<") "&lt;" s
let to_sentence ?main_feat ?(deco=G_deco.empty) graph =
exception No_pivot
let to_sentence ?(only_pivot=false) ?main_feat ?(deco=G_deco.empty) graph =
let high_list = match (only_pivot, deco.pivot) with
| (true, None) -> raise No_pivot
| (true, Some i) -> [i,("pivot", [])]
| (false, _) -> deco.nodes in
let is_highlighted_gid gid = List.mem_assoc gid deco.nodes in
let is_highlighted_gid gid = List.mem_assoc gid high_list in
let inside fusion_item gid =
let first = Gid_map.find fusion_item.first graph.map in
......@@ -875,7 +891,7 @@ module G_graph = struct
| _ -> false in
let is_highlighted_fusion_item fusion_item =
List.exists (fun (gid,_) -> inside fusion_item gid) deco.nodes in
List.exists (fun (gid,_) -> inside fusion_item gid) high_list in
let nodes = Gid_map.fold (fun id elt acc -> (id,elt)::acc) graph.map [] in
let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in
......
......@@ -36,8 +36,11 @@ module G_deco: sig
type highlighted_feat = string * string option
type t = {
nodes: (Gid.t * (string * highlighted_feat list)) list; (* a list of (node, (pattern_id, features of nodes implied in the step)) *)
edges: (Gid.t * G_edge.t * Gid.t) list; (* an edge list *)
(* a list of (node, (pattern_id, features of nodes implied in the step)) *)
nodes: (Gid.t * (string * highlighted_feat list)) list;
(* an edge list *)
edges: (Gid.t * G_edge.t * Gid.t) list;
pivot: Gid.t option;
}
val empty:t
......@@ -45,7 +48,12 @@ end (* module G_deco *)
(* ================================================================================ *)
module P_graph: sig
type t = P_node.t Pid_map.t
type map = P_node.t Pid_map.t
type t = {
map: map;
pivot: Pid.t option;
}
val empty: t
......@@ -66,8 +74,8 @@ module P_graph: sig
val build:
?domain:Domain.t ->
Lexicons.t ->
Ast.node list ->
Ast.edge list ->
Id.name option ->
Ast.basic ->
(t * Id.table)
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
......@@ -195,7 +203,7 @@ module G_graph: sig
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val to_gr: t -> string
val to_dot: ?main_feat:string -> ?get_url:(string -> string option) -> ?deco:G_deco.t -> t -> string
val to_sentence: ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_sentence: ?only_pivot: bool -> ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_dep: ?filter: (string -> bool) -> ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_conll: t -> Conll.t
val to_conll_string: ?cupt:bool -> t -> string
......
......@@ -288,7 +288,7 @@ rule:
| Some l -> l @ final_lexicons
| None -> final_lexicons in
{ Ast.rule_id = fst id_loc;
pattern = Ast.complete_pattern { Ast.pat_glob = ["TODO"]; Ast.pat_pos = p; Ast.pat_negs = n };
pattern = Ast.complete_pattern { Ast.pivot=None; Ast.pat_glob = ["TODO"]; Ast.pat_pos = p; Ast.pat_negs = n };
commands = cmds;
lexicon_info = lexicons;
rule_doc = begin match doc with Some d -> d | None -> [] end;
......@@ -725,6 +725,7 @@ concat_item:
pattern:
| g=option (glob_decl) p=option(pos_item) n=list(neg_item) EOF
{ Ast.complete_pattern {
Ast.pivot=None;
Ast.pat_glob = (match g with None -> [] | Some x -> x);
Ast.pat_pos = (match p with None -> Ast.empty_basic | Some x -> x);
Ast.pat_negs = n;
......
......@@ -270,9 +270,9 @@ module Rule = struct
("constraints", `List (List.map (const_to_json ?domain) basic.constraints));
]
let build_pos_basic ?domain lexicons basic_ast =
let build_pos_basic ?domain lexicons pivot basic_ast =
let (graph, pos_table) =
P_graph.build ?domain lexicons basic_ast.Ast.pat_nodes basic_ast.Ast.pat_edges in
P_graph.build ?domain lexicons pivot basic_ast in
(
{
graph = graph;
......@@ -375,7 +375,7 @@ module Rule = struct
let filters = Pid_map.fold (fun id node acc -> Filter (id, P_node.get_fs node) :: acc) extension.P_graph.old_map [] in
{
graph = extension.P_graph.ext_map;
graph = {P_graph.map = extension.P_graph.ext_map; pivot = None };
constraints = filters @ List.map (build_neg_constraint ?domain lexicons pos_table neg_table) basic_ast.Ast.pat_const ;
}
......@@ -385,7 +385,7 @@ module Rule = struct
Massoc_pid.fold
(fun acc2 _ edge -> (P_edge.get_id edge)::acc2)
acc (P_node.get_next node)
) basic.graph []
) basic.graph.P_graph.map []
(* a [pattern] is described by the positive basic and a list of negative basics. *)
type pattern = {
......@@ -431,7 +431,7 @@ module Rule = struct
(Pid.to_id id) (P_node.get_name node) (P_fs.to_dep (P_node.get_fs node))
)
:: acc
) pos_basic.graph [] in
) pos_basic.graph.P_graph.map [] in
(* nodes are sorted to appear in the same order in dep picture and in input file *)
let sorted_nodes = List.sort (fun (n1,_) (n2,_) -> P_node.compare_pos n1 n2) nodes in
......@@ -461,7 +461,7 @@ module Rule = struct
(P_edge.to_string ?domain edge)
)
(P_node.get_next node)
) pos_basic.graph;
) pos_basic.graph.P_graph.map;
List.iteri
(fun i cst ->
......@@ -515,7 +515,7 @@ module Rule = struct
let pattern = Ast.normalize_pattern rule_ast.Ast.pattern in
let (pos, pos_table) =
try build_pos_basic ?domain lexicons pattern.Ast.pat_pos
try build_pos_basic ?domain lexicons pattern.Ast.pivot pattern.Ast.pat_pos
with P_fs.Fail_unif ->
Error.build ~loc:rule_ast.Ast.rule_loc
"[Rule.build] in rule \"%s\": feature structures declared in the \"match\" clause are inconsistent"
......@@ -540,7 +540,7 @@ module Rule = struct
let build_pattern ?domain ?(lexicons=[]) pattern_ast =
let n_pattern = Ast.normalize_pattern pattern_ast in
let (pos, pos_table) =
try build_pos_basic ?domain lexicons n_pattern.Ast.pat_pos
try build_pos_basic ?domain lexicons n_pattern.Ast.pivot n_pattern.Ast.pat_pos
with P_fs.Fail_unif -> Error.build "feature structures declared in the \"match\" clause are inconsistent " in
let negs =
List_.try_map
......@@ -551,9 +551,9 @@ module Rule = struct
(* ====================================================================== *)
type matching = {
n_match: Gid.t Pid_map.t; (* partial fct: pattern nodes |--> graph nodes *)
n_match: Gid.t Pid_map.t; (* partial fct: pattern nodes |--> graph nodes *)
e_match: (string*(Gid.t*G_edge.t*Gid.t)) list; (* edge matching: edge ident |--> (src,label,tar) *)
l_param: Lexicons.t; (* *)
l_param: Lexicons.t; (* *)
}
let to_python pattern graph m =
......@@ -590,9 +590,12 @@ module Rule = struct
(fun pid gid acc ->
let pnode = P_graph.find pid pattern.pos.graph in
let pattern_feat_list = P_fs.feat_list (P_node.get_fs pnode) in
(gid, (P_node.get_name pnode, pattern_feat_list)) ::acc
(gid, (P_node.get_name pnode, pattern_feat_list)) :: acc
) matching.n_match [];
G_deco.edges = List.fold_left (fun acc (_,edge) -> edge::acc) [] matching.e_match;
G_deco.pivot = match pattern.pos.graph.pivot with
| None -> None
| Some pid -> try Some (Pid_map.find pid matching.n_match) with Not_found -> None
}
let find cnode ?loc (matching, created_nodes) =
......@@ -624,6 +627,7 @@ module Rule = struct
(find src_cn (matching, created_nodes), edge, find tar_cn (matching, created_nodes)) :: acc
| _ -> acc
) [] commands;
pivot=None;
}
exception Fail
......@@ -643,7 +647,7 @@ module Rule = struct
let init ?lexicons basic =
let roots = P_graph.roots basic.graph in
let node_list = Pid_map.fold (fun pid _ acc -> pid::acc) basic.graph [] in
let node_list = Pid_map.fold (fun pid _ acc -> pid::acc) basic.graph.P_graph.map [] in
(* put all roots in the front of the list to speed up the algo *)
let sorted_node_list =
......@@ -906,7 +910,7 @@ module Rule = struct
let unmatched_nodes =
Pid_map.fold
(fun pid _ acc -> match pid with Pid.Neg _ -> pid::acc | _ -> acc)
neg_graph [] in
neg_graph.P_graph.map [] in
let unmatched_edges =
Pid_map.fold
(fun pid node acc ->
......@@ -923,7 +927,7 @@ module Rule = struct
(* Massoc.fold_left *)
(* (fun acc2 pid_next p_edge -> (pid, p_edge, pid_next) :: acc2) *)
(* acc (P_node.get_next node) *)
) neg_graph [] in
) neg_graph.P_graph.map [] in
{
sub = sub;
unmatched_nodes = unmatched_nodes;
......
......@@ -223,10 +223,10 @@ module Graph = struct
let to_conll_string ?cupt graph =
Libgrew.handle ~name:"Graph.to_conll_string" (fun () -> Grew_graph.G_graph.to_conll_string ?cupt graph) ()
let to_sentence ?main_feat ?deco gr =
let to_sentence ?only_pivot ?main_feat ?deco gr =
Libgrew.handle ~name:"Graph.to_sentence"
(fun () ->
Grew_graph.G_graph.to_sentence ?main_feat ?deco gr
Grew_graph.G_graph.to_sentence ?only_pivot ?main_feat ?deco gr
) ()
let save_conll filename graph =
......
......@@ -98,7 +98,7 @@ module Graph : sig
val sentence_of_pst: ?domain:Domain.t -> string -> string
val to_sentence: ?main_feat:string -> ?deco:Deco.t -> t -> string
val to_sentence: ?only_pivot: bool -> ?main_feat:string -> ?deco:Deco.t -> t -> string
val to_dot : ?main_feat:string -> ?deco:Deco.t -> ?get_url:(string -> string option) -> t -> string
......
Markdown is supported
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