Commit 0c0a2e17 authored by Bruno Guillaume's avatar Bruno Guillaume

/!\ Put domain as a new field in graph definition

parent 13798ca4
...@@ -230,14 +230,16 @@ module G_graph = struct ...@@ -230,14 +230,16 @@ module G_graph = struct
} }
type t = { type t = {
domain: Domain.t option;
meta: string list; (* meta-informations *) meta: string list; (* meta-informations *)
map: G_node.t Gid_map.t; (* node description *) map: G_node.t Gid_map.t; (* node description *)
fusion: fusion_item list; (* the list of fusion word considered in UD conll *) fusion: fusion_item list; (* the list of fusion word considered in UD conll *)
highest_index: int; (* the next free integer index *) highest_index: int; (* the next free integer index *)
} }
let empty = {meta=[]; map=Gid_map.empty; fusion=[]; highest_index=0; } let empty = { domain=None; meta=[]; map=Gid_map.empty; fusion=[]; highest_index=0; }
let get_domain t = t.domain
let get_highest g = g.highest_index let get_highest g = g.highest_index
...@@ -251,7 +253,8 @@ module G_graph = struct ...@@ -251,7 +253,8 @@ module G_graph = struct
Gid_map.fold (fun gid _ acc -> fct gid acc) t.map init Gid_map.fold (fun gid _ acc -> fct gid acc) t.map init
(* is there an edge e out of node i ? *) (* is there an edge e out of node i ? *)
let edge_out ?domain graph node_id label_cst = let edge_out graph node_id label_cst =
let domain = get_domain graph in
let node = Gid_map.find node_id graph.map in let node = Gid_map.find node_id graph.map in
Massoc_gid.exists (fun _ e -> Label_cst.match_ ?domain label_cst e) (G_node.get_next node) Massoc_gid.exists (fun _ e -> Label_cst.match_ ?domain label_cst e) (G_node.get_next node)
...@@ -318,7 +321,13 @@ module G_graph = struct ...@@ -318,7 +321,13 @@ module G_graph = struct
) )
) map_without_edges full_edge_list in ) map_without_edges full_edge_list in
{meta=gr_ast.Ast.meta; map=map; fusion = []; highest_index = (List.length full_node_list) -1} {
domain;
meta=gr_ast.Ast.meta;
map;
fusion = [];
highest_index = (List.length full_node_list) -1
}
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let of_conll ?domain conll = let of_conll ?domain conll =
...@@ -371,7 +380,13 @@ module G_graph = struct ...@@ -371,7 +380,13 @@ module G_graph = struct
) )
) conll.Conll.multiwords in ) conll.Conll.multiwords in
{meta = conll.Conll.meta; map=map_with_edges; fusion; highest_index= (List.length sorted_lines) -1 } {
domain;
meta = conll.Conll.meta;
map=map_with_edges;
fusion;
highest_index= (List.length sorted_lines) -1
}
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
(** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/." *) (** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/." *)
...@@ -428,10 +443,16 @@ module G_graph = struct ...@@ -428,10 +443,16 @@ module G_graph = struct
|> (Gid_map.add n1 (G_node.set_succ n2 node1)) |> (Gid_map.add n1 (G_node.set_succ n2 node1))
|> (Gid_map.add n2 (G_node.set_prec n1 node2)) in |> (Gid_map.add n2 (G_node.set_prec n1 node2)) in
{meta=[]; map=prec_loop map (List.rev !leaf_list); fusion = []; highest_index = !cpt} {
domain;
meta=[];
map=prec_loop map (List.rev !leaf_list);
fusion = [];
highest_index = !cpt
}
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let del_edge ?domain ?edge_ident loc graph id_src label id_tar = let del_edge ?edge_ident loc graph id_src label id_tar =
let node_src = let node_src =
try Gid_map.find id_src graph.map try Gid_map.find id_src graph.map
with Not_found -> with Not_found ->
...@@ -539,7 +560,8 @@ module G_graph = struct ...@@ -539,7 +560,8 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
(* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *) (* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *)
let shift_out loc ?domain strict src_gid tar_gid is_gid_local label_cst graph = let shift_out loc strict src_gid tar_gid is_gid_local label_cst graph =
let domain = get_domain graph in
let del_edges = ref [] and add_edges = ref [] in let del_edges = ref [] and add_edges = ref [] in
let src_node = Gid_map.find src_gid graph.map in let src_node = Gid_map.find src_gid graph.map in
...@@ -575,7 +597,8 @@ module G_graph = struct ...@@ -575,7 +597,8 @@ module G_graph = struct
) )
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let shift_in loc ?domain strict src_gid tar_gid is_gid_local label_cst graph = let shift_in loc strict src_gid tar_gid is_gid_local label_cst graph =
let domain = get_domain graph in
let del_edges = ref [] and add_edges = ref [] in let del_edges = ref [] and add_edges = ref [] in
let new_map = let new_map =
Gid_map.mapi Gid_map.mapi
...@@ -618,13 +641,14 @@ module G_graph = struct ...@@ -618,13 +641,14 @@ module G_graph = struct
) )
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let shift_edges loc ?domain strict src_gid tar_gid is_gid_local label_cst graph = let shift_edges loc strict src_gid tar_gid is_gid_local label_cst graph =
let (g1,de1,ae1) = shift_out loc ?domain strict src_gid tar_gid is_gid_local label_cst graph in let (g1,de1,ae1) = shift_out loc strict src_gid tar_gid is_gid_local label_cst graph in
let (g2,de2,ae2) = shift_in loc ?domain strict src_gid tar_gid is_gid_local label_cst g1 in let (g2,de2,ae2) = shift_in loc strict src_gid tar_gid is_gid_local label_cst g1 in
(g2, de1 @ de2, ae1 @ ae2) (g2, de1 @ de2, ae1 @ ae2)
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let set_feat ?loc ?domain graph node_id feat_name new_value = let set_feat ?loc graph node_id feat_name new_value =
let domain = get_domain graph in
let node = Gid_map.find node_id graph.map in let node = Gid_map.find node_id graph.map in
let new_node = let new_node =
match feat_name with match feat_name with
...@@ -635,7 +659,8 @@ module G_graph = struct ...@@ -635,7 +659,8 @@ module G_graph = struct
{ graph with map = Gid_map.add node_id new_node graph.map } { graph with map = Gid_map.add node_id new_node graph.map }
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let update_feat ?loc ?domain graph tar_id tar_feat_name item_list = let update_feat ?loc graph tar_id tar_feat_name item_list =
let domain = get_domain graph in
let strings_to_concat = let strings_to_concat =
List.map List.map
(function (function
...@@ -655,7 +680,7 @@ module G_graph = struct ...@@ -655,7 +680,7 @@ module G_graph = struct
| Concat_item.String s -> s | Concat_item.String s -> s
) item_list in ) item_list in
let new_feature_value = List_.to_string (fun s->s) "" strings_to_concat in let new_feature_value = List_.to_string (fun s->s) "" strings_to_concat in
(set_feat ?loc ?domain graph tar_id tar_feat_name new_feature_value, new_feature_value) (set_feat ?loc graph tar_id tar_feat_name new_feature_value, new_feature_value)
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let del_feat graph node_id feat_name = let del_feat graph node_id feat_name =
...@@ -665,7 +690,8 @@ module G_graph = struct ...@@ -665,7 +690,8 @@ module G_graph = struct
| None -> None | None -> None
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let to_gr ?domain graph = let to_gr graph =
let domain = get_domain graph in
let gr_id id = G_node.get_name id (Gid_map.find id graph.map) in let gr_id id = G_node.get_name id (Gid_map.find id graph.map) in
...@@ -763,7 +789,9 @@ module G_graph = struct ...@@ -763,7 +789,9 @@ module G_graph = struct
Sentence.fr_clean_spaces (loop None snodes) Sentence.fr_clean_spaces (loop None snodes)
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let to_dep ?domain ?filter ?main_feat ?(deco=G_deco.empty) graph = let to_dep ?filter ?main_feat ?(deco=G_deco.empty) graph =
let domain = get_domain graph in
let nodes = Gid_map.fold (fun id elt acc -> (id,elt)::acc) graph.map [] 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 let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in
...@@ -834,7 +862,9 @@ module G_graph = struct ...@@ -834,7 +862,9 @@ module G_graph = struct
in loop 0 in loop 0
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let to_conll ?domain graph = let to_conll graph =
let domain = get_domain graph in
let nodes = Gid_map.fold let nodes = Gid_map.fold
(fun gid node acc -> (gid,node)::acc) (fun gid node acc -> (gid,node)::acc)
graph.map [] in graph.map [] in
...@@ -906,12 +936,13 @@ module G_graph = struct ...@@ -906,12 +936,13 @@ module G_graph = struct
multiwords = []; (* multiwords are handled by _UD_* features *) multiwords = []; (* multiwords are handled by _UD_* features *)
} }
let to_conll_string ?domain graph = let to_conll_string graph =
let conll = to_conll ?domain graph in let conll = to_conll graph in
Conll.to_string (Conll.normalize_multiwords conll) Conll.to_string (Conll.normalize_multiwords conll)
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let to_dot ?domain ?main_feat ?(deco=G_deco.empty) graph = let to_dot ?main_feat ?(deco=G_deco.empty) graph =
let domain = get_domain graph in
let buff = Buffer.create 32 in let buff = Buffer.create 32 in
bprintf buff "digraph G {\n"; bprintf buff "digraph G {\n";
......
...@@ -94,8 +94,8 @@ module G_graph: sig ...@@ -94,8 +94,8 @@ module G_graph: sig
val get_highest: t -> int val get_highest: t -> int
(** [edge_out label_domain t id label_cst] returns true iff there is an out-edge from the node [id] with a label compatible with [label_cst] *) (** [edge_out t id label_cst] returns true iff there is an out-edge from the node [id] with a label compatible with [label_cst] *)
val edge_out: ?domain:Domain.t -> t -> Gid.t -> Label_cst.t -> bool val edge_out: t -> Gid.t -> Label_cst.t -> bool
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *) (* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Build functions *) (* Build functions *)
...@@ -123,7 +123,7 @@ module G_graph: sig ...@@ -123,7 +123,7 @@ module G_graph: sig
(** [del_edge ?edge_ident loc graph id_src label id_tar] removes the edge (id_src -[label]-> id_tar) from graph. (** [del_edge ?edge_ident loc graph id_src label id_tar] removes the edge (id_src -[label]-> id_tar) from graph.
Log.critical if the edge is not in graph *) Log.critical if the edge is not in graph *)
val del_edge: ?domain:Domain.t -> ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t option val del_edge: ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t option
(** [del_node graph id] remove node [id] from [graph], with all its incoming and outcoming edges. (** [del_node graph id] remove node [id] from [graph], with all its incoming and outcoming edges.
None is returned if [id] not defined in [graph]*) None is returned if [id] not defined in [graph]*)
...@@ -136,7 +136,6 @@ module G_graph: sig ...@@ -136,7 +136,6 @@ module G_graph: sig
(** shift all crown-edges ending in [src_gid] to edges ending in [tar_gid] *) (** shift all crown-edges ending in [src_gid] to edges ending in [tar_gid] *)
val shift_in: val shift_in:
Loc.t -> (* localization of the command *) Loc.t -> (* localization of the command *)
?domain:Domain.t ->
bool -> (* true iff strict rewriting *) bool -> (* true iff strict rewriting *)
Gid.t -> (* [src_gid] the source gid of the "shift_in" *) Gid.t -> (* [src_gid] the source gid of the "shift_in" *)
Gid.t -> (* [tar_gid] the target gid of the "shift_in" *) Gid.t -> (* [tar_gid] the target gid of the "shift_in" *)
...@@ -151,7 +150,6 @@ module G_graph: sig ...@@ -151,7 +150,6 @@ module G_graph: sig
(** shift all crown-edges starting from [src_gid] to edges starting from [tar_gid] *) (** shift all crown-edges starting from [src_gid] to edges starting from [tar_gid] *)
val shift_out: val shift_out:
Loc.t -> (* localization of the command *) Loc.t -> (* localization of the command *)
?domain:Domain.t ->
bool -> (* true iff strict rewriting *) bool -> (* true iff strict rewriting *)
Gid.t -> (* [src_gid] the source gid of the "shift_out" *) Gid.t -> (* [src_gid] the source gid of the "shift_out" *)
Gid.t -> (* [tar_gid] the target gid of the "shift_out" *) Gid.t -> (* [tar_gid] the target gid of the "shift_out" *)
...@@ -166,7 +164,6 @@ module G_graph: sig ...@@ -166,7 +164,6 @@ module G_graph: sig
(** move all incident crown-edges from/to [src_gid] are moved to incident edges on node [tar_gid] from graph *) (** move all incident crown-edges from/to [src_gid] are moved to incident edges on node [tar_gid] from graph *)
val shift_edges: val shift_edges:
Loc.t -> (* localization of the command *) Loc.t -> (* localization of the command *)
?domain:Domain.t ->
bool -> (* true iff strict rewriting *) bool -> (* true iff strict rewriting *)
Gid.t -> (* [src_gid] the source gid of the "shift_edges" *) Gid.t -> (* [src_gid] the source gid of the "shift_edges" *)
Gid.t -> (* [tar_gid] the target gid of the "shift_edges" *) Gid.t -> (* [tar_gid] the target gid of the "shift_edges" *)
...@@ -181,9 +178,9 @@ module G_graph: sig ...@@ -181,9 +178,9 @@ module G_graph: sig
(** [update_feat domain tar_id tar_feat_name concat_items] sets the feature of the node [tar_id] (** [update_feat domain tar_id tar_feat_name concat_items] sets the feature of the node [tar_id]
with feature name [tar_feat_name] to be the contatenation of values described by the [concat_items]. with feature name [tar_feat_name] to be the contatenation of values described by the [concat_items].
It returns both the new graph and the new feature value produced as the second element *) It returns both the new graph and the new feature value produced as the second element *)
val update_feat: ?loc:Loc.t -> ?domain:Domain.t -> t -> Gid.t -> string -> Concat_item.t list -> (t * string) val update_feat: ?loc:Loc.t -> t -> Gid.t -> string -> Concat_item.t list -> (t * string)
val set_feat: ?loc:Loc.t -> ?domain:Domain.t -> t -> Gid.t -> string -> string -> t val set_feat: ?loc:Loc.t -> t -> Gid.t -> string -> string -> t
(** [del_feat graph node_id feat_name] returns [graph] where the feat [feat_name] of [node_id] is deleted (** [del_feat graph node_id feat_name] returns [graph] where the feat [feat_name] of [node_id] is deleted
If the feature is not present, None is returned. *) If the feature is not present, None is returned. *)
...@@ -192,12 +189,12 @@ module G_graph: sig ...@@ -192,12 +189,12 @@ module G_graph: sig
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *) (* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Output functions *) (* Output functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *) (* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val to_gr: ?domain:Domain.t -> t -> string val to_gr: t -> string
val to_dot: ?domain:Domain.t -> ?main_feat:string -> ?deco:G_deco.t -> t -> string val to_dot: ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_sentence: ?main_feat:string -> ?deco:G_deco.t -> t -> string val to_sentence: ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_dep: ?domain:Domain.t -> ?filter: (string -> 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: ?domain:Domain.t -> t -> Conll.t val to_conll: t -> Conll.t
val to_conll_string: ?domain:Domain.t -> t -> string val to_conll_string: t -> string
end (* module G_graph *) end (* module G_graph *)
module Delta : sig module Delta : sig
......
...@@ -41,63 +41,63 @@ module Rewrite_history = struct ...@@ -41,63 +41,63 @@ module Rewrite_history = struct
| { good_nf = [] } -> 1 | { good_nf = [] } -> 1
| { good_nf = l} -> List.fold_left (fun acc t -> acc + (num_sol t)) 0 l | { good_nf = l} -> List.fold_left (fun acc t -> acc + (num_sol t)) 0 l
let save_gr ?domain base t = let save_gr base t =
let rec loop file_name t = let rec loop file_name t =
match t.good_nf with match t.good_nf with
| [] -> File.write (Instance.to_gr ?domain t.instance) (file_name^".gr") | [] -> File.write (Instance.to_gr t.instance) (file_name^".gr")
| l -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l | l -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
in loop base t in loop base t
let save_conll ?domain base t = let save_conll base t =
let rec loop file_name t = let rec loop file_name t =
match t.good_nf with match t.good_nf with
| [] -> File.write (Instance.to_conll_string ?domain t.instance) (file_name^".conll") | [] -> File.write (Instance.to_conll_string t.instance) (file_name^".conll")
| l -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l | l -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
in loop base t in loop base t
let save_full_conll ?domain base t = let save_full_conll base t =
let cpt = ref 0 in let cpt = ref 0 in
let rec loop t = let rec loop t =
match t.good_nf with match t.good_nf with
| [] -> | [] ->
File.write (Instance.to_conll_string ?domain t.instance) (sprintf "%s__%d.conll" base !cpt); File.write (Instance.to_conll_string t.instance) (sprintf "%s__%d.conll" base !cpt);
incr cpt incr cpt
| l -> List.iter loop l | l -> List.iter loop l
in loop t; !cpt in loop t; !cpt
(* suppose that all modules are deterministic and produced exacly one normal form *) (* suppose that all modules are deterministic and produced exacly one normal form *)
let save_det_gr ?domain base t = let save_det_gr base t =
let rec loop t = let rec loop t =
match t.good_nf with match t.good_nf with
| [] -> File.write (Instance.to_gr ?domain t.instance) (base^".gr") | [] -> File.write (Instance.to_gr t.instance) (base^".gr")
| [one] -> loop one | [one] -> loop one
| _ -> Error.run "[save_det_gr] Not a single rewriting" | _ -> Error.run "[save_det_gr] Not a single rewriting"
in loop t in loop t
let save_det_conll ?domain ?header base t = let save_det_conll ?header base t =
let rec loop t = let rec loop t =
match t.good_nf with match t.good_nf with
| [] -> | [] ->
let output = let output =
match header with match header with
| Some h -> sprintf "%% %s\n%s" h (Instance.to_conll_string ?domain t.instance) | Some h -> sprintf "%% %s\n%s" h (Instance.to_conll_string t.instance)
| None -> Instance.to_conll_string ?domain t.instance in | None -> Instance.to_conll_string t.instance in
File.write output (base^".conll") File.write output (base^".conll")
| [one] -> loop one | [one] -> loop one
| _ -> Error.run "[save_det_conll] Not a single rewriting" | _ -> Error.run "[save_det_conll] Not a single rewriting"
in loop t in loop t
let det_dep_string ?domain t = let det_dep_string t =
let rec loop t = let rec loop t =
match t.good_nf with match t.good_nf with
| [] -> | [] ->
let graph = t.instance.Instance.graph in let graph = t.instance.Instance.graph in
Some (G_graph.to_dep ?domain graph) Some (G_graph.to_dep graph)
| [one] -> loop one | [one] -> loop one
| _ -> None | _ -> None
in loop t in loop t
let conll_dep_string ?domain ?(keep_empty_rh=false) t = let conll_dep_string ?(keep_empty_rh=false) t =
if (not keep_empty_rh) && is_empty t if (not keep_empty_rh) && is_empty t
then None then None
else else
...@@ -105,7 +105,7 @@ module Rewrite_history = struct ...@@ -105,7 +105,7 @@ module Rewrite_history = struct
match t.good_nf with match t.good_nf with
| [] -> | [] ->
let graph = t.instance.Instance.graph in let graph = t.instance.Instance.graph in
Some (G_graph.to_conll_string ?domain graph) Some (G_graph.to_conll_string graph)
| [one] -> loop one | [one] -> loop one
| _ -> None | _ -> None
in loop t in loop t
...@@ -520,7 +520,6 @@ module Grs = struct ...@@ -520,7 +520,6 @@ module Grs = struct
let domain t = t.domain let domain t = t.domain
let from_ast filename ast = let from_ast filename ast =
let conll_fields = match List_.opt_map let conll_fields = match List_.opt_map
(fun x -> match x with (fun x -> match x with
| New_ast.Conll_fields desc -> Some desc | New_ast.Conll_fields desc -> Some desc
...@@ -560,6 +559,7 @@ module Grs = struct ...@@ -560,6 +559,7 @@ module Grs = struct
(fun x -> match x with (fun x -> match x with
| New_ast.Features _ -> None | New_ast.Features _ -> None
| New_ast.Labels _ -> None | New_ast.Labels _ -> None
| New_ast.Conll_fields _ -> None
| New_ast.Import _ -> Error.bug "[load] Import: inconsistent ast for new_grs" | New_ast.Import _ -> Error.bug "[load] Import: inconsistent ast for new_grs"
| New_ast.Include _ -> Error.bug "[load] Inlcude: inconsistent ast for new_grs" | New_ast.Include _ -> Error.bug "[load] Inlcude: inconsistent ast for new_grs"
| x -> Some (build_decl ?domain x) | x -> Some (build_decl ?domain x)
......
...@@ -31,22 +31,22 @@ module Rewrite_history: sig ...@@ -31,22 +31,22 @@ module Rewrite_history: sig
(** [save_gr base_name t] saves one gr_file for each normal form defined in [t]. (** [save_gr base_name t] saves one gr_file for each normal form defined in [t].
Output files are named according to [base_name] and the Gorn adress in the rewriting tree. *) Output files are named according to [base_name] and the Gorn adress in the rewriting tree. *)
val save_gr: ?domain:Domain.t -> string -> t -> unit val save_gr: string -> t -> unit
val save_conll: ?domain:Domain.t -> string -> t -> unit val save_conll: string -> t -> unit
(** [save_full_conll base_name t] saves one conll_file for each normal form defined in [t]. (** [save_full_conll base_name t] saves one conll_file for each normal form defined in [t].
Output files are named according to [base_name] and a secondary index after "__". Output files are named according to [base_name] and a secondary index after "__".
The number of conll file produced is returned. *) The number of conll file produced is returned. *)
val save_full_conll: ?domain:Domain.t -> string -> t -> int val save_full_conll: string -> t -> int
(** [save_det_gr base_name t] supposes that the current GRS is deterministic. (** [save_det_gr base_name t] supposes that the current GRS is deterministic.
It writes exactly one output file named [base_name].gr with the unique normal form. *) It writes exactly one output file named [base_name].gr with the unique normal form. *)
val save_det_gr: ?domain:Domain.t ->string -> t -> unit val save_det_gr: string -> t -> unit
val save_det_conll: ?domain:Domain.t -> ?header:string -> string -> t -> unit val save_det_conll: ?header:string -> string -> t -> unit
val det_dep_string: ?domain:Domain.t -> t -> string option val det_dep_string: t -> string option
val conll_dep_string: ?domain:Domain.t -> ?keep_empty_rh:bool -> t -> string option val conll_dep_string: ?keep_empty_rh:bool -> t -> string option
end (* module Rewrite_history *) end (* module Rewrite_history *)
(* ================================================================================ *) (* ================================================================================ *)
......
...@@ -51,12 +51,12 @@ module Instance = struct ...@@ -51,12 +51,12 @@ module Instance = struct
(* only graph rewritten from the same init graph can be "compared" *) (* only graph rewritten from the same init graph can be "compared" *)
let compare t1 t2 = Pervasives.compare t1.history t2.history let compare t1 t2 = Pervasives.compare t1.history t2.history
let to_gr ?domain t = G_graph.to_gr ?domain t.graph let to_gr t = G_graph.to_gr t.graph
let to_conll_string ?domain t = G_graph.to_conll_string ?domain t.graph let to_conll_string t = G_graph.to_conll_string t.graph
let save_dot_png ?domain ?filter ?main_feat base t = let save_dot_png ?filter ?main_feat base t =
ignore (Dot.to_png_file (G_graph.to_dot ?domain ?main_feat t.graph) (base^".png")) ignore (Dot.to_png_file (G_graph.to_dot ?main_feat t.graph) (base^".png"))
end (* module Instance *) end (* module Instance *)
(* ================================================================================ *) (* ================================================================================ *)
...@@ -694,7 +694,7 @@ module Rule = struct ...@@ -694,7 +694,7 @@ module Rule = struct
match cst with match cst with
| Cst_out (pid,label_cst) -> | Cst_out (pid,label_cst) ->
let gid = Pid_map.find pid matching.n_match in let gid = Pid_map.find pid matching.n_match in
if G_graph.edge_out ?domain graph gid label_cst if G_graph.edge_out graph gid label_cst
then matching then matching
else raise Fail else raise Fail
| Cst_in (pid,label_cst) -> | Cst_in (pid,label_cst) ->
...@@ -938,7 +938,7 @@ module Rule = struct ...@@ -938,7 +938,7 @@ module Rule = struct
| Command.DEL_EDGE_EXPL (src_cn,tar_cn,edge) -> | Command.DEL_EDGE_EXPL (src_cn,tar_cn,edge) ->
let src_gid = node_find src_cn in let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in let tar_gid = node_find tar_cn in
(match G_graph.del_edge ?domain loc instance.Instance.graph src_gid edge tar_gid with (match G_graph.del_edge loc instance.Instance.graph src_gid edge tar_gid with
| None when !Global.strict -> Error.run "DEL_EDGE_EXPL: the edge '%s' does not exist %s" (G_edge.to_string ?domain edge) (Loc.to_string loc) | None when !Global.strict -> Error.run "DEL_EDGE_EXPL: the edge '%s' does not exist %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
| None -> (instance, created_nodes) | None -> (instance, created_nodes)
| Some new_graph -> | Some new_graph ->
...@@ -955,7 +955,7 @@ module Rule = struct ...@@ -955,7 +955,7 @@ module Rule = struct
let (src_gid,edge,tar_gid) = let (src_gid,edge,tar_gid) =
try List.assoc edge_ident matching.e_match try List.assoc edge_ident matching.e_match
with Not_found -> Error.bug "The edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in with Not_found -> Error.bug "The edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in
(match G_graph.del_edge ?domain ~edge_ident loc instance.Instance.graph src_gid edge tar_gid with (match G_graph.del_edge ~edge_ident loc instance.Instance.graph src_gid edge tar_gid with
| None -> Error.bug "DEL_EDGE_NAME" | None -> Error.bug "DEL_EDGE_NAME"
| Some new_graph -> | Some new_graph ->
( (
...@@ -997,7 +997,7 @@ module Rule = struct ...@@ -997,7 +997,7 @@ module Rule = struct
) item_list in ) item_list in
let (new_graph, new_feature_value) = let (new_graph, new_feature_value) =
G_graph.update_feat ~loc ?domain instance.Instance.graph tar_gid tar_feat_name rule_items in G_graph.update_feat ~loc instance.Instance.graph tar_gid tar_feat_name rule_items in
( (
{instance with {instance with
Instance.graph = new_graph; Instance.graph = new_graph;
...@@ -1057,7 +1057,7 @@ module Rule = struct ...@@ -1057,7 +1057,7 @@ module Rule = struct
| Command.SHIFT_IN (src_cn,tar_cn,label_cst) -> | Command.SHIFT_IN (src_cn,tar_cn,label_cst) ->
let src_gid = node_find src_cn in let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in let tar_gid = node_find tar_cn in
let (new_graph, _, _) = G_graph.shift_in loc ?domain true src_gid tar_gid (test_locality matching created_nodes) label_cst instance.Instance.graph in let (new_graph, _, _) = G_graph.shift_in loc true src_gid tar_gid (test_locality matching created_nodes) label_cst instance.Instance.graph in
( (
{instance with {instance with
Instance.graph = new_graph; Instance.graph = new_graph;
...@@ -1069,7 +1069,7 @@ module Rule = struct ...@@ -1069,7 +1069,7 @@ module Rule = struct
| Command.SHIFT_OUT (src_cn,tar_cn,label_cst) -> | Command.SHIFT_OUT (src_cn,tar_cn,label_cst) ->
let src_gid = node_find src_cn in let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in let tar_gid = node_find tar_cn in
let (new_graph, _, _) = G_graph.shift_out loc ?domain true src_gid tar_gid (test_locality matching created_nodes) label_cst instance.Instance.graph in let (new_graph, _, _) = G_graph.shift_out loc true src_gid tar_gid (test_locality matching created_nodes) label_cst instance.Instance.graph in
( (
{instance with {instance with
Instance.graph = new_graph; Instance.graph = new_graph;
...@@ -1081,7 +1081,7 @@ module Rule = struct ...@@ -1081,7 +1081,7 @@ module Rule = struct
| Command.SHIFT_EDGE (src_cn,tar_cn,label_cst) -> | Command.SHIFT_EDGE (src_cn,tar_cn,label_cst) ->
let src_gid = node_find src_cn in let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in let tar_gid = node_find tar_cn in
let (new_graph, _, _) = G_graph.shift_edges loc ?domain true src_gid tar_gid (test_locality matching created_nodes) label_cst instance.Instance.graph in let (new_graph, _, _) = G_graph.shift_edges loc true src_gid tar_gid (test_locality matching created_nodes) label_cst instance.Instance.graph in
( (
{instance with {instance with
Instance.graph = new_graph; Instance.graph = new_graph;
...@@ -1412,7 +1412,7 @@ module Rule = struct ...@@ -1412,7 +1412,7 @@ module Rule = struct
| Command.DEL_EDGE_EXPL (src_cn,tar_cn,edge) -> | Command.DEL_EDGE_EXPL (src_cn,tar_cn,edge) ->
let src_gid = node_find src_cn in let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in let tar_gid = node_find tar_cn in
(match G_graph.del_edge ?domain loc graph src_gid edge tar_gid with (match G_graph.del_edge loc graph src_gid edge tar_gid with
| None when !Global.strict -> Error.run "DEL_EDGE_EXPL: the edge '%s' does not exist %s" (G_edge.to_string ?domain edge) (Loc.to_string loc) | None when !Global.strict -> Error.run "DEL_EDGE_EXPL: the edge '%s' does not exist %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
| None -> (graph, created_nodes, eff) | None -> (graph, created_nodes, eff)
...@@ -1423,7 +1423,7 @@ module Rule = struct ...@@ -1423,7 +1423,7 @@ module Rule = struct
let (src_gid,edge,tar_gid) = let (src_gid,edge,tar_gid) =
try List.assoc edge_ident matching.e_match try List.assoc edge_ident matching.e_match
with Not_found -> Error.bug "The edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in with Not_found -> Error.bug "The edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in
(match G_graph.del_edge ?domain ~edge_ident loc graph src_gid edge tar_gid with (match G_graph.del_edge ~edge_ident loc graph src_gid edge tar_gid with
| None -> Error.bug "DEL_EDGE_NAME" | None -> Error.bug "DEL_EDGE_NAME"
| Some new_graph -> (new_graph, created_nodes, true) | Some new_graph -> (new_graph, created_nodes, true)
) )
...@@ -1451,7 +1451,7 @@ module Rule = struct ...@@ -1451,7 +1451,7 @@ module Rule = struct
) item_list in ) item_list in
let (new_graph, new_feature_value) = let (new_graph, new_feature_value) =
G_graph.update_feat ~loc ?domain graph tar_gid tar_feat_name rule_items in G_graph.update_feat ~loc graph tar_gid tar_feat_name rule_items in
(new_graph, created_nodes, true) (new_graph, created_nodes, true)
| Command.DEL_FEAT (tar_cn,feat_name) -> | Command.DEL_FEAT (tar_cn,feat_name) ->
...@@ -1465,19 +1465,19 @@ module Rule = struct ...@@ -1465,19 +1465,19 @@ module Rule = struct
| Command.SHIFT_IN (src_cn,tar_cn,label_cst) -> | Command.SHIFT_IN (src_cn,tar_cn,label_cst) ->
let src_gid = node_find src_cn in let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in let tar_gid = node_find tar_cn in
let (new_graph, de