Added everything (graph, degree...), and put diameter in its own module.

lib/algo/algo.ml

@@ -75,3 +75,12 @@ let (register : 's to_register -> unit) =
 
 
 let card = Register.card
+let degree_min = Register.degree_min
+let mean_degree = Register.mean_degree
+let degree_max = Register.degree_max
+let is_cyclic = Register.is_cyclic
+let is_connected = Register.is_connected
+let is_tree = Register.is_tree
+let height = Register.height
+let links_number = Register.links_number
+let diameter = Register.diameter
\ No newline at end of file

lib/algo/algo.mli

@@ -47,5 +47,14 @@ val register : 's to_register -> unit
   
 (** Topological infos *)
 val card : unit -> int
+val degree_min : unit -> int
+val mean_degree : unit -> float
+val degree_max : unit -> int
+val is_cyclic : unit -> bool
+val is_connected : unit -> bool
+val is_tree : unit -> bool
+val height : unit -> (string -> int) option
+val links_number : unit -> int
+val diameter : unit -> int
 (* val degree : unit -> int *)
 (* val diameter : unit -> int *)

lib/sasacore/diameter.ml

+
+(* take a string and the list of all node and return the position of the node in the list *)                          
+let (pos:string -> Topology.node list -> int) =
+  fun nid lid -> List.fold_right (fun lid i -> if (nid=lid.Topology.id) then 0 else  i + 1 ) lid 0
+
+(* take a graph t and return the Adjacency matrix of t *)                                 
+let (gtom: Topology.t -> int array array) =
+  fun t->
+  let taille = List.length t.nodes in
+  let mat = Array.make_matrix (taille) (taille) 0 in
+  List.iter (fun n -> (List.iter (fun (_,m) ->  mat.(pos n.Topology.id t.nodes).(pos m t.nodes) <- 1 )
+                         (t.succ n.Topology.id) ) ) (t.nodes);
+  mat
+
+    
+(* Initialize the Adjacency matrix for Floyd Warshall algorithm *)
+let (initFW: int array array -> int array array) =
+  fun m ->
+  let n = (Array.length m.(0)) in
+  for i=0 to (n - 1) do
+    for j=0 to (n - 1) do
+      if (i<>j) then
+        (if (m.(i).(j)=1) then m.(i).(j) <- 1 else m.(i).(j) <- n+1)
+          else m.(i).(j) <- 0
+      done;
+  done;
+  m
+
+
+(* Apply Floyd Warshall algorithm which give the matrix of all pairs shortest path *)
+let (floydwarshall:int array array -> int array array) =
+  fun m ->
+  let w = initFW m in 
+  let n = (Array.length m.(0)) in
+  for k=0 to (n - 1) do
+    for i=0 to (n - 1) do
+      for j=0 to (n - 1) do
+        w.(i).(j) <- (min (w.(i).(j)) (w.(i).(k) + w.(k).(j)))
+        done;
+      done;
+  done;
+  w
+
+
+(* return the greatest int of a matrix *)
+let (max_mat: int array array -> int) =
+  fun m ->
+  let n = (Array.length m.(0)) in
+  let maxi = ref (-1) in
+      for i=0 to (n - 1) do
+        for j=0 to (n - 1) do
+          maxi := max !maxi m.(i).(j)
+        done;
+      done;
+      !maxi
+
+(* take a graph t in argument and return the diameter *)
+let (get: Topology.t -> unit -> int ) =
+  fun t () ->
+  (max_mat(floydwarshall (gtom t)))
\ No newline at end of file

lib/sasacore/diameter.mli

+val get : Topology.t -> unit -> int

lib/sasacore/register.ml

@@ -21,8 +21,19 @@ type 's internal_tables = {
   value_to_string  : (string, Obj.t) Hashtbl.t;
   value_of_string  : (string, Obj.t) Hashtbl.t;
   copy_value  : (string, Obj.t) Hashtbl.t;
-  mutable card : int 
-}
+  mutable card : int;
+
+  mutable deg_min : int;
+  mutable mean_deg : float; 
+  mutable deg_max : int;
+  mutable is_cyclic : bool; 
+  mutable is_connected : bool; 
+  mutable is_tree : bool; 
+  mutable height : (string -> int) option; 
+  mutable links_number : int; 
+  mutable diameter : int option;
+  mutable diameter_fun : unit -> int
+  }
 
 let (tbls:'s internal_tables) = {
   init_state = Hashtbl.create 1;
@@ -32,7 +43,18 @@ let (tbls:'s internal_tables) = {
   value_to_string   = Hashtbl.create 1;
   value_of_string   = Hashtbl.create 1;
   copy_value   = Hashtbl.create 1;
-  card      = (-1)
+  card      = (-1);
+
+  deg_min      = (-1);
+  mean_deg     = (-1.);
+  deg_max      = (-1);
+  is_cyclic    = false;
+  is_connected = false;
+  is_tree      = false;
+  height       = None;
+  links_number = (-1);
+  diameter     = None;
+  diameter_fun = (fun () -> -1)
 }
 
 let verbose_level = ref 0
@@ -127,11 +149,72 @@ let (get_copy_value : unit ->  ('s -> 's)) = fun () ->
 
 let (card : unit -> int) =
   fun () -> tbls.card
-    
+
+let (degree_min : unit -> int) = 
+  fun () -> tbls.deg_min
+
+let (mean_degree : unit -> float) = 
+  fun () -> tbls.mean_deg
+
+let (degree_max : unit -> int) = 
+  fun () -> tbls.deg_max
+
+let (is_cyclic : unit -> bool) = 
+  fun () -> tbls.is_cyclic
+
+let (is_connected : unit -> bool) = 
+  fun () -> tbls.is_connected
+
+let (is_tree : unit -> bool) = 
+  fun () -> tbls.is_tree
+
+let height : (unit -> (string -> int) option) = 
+  fun () -> tbls.height
+
+let (links_number : unit -> int) = 
+  fun () -> tbls.links_number
+
+let (diameter : unit -> int) = 
+  fun () -> 
+  match tbls.diameter with
+  | None -> (let d = (tbls.diameter_fun ()) in tbls.diameter <- Some d; d)
+  | Some d -> d
+  
+
+
 let (set_card : int -> unit) =
   fun i ->
     tbls.card <- i
 
+
+let (set_degrees : int*int -> unit) = 
+  fun (min,max) -> 
+  tbls.deg_min <- min;
+  tbls.deg_max <- max
+
+let (set_mean_deg : float -> unit) = 
+  fun m -> 
+  tbls.mean_deg <- m
+
+let (set_is_cyclic : bool -> unit) = 
+  fun b -> tbls.is_cyclic <- b
+
+let (set_is_connected : bool -> unit) = 
+  fun b -> tbls.is_connected <- b
+
+let (set_is_tree : bool -> unit) = 
+  fun b -> tbls.is_tree <- b
+
+let set_height : ((string -> int) -> unit) = 
+  fun f -> tbls.height <- Some f
+
+let (set_links_number : int -> unit) = 
+  fun l_nb -> tbls.links_number <- l_nb
+
+let set_diameter : ((unit -> int) -> unit) = 
+  fun f -> tbls.diameter_fun <- f
+
+
 let (to_string : 's -> string) =
   fun v ->
     (get_value_to_string ()) v

lib/sasacore/register.mli

@@ -32,10 +32,29 @@ val get_value_of_string : unit -> (string -> 's) option
 val get_copy_value : unit -> ('s -> 's)
 val to_string : 's -> string
 val set_card : int -> unit
+
+val set_degrees : int*int -> unit
+val set_mean_deg : float -> unit
+val set_is_cyclic : bool -> unit
+val set_is_connected : bool -> unit
+val set_is_tree : bool -> unit
+val set_height : (string -> int) -> unit
+val set_links_number : int -> unit
+val set_diameter : (unit -> int) -> unit
 (* val set_degree :  int -> unit *)
 (* val set_diameter : int -> unit *)
 
 val card : unit -> int
+
+val degree_min : unit -> int
+val mean_degree : unit -> float
+val degree_max : unit -> int
+val is_cyclic : unit -> bool
+val is_connected : unit -> bool
+val is_tree : unit -> bool
+val height : unit -> (string -> int) option
+val links_number : unit -> int
+val diameter : unit -> int
 (* val degree : unit -> int *)
 (* val diameter : unit -> int *)
 

lib/sasacore/sasa.ml

@@ -146,7 +146,71 @@ let (env_rif_decl: SasArg.t -> 'v Process.t list -> string) =
     let ssl = get_outputs_rif_decl args pl in
     String.concat " "
       (List.map (fun (base, tstr) -> Printf.sprintf "\"%s\":%s" base tstr) ssl)
-    
+
+(***********************************************************)
+(*********       Added by Gwennan and Nathan       *********)
+(***********************************************************)
+
+let (get_degree:Topology.t -> int*int) =
+  fun t -> if t.nodes = [] then 0,0
+    else
+      let node_deg n = List.length (t.succ (n.Topology.id)) in
+      let d_start = node_deg ((List.hd t.nodes)) in
+      List.fold_left (fun (d_min,d_max) n -> (min (node_deg n) d_min, max (node_deg n) d_max)
+      ) (d_start,d_start) (List.tl t.nodes)
+
+    (* take a graph t and a boolean o (for know if the graph is oriented or not) and return the number of link in the graph *)
+let (get_nb_link: Topology.t -> bool -> int) =
+  fun t o ->
+  if not o then (List.fold_left (fun acc n -> ((List.length (t.succ n.Topology.id))) + acc) (0) (t.nodes)) / 2
+    else (List.fold_left (fun acc n -> ((List.length (t.succ n.Topology.id))) + acc) (0) (t.nodes))
+
+let (get_mean_degree : Topology.t -> float) = 
+  fun t -> 
+    (float_of_int (get_nb_link t true)) /. (float_of_int (List.length t.nodes))
+
+let bfs : (Topology.t -> string -> bool * string list) = 
+  fun t n ->
+    let q = Queue.create () in
+    let discovered = ref [n] and parent = ref (function _ -> "") in
+    let cyclic = ref false in
+    Queue.add n q;
+    while not (Queue.is_empty q) do
+      let node = Queue.take q in
+      parent := List.fold_left (fun parents (_,suc) -> 
+                  if List.for_all (fun disc -> disc <> suc) !discovered 
+                  then (
+                    Queue.add suc q;
+                    discovered := (suc)::!discovered;
+                    function a -> if a = suc then node else parents a
+                  ) else ((
+                    if suc <> (parents node) 
+                    then 
+                      cyclic := true);
+                    parents
+                  )
+                ) !parent (t.succ node)
+
+    done;
+    (!cyclic, !discovered)
+
+let is_connected_and_cyclic : Topology.t -> bool*bool = 
+  fun t -> match t.nodes with
+    | [] -> (false,false)
+    | hd::_ -> let (cyclic,bfs_nodes) = (bfs t hd.Topology.id) in ((List.compare_lengths t.nodes bfs_nodes) = 0, cyclic)
+
+let rec height : string list -> Topology.t -> string -> int = 
+  fun p t n ->
+    (List.fold_left (fun h (_,succ) -> 
+      if List.exists (fun par -> par = succ) p then h else max h (height (n::p) t succ)) (-1) (t.succ n)) + 1
+
+let get_height : Topology.t -> string -> int = 
+  fun t -> 
+    height ([]) t
+
+(***********************************************************)
+(***********************************************************)
+
 let (make : bool -> string array -> 'v t) =
   fun dynlink argv ->
     let args = 
@@ -168,6 +232,19 @@ let (make : bool -> string array -> 'v t) =
       let nidl = List.map (fun n -> n.Topology.id) nl in
       let nstr = String.concat "," nidl in
       Register.set_card (List.length nl);
+      (*****************************)
+      Register.set_degrees (get_degree g);
+      Register.set_mean_deg (get_mean_degree g);
+      let (connected, cyclic) = is_connected_and_cyclic g in
+      Register.set_is_cyclic cyclic;
+      Register.set_is_connected connected;
+      let is_tree = ((not cyclic) && connected) in
+      Register.set_is_tree is_tree;
+      if is_tree then Register.set_height (get_height g);
+      Register.set_links_number (get_nb_link g false);
+      Register.set_diameter (Diameter.get g);
+      (*****************************)
+
       Register.verbose_level := args.verbose;
       Random.init args.seed;
       if !Register.verbose_level > 0 then Printf.eprintf "nodes: %s\nedges:\n" nstr;