refactor: compute if a graph is a rooted tree instead of relying on a graph attribute

lib/sasacore/register.ml

-(* Time-stamp: <modified the 27/07/2021 (at 10:36) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/08/2021 (at 14:21) by Erwan Jahier> *)
 
 type 's neighbor = {
   state:  's ;
@@ -303,11 +303,14 @@ let sub_tree_size : (string -> int) =
 
 let parent : (string -> int option) =
   fun pid ->
+  if is_tree () then (
     match tbls.parent with
     | Some p -> p pid
     | None ->
       let p = Topology.get_parent (get_topology ()) in
       tbls.parent <- Some p; p pid
+  )
+  else not_a_tree ()
 
 
 let (links_number : unit -> int) =
@@ -351,6 +354,4 @@ let (graph_attribute_list: unit -> (string * string)  list) =
     Hashtbl.fold (fun n v acc -> (n,v)::acc) tbls.graph_attributes []
 
 let (is_rooted_tree : unit -> bool) = fun () ->
-  match get_graph_attribute_opt "is_rooted" with
-  | None -> false
-  | Some str -> bool_of_string str
+  Topology.is_rooted_tree (get_topology ())

lib/sasacore/topology.ml

-(* Time-stamp: <modified the 09/04/2021 (at 10:58) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/08/2021 (at 14:30) by Erwan Jahier> *)
 
 open Graph
 open Graph.Dot_ast
@@ -281,15 +281,21 @@ let is_cyclic : t -> bool =
   fun g ->
   if g.directed then directed_is_cyclic g else non_directed_is_cyclic g
 
-
 let is_tree : t -> bool =
   fun g ->
   (not (is_cyclic g)) && (is_connected g)
 
+let is_root_pid pid = Str.string_match (Str.regexp ".*root.*") pid 0
+let is_root_node n = is_root_pid n.id
+
+(* cf algo.mli for the spec *)
+let is_rooted_tree : t -> bool =
+  fun g ->
+  is_tree g && List.length (List.filter is_root_node g.nodes) = 1
 
 (** Returns the channel number that let [p_neighbor] access to the
    content of [p], if [p] is a neighbor of [p_neighbor].  Returns -1 if
-   [p] is not a neigbhbor of [p_neigbor], which can happen in directed
+   [p] is not a neighbor of [p_neighbor], which can happen in directed
    graphs. *)
 let (reply: t -> string -> string -> int) =
   fun g p p_neighbor  ->
@@ -307,16 +313,24 @@ let (reply_pred: t -> string -> string -> int) =
     in
     f 0 (g.pred p_neighbor)
 
+(* count the occurrences of x in l *)
+let _count x l =
+  let rec f acc = function
+    | [] -> acc
+    | y::t -> f (if x=y then acc+1 else acc) t
+  in
+  f 0 l
+
 let is_in_tree g =
+  g.directed && (* redundant, but more efficient *)
   (is_tree g) &&
   (List.for_all (fun n -> List.length (g.pred n.id) <= 1) g.nodes)
 
 let is_out_tree g =
+  g.directed && (* redundant, but more efficient *)
   (is_tree g) &&
   (List.for_all (fun n -> List.length (g.succ n.id)  <= 1) g.nodes)
 
-let is_root_node _ pid =
-  pid = "root"
 
 (* Donne les enfants d'un noeud dans un in-tree (liens partent de la racine) *)
 let children_in g pid =
@@ -329,7 +343,7 @@ let children_out g pid =
 (* Donne les enfants d'un noeud dans un in-out-tree *)
 let children_in_out g pid =
   let succ = List.map snd (g.succ pid) in
-  if is_root_node g pid then succ
+  if is_root_pid pid then succ
   else List.tl succ
   (* pour tous les noeuds sauf la racine, le parent est la tête de succ
   ici on veut juste les enfants donc on enlève le premier *)
@@ -345,7 +359,7 @@ let parent_out g pid =
   | (_,id)::_ -> Some (id)
 
 let parent_in_out g pid =
-  if is_root_node g pid then None
+  if is_root_pid pid then None
   else Some (snd (List.hd (g.succ pid)))
   (* Le parent est le premier dans la liste succ pour un in-out-tree ou un rooted-tree *)
 

lib/sasacore/topology.mli

-(* Time-stamp: <modified the 21/04/2021 (at 15:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/08/2021 (at 09:25) by Erwan Jahier> *)
 
 (** {1 Topology: internal representation of Graphs } *)
 
@@ -29,6 +29,7 @@ val get_nb_link: t -> int
 val get_mean_degree : t -> float
 val is_connected : t -> bool
 val is_cyclic : t -> bool
+val is_rooted_tree : t -> bool
 val is_tree : t -> bool
 val is_in_tree : t -> bool
 val is_out_tree : t -> bool