Commit c3a22075 authored by Bruno Guillaume's avatar Bruno Guillaume

Add function G_graph.is_projective

parent c2abb500
......@@ -17,6 +17,8 @@ module String_map = Map.Make (String)
module Int_set = Set.Make (struct type t = int let compare = Pervasives.compare end)
module Int_map = Map.Make (struct type t = int let compare = Pervasives.compare end)
module Float_map = Map.Make (struct type t = float let compare = Pervasives.compare end)
(* ================================================================================ *)
module Loc = struct
type t = string option * int option
......@@ -624,3 +626,33 @@ module Global = struct
let debug = ref false
let safe_commands = ref false
end (* module Global *)
module Dependencies = struct
let lex_cmp (i1, j1) (i2,j2) = match Pervasives.compare i1 i2 with 0 -> Pervasives.compare j1 j2 | x -> x
let rec insert_sorted i = function
| h::t when h < i -> h :: (insert_sorted i t)
| l -> i::l
let is_projective edge_list =
let rec loop position from_here from_before = function
| [] ->
(* Printf.printf "=N=> pos=%d H=[%s] B=[%s]\n" position (String.concat "," (List.map string_of_int from_here)) (String.concat "," (List.map string_of_int from_before)); *)
None
| (i,j) :: tail ->
(* Printf.printf "=S=> (%d, %d) pos=%d H=[%s] B=[%s]\n" i j position (String.concat "," (List.map string_of_int from_here)) (String.concat "," (List.map string_of_int from_before)); *)
let rec reduce_from_before = function
| h::t when h <= i -> reduce_from_before t
| l -> l in
let (new_from_here, new_from_before) =
if i > position
then ([], reduce_from_before (from_here @ from_before))
else (from_here, reduce_from_before from_before) in
(* Printf.printf " ...> NH=[%s] NB=[%s]\n" (String.concat "," (List.map string_of_int new_from_here)) (String.concat "," (List.map string_of_int new_from_before)); *)
match new_from_before with
| h::t when j > h -> Some (i,j)
| h::t when j = h -> loop i new_from_here new_from_before tail
| _ -> loop i (insert_sorted j new_from_here) new_from_before tail in
loop 0. [] [] edge_list
end
\ No newline at end of file
......@@ -14,6 +14,8 @@ module String_map : Map.S with type key = string
module Int_set : Set.S with type elt = int
module Int_map : Map.S with type key = int
module Float_map : Map.S with type key = float
(* ================================================================================ *)
(* [Loc] general module to describe errors location: (file name, line number in file) *)
module Loc: sig
......@@ -296,3 +298,14 @@ module Global: sig
val debug: bool ref
val safe_commands: bool ref
end
(* ================================================================================ *)
module Dependencies : sig
(* [lex_cmp pair1 pair2] is the lexicographic ordering. This function can be used to sort data for [is_projective] function. *)
val lex_cmp: ('a * 'b) -> ('a * 'b) -> int
(* [is_projective arcs] returns [None] if the structure is projective and [Some arc] where [arc] is one of the edge implied in non-projectivity.
Input: a list of arcs represented by couples (smallest position, highest position) and lexicographically ordered *)
val is_projective: (float * float) list -> (float * float) option
end
......@@ -1187,6 +1187,25 @@ module G_graph = struct
(* ====== NO CAST NEEDED ====== *) graph
| _ ->
(* ====== CASTING NEEDED ====== *) of_conll ?domain (to_conll graph)
let is_projective t =
let (arc_positions, pos_to_gid_map) =
Gid_map.fold (fun src_gid src_node (acc, acc_map) ->
match G_node.get_position src_node with
| G_node.Unordered _ -> (acc, acc_map)
| G_node.Ordered src_pos ->
let new_acc = Massoc_gid.fold (fun acc2 tar_gid edge ->
let tar_node = find tar_gid t in
match G_node.get_position tar_node with
| G_node.Unordered _ -> acc2
| G_node.Ordered tar_pos -> (min src_pos tar_pos, max src_pos tar_pos) :: acc2
) acc (G_node.get_next src_node) in
(new_acc, Float_map.add src_pos src_gid acc_map)
) t.map ([], Float_map.empty) in
let sorted_arc_positions = List.sort Dependencies.lex_cmp arc_positions in
match Dependencies.is_projective sorted_arc_positions with
| Some (p1, p2) -> Some (Float_map.find p1 pos_to_gid_map, Float_map.find p1 pos_to_gid_map)
| None -> None
end (* module G_graph *)
......
......@@ -200,6 +200,8 @@ module G_graph: sig
val to_json: t -> json
val cast: ?domain:Domain.t -> t -> t
val is_projective: t -> (Gid.t * Gid.t) option
end (* module G_graph *)
(* ================================================================================ *)
......
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