Commit d26e88b7 authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files

subgraph

parent e6371ebe
......@@ -506,6 +506,8 @@ module type S = sig
val filter: ('a -> bool) -> 'a t -> 'a t
val filter_key: (key -> bool) -> 'a t -> 'a t
end (* module type S *)
(* ================================================================================ *)
......@@ -620,6 +622,14 @@ module Massoc_make (Ord: OrderedType) = struct
| [] -> acc
| l -> M.add key l acc
) t M.empty
let filter_key test t =
M.fold
(fun key value acc ->
if test key
then M.add key value acc
else acc
) t M.empty
end (* module Massoc_make *)
(* ================================================================================ *)
......
......@@ -264,6 +264,8 @@ sig
val filter: ('a -> bool) -> 'a t -> 'a t
val filter_key: (key -> bool) -> 'a t -> 'a t
end
(* ================================================================================ *)
......
......@@ -270,6 +270,38 @@ module G_graph = struct
let node_exists fct t = Gid_map.exists (fun _ node -> fct node) t.map
let subgraph graph seed depth =
let todo_init = List.fold_left (fun acc gid -> Gid_map.add gid depth acc) Gid_map.empty seed in
let rec loop (todo, ok) =
match Gid_map.choose_opt todo with
| None -> ok
| Some (gid, depth) ->
let node = find gid graph in
let next = G_node.get_next node in
let (new_todo, new_ok) =
if depth = 1
then (Gid_map.remove gid todo, Massoc_gid.fold_on_list (fun acc gid' _ -> Gid_set.add gid' acc) ok next)
else
let new_ok = Gid_set.add gid ok in
let new_todo =
Massoc_gid.fold_on_list
(fun acc gid' _ ->
if (Gid_set.mem gid' new_ok) || (Gid_map.mem gid' todo)
then acc
else Gid_map.add gid' (depth-1) acc
) (Gid_map.remove gid todo) next in
(new_todo, new_ok) in
loop (new_todo, new_ok) in
let selected_nodes = loop (todo_init, Gid_set.empty) in
let sub_map = Gid_set.fold
(fun gid acc ->
let node = find gid graph in
let new_next = Massoc_gid.filter_key (fun gid -> Gid_set.mem gid selected_nodes) (G_node.get_next node) in
let new_node = G_node.set_next new_next node in
Gid_map.add gid new_node acc
) selected_nodes Gid_map.empty in
{empty with map= sub_map}
let fold_gid fct t init =
Gid_map.fold (fun gid _ acc -> fct gid acc) t.map init
......
......@@ -255,6 +255,7 @@ module G_graph: sig
val to_raw: config:Conllx_config.t -> t -> (string * string) list * (string * string) list list * (int * string * int) list
val subgraph: t -> Gid_map.key list -> int -> t
end (* module G_graph *)
(* ================================================================================ *)
......
......@@ -826,6 +826,11 @@ module Matching = struct
) exts
) matching_list in
List.map fst filtered_matching_list
let subgraph graph matching depth =
let gid_list = Pid_map.fold (fun _ gid acc -> gid :: acc) matching.n_match [] in
G_graph.subgraph graph gid_list depth
end (* module Matching *)
(* ================================================================================ *)
......
......@@ -56,6 +56,8 @@ module Matching : sig
val get_string_value_opt: config:Conllx.Conllx_config.t -> string -> Pattern.t -> G_graph.t -> t -> string option
val whether: config:Conllx.Conllx_config.t -> Pattern.basic -> Pattern.t -> G_graph.t -> t -> bool
val subgraph: G_graph.t -> t -> int -> G_graph.t
end
(* ================================================================================ *)
......
......@@ -120,6 +120,11 @@ module Matching = struct
Libgrew.handle ~name:"Matching.whether" (fun () ->
Grew_rule.Matching.whether ~config extension pattern graph matching
) ()
let subgraph graph matching depth =
Libgrew.handle ~name:"Matching.subgraph" (fun () ->
Grew_rule.Matching.subgraph graph matching depth
) ()
end
(* ==================================================================================================== *)
......
......@@ -101,6 +101,8 @@ module Matching: sig
val get_value_opt: config:Conllx_config.t -> string -> Pattern.t -> Grew_graph.G_graph.t -> t -> string option
val whether: config:Conllx_config.t -> Pattern.basic -> Pattern.t -> Grew_graph.G_graph.t -> t -> bool
val subgraph: Grew_graph.G_graph.t -> t -> int -> Grew_graph.G_graph.t
end
(* ==================================================================================================== *)
......
Supports Markdown
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