Commit dbc68ad1 authored by Bruno Guillaume's avatar Bruno Guillaume

add tree/forest/cycle constraints

parent 13493b75
...@@ -1286,12 +1286,16 @@ The algorithm is modified: ...@@ -1286,12 +1286,16 @@ The algorithm is modified:
Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0 Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0
*) *)
(* --------------------------------------------------------------- *) (* --------------------------------------------------------------- *)
let dfs_debug = false
let get_roots graph = let get_roots graph =
let non_roots = let non_roots =
Gid_map.fold Gid_map.fold
(fun gid node acc -> (fun gid node acc ->
Massoc_gid.fold_on_list ( Massoc_gid.fold_on_list (
fun acc2 next_gid _ -> Gid_set.add next_gid acc2 fun acc2 next_gid _ ->
if dfs_debug then printf " %s ---> %s\n%!" (Gid.to_string gid) (Gid.to_string next_gid);
Gid_set.add next_gid acc2
) acc (G_node.get_next node) ) acc (G_node.get_next node)
) graph.map Gid_set.empty in ) graph.map Gid_set.empty in
let roots = let roots =
...@@ -1313,6 +1317,12 @@ Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0 ...@@ -1313,6 +1317,12 @@ Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0
nontree_edges: (Gid.t * Gid.t) list; nontree_edges: (Gid.t * Gid.t) list;
} }
type dfs_output = {
forest: bool;
tree: bool;
cyclic: bool;
}
let depth_first_search graph = let depth_first_search graph =
let info = ref {intervals=Gid_map.empty; back_edges=[]; nontree_edges=[];} in let info = ref {intervals=Gid_map.empty; back_edges=[]; nontree_edges=[];} in
let clock = ref 0 in let clock = ref 0 in
...@@ -1334,31 +1344,48 @@ Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0 ...@@ -1334,31 +1344,48 @@ Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0
| _ -> assert false in | _ -> assert false in
let roots = get_roots graph in let roots = get_roots graph in
Printf.printf "|roots| = %d\n" (Gid_set.cardinal roots); let nb_roots = Gid_set.cardinal roots in
if dfs_debug then Printf.printf "|roots| = %d\n" nb_roots;
Gid_set.iter (fun gid -> Gid_set.iter (fun gid ->
Printf.printf " -----> explore %s\n" (Gid.to_string gid); if dfs_debug then Printf.printf " -----> explore %s\n" (Gid.to_string gid);
explore gid explore gid
) roots; ) roots;
Printf.printf "======== Intervals =======\n"; if dfs_debug then
Gid_map.iter (fun gid node -> begin
match Gid_map.find_opt gid !info.intervals with Printf.printf "======== Intervals =======\n";
| None -> Printf.printf "None! %s" (Gid.to_string gid) Gid_map.iter (fun gid node ->
| Some (Pre _) -> Printf.printf "Pre! %s" (Gid.to_string gid) match Gid_map.find_opt gid !info.intervals with
| Some (Pre_post (i,j)) -> | None -> Printf.printf "None! %s" (Gid.to_string gid)
| Some (Pre _) -> Printf.printf "Pre! %s" (Gid.to_string gid)
| Some (Pre_post (i,j)) ->
Printf.printf "%s --> [%d,%d] --> %s\n" (Gid.to_string gid) i j Printf.printf "%s --> [%d,%d] --> %s\n" (Gid.to_string gid) i j
(G_fs.to_string (G_node.get_fs node)) (G_fs.to_string (G_node.get_fs node))
) graph.map; ) graph.map;
Printf.printf "======== Back_edges =======\n"; Printf.printf "======== Back_edges =======\n";
List.iter (fun (gid1, gid2) -> List.iter (fun (gid1, gid2) ->
Printf.printf "%s --> %s\n" (Gid.to_string gid1) (Gid.to_string gid2) Printf.printf "%s --> %s\n" (Gid.to_string gid1) (Gid.to_string gid2)
) !info.back_edges; ) !info.back_edges;
Printf.printf "======== nontree_edges =======\n"; Printf.printf "======== nontree_edges =======\n";
List.iter (fun (gid1, gid2) -> List.iter (fun (gid1, gid2) ->
Printf.printf "%s --> %s\n" (Gid.to_string gid1) (Gid.to_string gid2) Printf.printf "%s --> %s\n" (Gid.to_string gid1) (Gid.to_string gid2)
) !info.nontree_edges ) !info.nontree_edges
end;
if Gid_map.cardinal !info.intervals < Gid_map.cardinal graph.map
then
begin
if dfs_debug then printf "Not covered\n%!";
{ forest = false; tree = false; cyclic = true}
end
else
{
forest = !info.nontree_edges = [] && !info.back_edges = [];
tree = !info.nontree_edges = [] && !info.back_edges = [] && nb_roots = 1;
cyclic = !info.back_edges <> [];
}
end (* module G_graph *) end (* module G_graph *)
......
...@@ -213,7 +213,13 @@ module G_graph: sig ...@@ -213,7 +213,13 @@ module G_graph: sig
val is_projective: t -> (Gid.t * Gid.t) option val is_projective: t -> (Gid.t * Gid.t) option
val depth_first_search: t -> unit type dfs_output = {
forest: bool;
tree: bool;
cyclic: bool;
}
val depth_first_search: t -> dfs_output
end (* module G_graph *) end (* module G_graph *)
(* ================================================================================ *) (* ================================================================================ *)
......
...@@ -947,21 +947,47 @@ module Rule = struct ...@@ -947,21 +947,47 @@ module Rule = struct
let match_in_graph ?domain ?lexicons { global; pos; negs } graph = let match_in_graph ?domain ?lexicons { global; pos; negs } graph =
let casted_graph = G_graph.cast ?domain graph in let casted_graph = G_graph.cast ?domain graph in
let rec match_global = function let match_global = function
| [] -> true | [] -> true
| "is_projective" :: tail -> | ["is_projective"] -> G_graph.is_projective graph = None
begin | ["is_not_projective"] -> G_graph.is_projective graph <> None
match G_graph.is_projective graph with | l ->
| Some _ -> false let dfs = G_graph.depth_first_search graph in
| None -> match_global tail let rec loop = function
end | [] -> true
| "is_not_projective" :: tail -> | "is_projective" :: tail ->
begin begin
match G_graph.is_projective graph with match G_graph.is_projective graph with
| Some _ -> match_global tail | Some _ -> false
| None -> false | None -> loop tail
end end
| x :: tail -> Error.build "Unknown global requirement \"%s\"" x in | "is_not_projective" :: tail ->
begin
match G_graph.is_projective graph with
| Some _ -> loop tail
| None -> false
end
| "is_tree" :: tail when dfs.tree -> loop tail
| "is_tree" :: _ -> false
| "is_not_tree" :: tail when not dfs.tree -> loop tail
| "is_not_tree" :: _ -> false
| "is_forest" :: tail when dfs.forest -> loop tail
| "is_forest" :: _ -> false
| "is_not_forest" :: tail when not dfs.forest -> loop tail
| "is_not_forest" :: _ -> false
| "is_cyclic" :: tail when dfs.cyclic -> loop tail
| "is_cyclic" :: _ -> false
| "is_not_cyclic" :: tail when not dfs.cyclic -> loop tail
| "is_not_cyclic" :: _ -> false
| x :: tail -> Error.build "Unknown global requirement \"%s\"" x in
loop l in
if not (match_global global) if not (match_global global)
then [] then []
......
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