Commit 4333117a authored by bguillaum's avatar bguillaum

version 0.34.2: fix bug in node ordering in case of del_node

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8978 7838e531-6607-4d57-9587-6c381814729c
parent f9df731c
Version 0.34.2 (2016/05/18)
Bug fix in node ordering in case of del_node
Version 0.34.1 (2016/05/14)
Bug fix in default values for depth bounds
Version 0.34 (2016/05/10)
NB: changes prefixed with "==>" belows breaks existing code!
NB: changes prefixed with "-->" belows makes existing code deprecated
......
......@@ -412,14 +412,38 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *)
let del_node graph node_id =
{graph with map =
let node = Gid_map.find node_id graph.map in
let map_wo_node =
Gid_map.fold
(fun id value acc ->
if id = node_id
then acc
else Gid_map.add id (G_node.remove_key node_id value) acc
) graph.map Gid_map.empty
}
) graph.map Gid_map.empty in
let new_map =
match (G_node.get_prec node, G_node.get_succ node) with
| (Some id_prec, Some id_succ) ->
begin
let prec = Gid_map.find id_prec graph.map
and succ = Gid_map.find id_succ graph.map in
map_wo_node
|> (Gid_map.add id_prec (G_node.set_succ id_succ prec))
|> (Gid_map.add id_succ (G_node.set_prec id_prec succ))
end
| (Some id_prec, None) ->
begin
let prec = Gid_map.find id_prec graph.map in
map_wo_node
|> (Gid_map.add id_prec (G_node.remove_succ prec))
end
| (None, Some id_succ) ->
begin
let succ = Gid_map.find id_succ graph.map in
map_wo_node
|> (Gid_map.add id_succ (G_node.remove_prec succ))
end
| (None, None) -> map_wo_node in
{ graph with map = new_map }
(* -------------------------------------------------------------------------------- *)
let add_neighbour loc domain graph node_id label = failwith "no more add_neighbour"
......
......@@ -44,6 +44,9 @@ module G_node = struct
let set_succ id t = { t with succ = Some id }
let set_prec id t = { t with prec = Some id }
let remove_succ t = { t with succ = None }
let remove_prec t = { t with prec = None }
let empty = { fs = G_fs.empty; next = Massoc_gid.empty; succ = None; prec = None; position = -1.; conll_root=false }
let is_conll_root t = t.conll_root
......@@ -70,7 +73,7 @@ module G_node = struct
let of_conll ?loc ?prec ?succ domain line =
if line = Conll.root
then { empty with conll_root=true }
then { empty with conll_root=true; succ}
else { empty with fs = G_fs.of_conll ?loc domain line; position = float line.Conll.id; prec; succ }
let fresh domain ?prec ?succ position = { empty with position; prec; succ }
......
......@@ -34,6 +34,9 @@ module G_node: sig
val set_prec: Gid.t -> t -> t
val set_succ: Gid.t -> t -> t
val remove_prec: t -> t
val remove_succ: t -> t
val set_fs: G_fs.t -> t -> t
val set_position: float -> t -> t
val set_next: G_edge.t Massoc_gid.t -> t -> t
......
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