gg: fix the computation of degrees for rings

lib/sasacore/topology.ml

-(* Time-stamp: <modified the 24/08/2020 (at 11:25) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/11/2020 (at 21:58) by Erwan Jahier> *)
 
 open Graph
 open Graph.Dot_ast
@@ -157,17 +157,22 @@ let (to_adjacency: t -> bool array array) =
       )
       t.nodes;
     m
-let (get_degree:t -> int*int) =
-  fun t -> if t.nodes = [] then 0,0
-    else
-      let node_deg n = List.length (t.succ (n.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)
+
+let (get_degree: t -> int*int) =
+  fun t ->
+  match t.nodes with
+  | [] -> 0,0
+  | n::tl ->
+    let node_deg n = List.length (t.succ (n.id)) in
+    let d0 = node_deg n in
+    let dmin, dmax = List.fold_left
+      (fun (d_min,d_max) n ->
+         (min (node_deg n) d_min, max (node_deg n) d_max)
+      )
+      (d0, d0)
+      tl
+    in
+    if t.directed then 2*dmin, 2*dmax else dmin, dmax
 
 let (get_nb_link: t -> int) =
   fun t ->

tools/gg/classicGraph.ml

@@ -45,20 +45,37 @@ let (gen_star: bool -> int -> Topology.t) =
     attributes = []
   }
 
-let neighbours_ring : (node_id list -> (node_id -> (int * node_id) list)) = 
-  fun nodes ->
+let rec list_iter3 f l1 l2 l3 =
+  match (l1, l2, l3) with
+    ([], [], []) -> ()
+  | (a1::l1, a2::l2, a3::l3) -> f a1 a2 a3; list_iter3 f l1 l2 l3
+  | (_, _, _) -> invalid_arg "list_iter3"
+
+
+let neighbours_ring : bool -> (node_id list -> (node_id -> (int * node_id) list)) = 
+  fun dir nodes ->
   let node_succ:node_succ_t = Hashtbl.create (length nodes) in
-  let nodes2 = (List.tl nodes)@[List.hd nodes] in
-  List.iter2 (fun n1 n2 -> Hashtbl.replace node_succ n1 [1,n2]) nodes nodes2;
+  let nodes2, nodes3 = match nodes with
+    | n1::n2::t -> (n2::t)@[n1], t@[n1;n2]
+    | _ ->  assert false
+  in
+  list_iter3 (fun n1 n2 n3 ->
+      if dir then
+        Hashtbl.replace node_succ n2 [1,n3]
+      else
+        Hashtbl.replace node_succ n2 [(1,n3);(1,n1)]
+    )
+    nodes nodes2 nodes3;
   (fun n -> try Hashtbl.find node_succ n with Not_found -> [])
 
+
 let (gen_ring: bool -> int -> Topology.t) =
   fun directed nb ->
   let nodes = (create_nodes "p" (0,nb)) in
   let nl = id_to_empty_nodes nodes in
   {
     nodes = nl;
-    succ = neighbours_ring nodes;
+    succ = neighbours_ring directed nodes;
     of_id = get_of_id nl;
     directed = directed;
     attributes = []