Add function G_graph.is_projective

src/grew_base.ml

@@ -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

src/grew_base.mli

@@ -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

src/grew_graph.ml

@@ -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 *)
 
 

src/grew_graph.mli

@@ -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 *)
 
 (* ================================================================================ *)