Commit e6f1aa70 authored by bguillaum's avatar bguillaum

add the flatten function for graph normalization between modules

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7452 7838e531-6607-4d57-9587-6c381814729c
parent 78f52c74
......@@ -9,7 +9,7 @@ open Grew_node
open Grew_command
(* ================================================================================ *)
(* ==================================================================================================== *)
module P_deco = struct
type t = {
nodes: Pid.t list;
......@@ -19,17 +19,7 @@ module P_deco = struct
let empty = {nodes=[]; edges=[]}
end (* module P_deco *)
(* ================================================================================ *)
module G_deco = struct
type t = {
nodes: Gid.t list;
edges: (Gid.t * G_edge.t * Gid.t) list;
}
let empty = {nodes=[]; edges=[]}
end (* module G_deco *)
(* ================================================================================ *)
(* ==================================================================================================== *)
module P_graph = struct
type t = P_node.t Pid_map.t
......@@ -58,7 +48,7 @@ module P_graph = struct
let build ?pat_vars ?(locals=[||]) (full_node_list : Ast.node list) full_edge_list =
(* 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. *)
(* NB: insertion of new node at the end of the list: not efficient but graph building is not the hard part. *)
let rec insert (ast_node, loc) = function
| [] -> [P_node.build ?pat_vars (ast_node, loc)]
| (node_id,fs)::tail when ast_node.Ast.node_id = node_id ->
......@@ -67,8 +57,8 @@ module P_graph = struct
let (named_nodes : (Id.name * P_node.t) list) =
List.fold_left
(fun acc ast_node -> insert ast_node acc)
[] full_node_list in
(fun acc ast_node -> insert ast_node acc)
[] full_node_list in
let sorted_nodes = List.sort (fun (id1,_) (id2,_) -> Pervasives.compare id1 id2) named_nodes in
let (sorted_ids, node_list) = List.split sorted_nodes in
......@@ -186,6 +176,15 @@ module P_graph = struct
let roots graph = snd (tree_and_roots graph)
end (* module P_graph *)
(* ==================================================================================================== *)
module G_deco = struct
type t = {
nodes: Gid.t list;
edges: (Gid.t * G_edge.t * Gid.t) list;
}
let empty = {nodes=[]; edges=[]}
end (* module G_deco *)
(* ==================================================================================================== *)
module Concat_item = struct
......@@ -210,20 +209,24 @@ module G_graph = struct
Massoc_gid.exists (fun _ e -> P_edge.compatible p_edge e) (G_node.get_next node)
(* -------------------------------------------------------------------------------- *)
let map_add_edge map id_src label id_tar =
let add_edge graph id_src label id_tar =
let node_src =
(* Not found can be raised when adding an edge from pos to neg *)
try Gid_map.find id_src map with Not_found -> G_node.empty in
try Gid_map.find id_src graph with Not_found -> G_node.empty in
match G_node.add_edge label id_tar node_src with
| None -> None
| Some new_node -> Some (Gid_map.add id_src new_node map)
| Some new_node -> Some (Gid_map.add id_src new_node graph)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Build functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* -------------------------------------------------------------------------------- *)
let build ?(locals=[||]) full_node_list full_edge_list =
(* let build ?(locals=[||]) full_node_list full_edge_list = *)
let build ?(locals=[||]) gr_ast =
let full_node_list = gr_ast.Ast.nodes
and full_edge_list = gr_ast.Ast.edges in
let named_nodes =
let rec loop already_bound = function
......@@ -250,7 +253,7 @@ module G_graph = struct
let i1 = Id.build ~loc ast_edge.Ast.src table in
let i2 = Id.build ~loc ast_edge.Ast.tar table in
let edge = G_edge.build ~locals (ast_edge, loc) in
(match map_add_edge acc (Gid.Old i1) edge (Gid.Old i2) with
(match add_edge acc (Gid.Old i1) edge (Gid.Old i2) with
| Some g -> g
| None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
(G_edge.to_string edge)
......@@ -289,13 +292,18 @@ module G_graph = struct
nodes_with_edges
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Update functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* -------------------------------------------------------------------------------- *)
let add_edge graph id_src label id_tar = map_add_edge graph id_src label id_tar
let rename mapping graph =
Gid_map.fold
(fun id node acc ->
let new_id = try List.assoc id mapping with Not_found -> id in
let new_node = G_node.rename mapping node in
Gid_map.add new_id new_node acc
) graph Gid_map.empty
(* -------------------------------------------------------------------------------- *)
let del_edge ?edge_ident loc graph id_src label id_tar =
......@@ -380,10 +388,12 @@ module G_graph = struct
let tar_node = Gid_map.find tar_gid graph in
if Massoc_gid.mem_key tar_gid (G_node.get_next src_node)
then Error.run ~loc "[Graph.shift_edges] dependency from src to tar";
then Error.run ~loc "[Graph.shift_edges] dependency from src (gid=%s) to tar (gid=%s)"
(Gid.to_string src_gid) (Gid.to_string tar_gid);
if Massoc_gid.mem_key src_gid (G_node.get_next tar_node)
then Error.run ~loc "[Graph.shift_edges] dependency from tar to src";
then Error.run ~loc "[Graph.shift_edges] dependency from tar (gid=%s) to src (gid=%s)"
(Gid.to_string tar_gid) (Gid.to_string src_gid);
Gid_map.mapi
(fun node_id node ->
......
......@@ -83,11 +83,7 @@ module G_graph: sig
(* Build functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val build:
?locals: Label.decl array ->
Ast.node list ->
Ast.edge list ->
t
val build: ?locals: Label.decl array -> Ast.gr -> t
val of_conll: ?loc:Loc.t -> Conll.line list -> t
......@@ -95,6 +91,9 @@ module G_graph: sig
(* Update functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val rename: (Gid.t * Gid.t) list -> t -> t
(** [add_edge graph id_src label id_tar] tries to add an edge grom [id_src] to [id_tar] with [label] to [graph].
if it succeeds, [Some new_graph] is returned
if it fails (the edge already exists), [None] is returned
......
......@@ -294,7 +294,7 @@ module Grs = struct
~confluent: next.Modul.confluent
next.Modul.rules
next.Modul.filters
(Instance.clear instance) in
(Instance.flatten instance) in
let good_list = Instance_set.elements good_set
and bad_list = Instance_set.elements bad_set in
{
......@@ -317,7 +317,7 @@ module Grs = struct
~confluent: next.Modul.confluent
next.Modul.rules
next.Modul.filters
(Instance.clear instance) in
(Instance.flatten instance) in
let inst_list = Instance_set.elements good_set
(* and bad_list = Instance_set.elements bad_set *) in
......
......@@ -66,6 +66,8 @@ module G_node = struct
let build_neighbour t = {empty with pos = match t.pos with Some x -> Some (x+1) | None -> None}
let pos_comp n1 n2 = Pervasives.compare n1.pos n2.pos
let rename mapping n = {n with next = Massoc_gid.rename mapping n.next}
end
(* ================================================================================ *)
......
......@@ -33,6 +33,8 @@ module G_node: sig
val pos_comp: t -> t -> int
val build_neighbour: t -> t
val rename: (Gid.t * Gid.t) list -> t -> t
end
(* ================================================================================ *)
......
......@@ -12,35 +12,44 @@ open Grew_graph
(* ================================================================================ *)
module Instance = struct
type t = {
graph: G_graph.t;
commands: Command.h list;
rules: string list;
big_step: Grew_types.big_step option;
graph: G_graph.t;
history: Command.h list;
rules: string list;
big_step: Grew_types.big_step option;
free_index: int;
activated_node: Gid.t list;
}
let empty = {graph = G_graph.empty; rules=[]; history=[]; big_step=None; free_index=0; activated_node=[];}
let from_graph graph =
{empty with
graph = graph;
free_index = match (Gid_map.max_binding graph) with
| (Gid.Old i,_) -> i+1
| _ -> Error.bug "[Instance.from_graph]"
}
let empty = {graph = G_graph.empty; rules=[]; commands=[]; big_step=None;}
let from_graph g = {empty with graph = g}
let build gr_ast =
let graph = G_graph.build gr_ast.Ast.nodes gr_ast.Ast.edges in
{ empty with graph = graph }
let of_conll ?loc lines =
{ empty with graph = G_graph.of_conll ?loc lines }
let rev_steps t =
{ t with big_step = match t.big_step with
| None -> None
| Some bs -> Some {bs with Grew_types.small_step = List.rev bs.Grew_types.small_step }
| None -> None
| Some bs -> Some {bs with Grew_types.small_step = List.rev bs.Grew_types.small_step }
}
let clear t = {empty with graph = t.graph } (* FIXME: normalization of node ids ??? *)
let get_graph t = t.graph
let flatten t =
(* [mapping] is list of couple (node_id, node_id) used to flatten the graph *)
let (mapping, new_free) = List.fold_left
(fun (acc_map, next_free) node_id ->
(
(node_id, Gid.Old next_free) :: acc_map,
next_free + 1
)
) ([], t.free_index) t.activated_node in
{ empty with graph = G_graph.rename mapping t.graph; free_index = new_free }
(* comparison is done on the list of commands *)
(* only graph rewrited from the same init graph can be "compared" *)
let compare t1 t2 = Pervasives.compare t1.commands t2.commands
let compare t1 t2 = Pervasives.compare t1.history t2.history
let to_gr t = G_graph.to_gr t.graph
......@@ -493,7 +502,7 @@ module Rule = struct
(
{instance with
Instance.graph = new_graph;
commands = List_.sort_insert (Command.H_ADD_EDGE (src_gid,tar_gid,edge)) instance.Instance.commands
history = List_.sort_insert (Command.H_ADD_EDGE (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
)
......@@ -507,7 +516,7 @@ module Rule = struct
(
{instance with
Instance.graph = G_graph.del_edge loc instance.Instance.graph src_gid edge tar_gid;
commands = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.commands
history = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
)
......@@ -519,7 +528,7 @@ module Rule = struct
(
{instance with
Instance.graph = G_graph.del_edge ~edge_ident loc instance.Instance.graph src_gid edge tar_gid;
commands = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.commands
history = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
)
......@@ -529,7 +538,7 @@ module Rule = struct
(
{instance with
Instance.graph = G_graph.del_node instance.Instance.graph node_gid;
commands = List_.sort_insert (Command.H_DEL_NODE node_gid) instance.Instance.commands
history = List_.sort_insert (Command.H_DEL_NODE node_gid) instance.Instance.history
},
created_nodes
)
......@@ -542,7 +551,7 @@ module Rule = struct
(
{instance with
Instance.graph = new_graph;
commands = List_.sort_insert (Command.H_MERGE_NODE (src_gid,tar_gid)) instance.Instance.commands
history = List_.sort_insert (Command.H_MERGE_NODE (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
)
......@@ -570,9 +579,7 @@ module Rule = struct
(
{instance with
Instance.graph = new_graph;
commands = List_.sort_insert
(Command.H_UPDATE_FEAT (tar_gid,tar_feat_name,new_feature_value))
instance.Instance.commands
history = List_.sort_insert (Command.H_UPDATE_FEAT (tar_gid,tar_feat_name,new_feature_value)) instance.Instance.history
},
created_nodes
)
......@@ -582,7 +589,7 @@ module Rule = struct
(
{instance with
Instance.graph = G_graph.del_feat instance.Instance.graph tar_gid feat_name;
commands = List_.sort_insert (Command.H_DEL_FEAT (tar_gid,feat_name)) instance.Instance.commands
history = List_.sort_insert (Command.H_DEL_FEAT (tar_gid,feat_name)) instance.Instance.history
},
created_nodes
)
......@@ -593,7 +600,8 @@ module Rule = struct
(
{instance with
Instance.graph = new_graph;
commands = List_.sort_insert (Command.H_NEW_NEIGHBOUR (created_name,edge,new_gid)) instance.Instance.commands
history = List_.sort_insert (Command.H_NEW_NEIGHBOUR (created_name,edge,new_gid)) instance.Instance.history;
activated_node = new_gid :: instance.Instance.activated_node;
},
(created_name,new_gid) :: created_nodes
)
......@@ -604,7 +612,7 @@ module Rule = struct
(
{instance with
Instance.graph = G_graph.shift_in loc instance.Instance.graph src_gid tar_gid;
commands = List_.sort_insert (Command.H_SHIFT_IN (src_gid,tar_gid)) instance.Instance.commands
history = List_.sort_insert (Command.H_SHIFT_IN (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
)
......@@ -615,7 +623,7 @@ module Rule = struct
(
{instance with
Instance.graph = G_graph.shift_out loc instance.Instance.graph src_gid tar_gid;
commands = List_.sort_insert (Command.H_SHIFT_OUT (src_gid,tar_gid)) instance.Instance.commands
history = List_.sort_insert (Command.H_SHIFT_OUT (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
)
......@@ -624,11 +632,11 @@ module Rule = struct
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
(
{instance with
Instance.graph = G_graph.shift_edges loc instance.Instance.graph src_gid tar_gid;
commands = List_.sort_insert (Command.H_SHIFT_EDGE (src_gid,tar_gid)) instance.Instance.commands
},
created_nodes
{instance with
Instance.graph = G_graph.shift_edges loc instance.Instance.graph src_gid tar_gid;
history = List_.sort_insert (Command.H_SHIFT_EDGE (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
)
(** [apply_rule instance matching rule] returns a new instance after the application of the rule
......
......@@ -7,36 +7,34 @@ open Grew_ast
module Instance : sig
type t = {
graph: G_graph.t;
commands: Command.h list;
rules: string list;
big_step: Grew_types.big_step option;
}
val empty:t
val build: Ast.gr -> t
val of_conll: ?loc:Loc.t -> Conll.line list -> t
graph: G_graph.t;
history: Command.h list;
rules: string list;
big_step: Grew_types.big_step option;
free_index: int;
activated_node: Gid.t list;
}
(** [from_graph graph] return a fresh instance based on the input [graph]. *)
val from_graph: G_graph.t -> t
(* rev_steps reverse the small step list: during rewriting, the last rule is in the head of the list and the reverse is needed for display *)
(** [rev_steps t] reverses the small step list: during rewriting, the last rule
is in the head of the list and the reverse is needed for display. *)
val rev_steps: t -> t
val clear: t -> t
val from_graph: G_graph.t -> t
val get_graph: t -> G_graph.t
(** [flatten inst] returns a fresh representation of the graph where gid created by node
activation are map to basic gid. Graphs are flattened after each moduke. *)
val flatten: t -> t
(** [to_gr t] returns a string which contains the "gr" code of the current graph *)
val to_gr: t -> string
(* [save_dep_png base t] writes a file "base.png" with the dep representation of [t].
(** [save_dep_png base t] writes a file "base.png" with the dep representation of [t].
NB: if the Dep2pict is not available, nothing is done *)
val save_dep_png: ?main_feat: string -> string -> t -> unit
(* [save_dot_png base t] writes a file "base.png" with the dot representation of [t] *)
(** [save_dot_png base t] writes a file "base.png" with the dot representation of [t] *)
val save_dot_png: ?main_feat: string -> string -> t -> unit
end
module Instance_set : Set.S with type elt = Instance.t
......
......@@ -122,9 +122,14 @@ module Pid_set = Set.Make (Pid)
module Gid = struct
type t =
| Old of int
| New of int * int (* identifier for "created nodes" *)
| New of (int * int) (* identifier for "created nodes" *)
let compare = Pervasives.compare
(* a compore function which ensures that new nodes are a the "end" of the graph *)
let compare t1 t2 = match (t1,t2) with
| Old _ , New _ -> -1
| New _, Old _ -> 1
| Old o1, Old o2 -> Pervasives.compare o1 o2
| New n1, New n2 -> Pervasives.compare n1 n2
let to_string = function
| Old i -> sprintf "%d" i
......@@ -350,8 +355,8 @@ module List_ = struct
let foldi_left f init l =
fst
(List.fold_left
(fun (acc,i) elt -> (f i acc elt, i+1))
(init,0) l
(fun (acc,i) elt -> (f i acc elt, i+1))
(init,0) l
)
end (* module List_ *)
......@@ -403,6 +408,8 @@ module type S =
val merge_key: key -> key -> 'a t -> 'a t
val exists: (key -> 'a -> bool) -> 'a t -> bool
val rename: (key * key) list -> 'a t -> 'a t
end (* module type S *)
(* ================================================================================ *)
......@@ -503,6 +510,13 @@ module Massoc_make (Ord: OrderedType) = struct
false
with True -> true
let rename mapping t =
M.fold
(fun key value acc ->
let new_key = try List.assoc key mapping with Not_found -> key in
M.add new_key value acc
) t M.empty
end (* module Massoc_make *)
(* ================================================================================ *)
......
......@@ -57,7 +57,7 @@ module Pid_set : Set.S with type elt = Pid.t
module Gid : sig
type t =
| Old of int
| New of int * int (* identifier for "created nodes" *)
| New of (int * int) (* identifier for "created nodes" *)
val to_string: t -> string
end
......@@ -193,6 +193,8 @@ module type S =
val merge_key: key -> key -> 'a t -> 'a t
val exists: (key -> 'a -> bool) -> 'a t -> bool
val rename: (key * key) list -> 'a t -> 'a t
end
......
......@@ -72,13 +72,11 @@ let to_sentence ?main_feat gr =
let get_sequence_names grs = Grs.sequence_names grs
let empty_gr = Instance.empty
let load_gr file =
if (Sys.file_exists file) then (
try
let gr_ast = Grew_parser.gr_of_file file in
Instance.build gr_ast
Instance.from_graph (G_graph.build gr_ast)
with
| Grew_parser.Parse_error (msg,Some (sub_file,l)) ->
raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
......@@ -94,9 +92,8 @@ let load_gr file =
let load_conll file =
try
(* let lines = File.read file in *)
(* Instance.of_conll (List.map Conll.parse lines) *)
Instance.of_conll ~loc:(file,-1) (Conll.load file)
let graph = G_graph.of_conll ~loc:(file,-1) (Conll.load file) in
Instance.from_graph graph
with
| Grew_parser.Parse_error (msg,Some (sub_file,l)) ->
raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
......
......@@ -50,8 +50,6 @@ val to_sentence: ?main_feat:string -> Instance.t -> string
val save_gr: string -> Rewrite_history.t -> unit
val empty_gr : Instance.t
(** get a graph from a file either in 'gr' or 'conll' format.
File extension should be '.gr' or '.conll'.
@raise Parsing_err if libgrew can't parse the file
......
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