refactor: minor improvements

lib/algo/algo.mli

-(* Time-stamp: <modified the 19/10/2021 (at 23:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 25/04/2022 (at 15:40) by Erwan Jahier> *)
 (** {1 The Algorithm programming Interface}
 
     A SASA process is an instance of an algorithm defined via this
@@ -151,6 +151,8 @@ val level : string (* the node id *) -> int
    for the tree root. *)
 val parent : string (* the node id *) -> int option
 
+(** returns [true] iff [is_tree]  returns [true], and exactly one node
+   name contains the string "root" *)
 val is_rooted_tree : unit -> bool
 
 (** It is possible to set some global parameters in the dot file

lib/sasacore/topology.ml

-(* Time-stamp: <modified the 01/09/2021 (at 10:50) by Erwan Jahier> *)
+(* Time-stamp: <modified the 11/05/2022 (at 11:28) by Erwan Jahier> *)
 
 open Graph
 open Graph.Dot_ast
@@ -346,6 +346,7 @@ let children_out g pid =
 
 (* Donne les enfants d'un noeud dans un in-out-tree *)
 let children_in_out g pid =
+  assert (is_rooted_tree g);
   let succ = g.succ pid in
   if is_root_pid pid then succ
   else List.tl succ
@@ -363,6 +364,7 @@ let parent_out g pid =
   | id::_ -> Some id
 
 let parent_in_out g pid =
+  assert (is_rooted_tree g);
   if is_root_pid pid then None
   else Some (List.hd (g.succ pid))
   (* Le parent est le premier dans la liste succ pour un in-out-tree ou un rooted-tree *)

src/sasaMain.ml

@@ -82,10 +82,12 @@ let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuS
   fun log n i activate_val st ->
   (* 1: Get enable processes *)
   let verb = !Register.verbose_level > 0 in
-  if verb then Printf.fprintf log "==> SasaSimuState.simustp :1: Get enable processes\n%!";
+  if verb then Printf.fprintf log "==> SasaSimuState.simustep :1: Get enable processes\n%!";
   let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
+  if verb then Printf.fprintf log "==> SasaSimuState.simustep: Get the potential\n%!";
   let pot = try string_of_float (SimuState.compute_potentiel st) with _ -> "" in
   let pl = st.network in
+  if verb then Printf.fprintf log "==> SasaSimuState.simustep: is it legitimate?\n%!";
   let leg = legitimate st in
   let st, all, enab_ll =
     if
@@ -151,7 +153,7 @@ let rec (simuloop: out_channel -> int -> int -> string -> 'v SimuState.t -> int)
   fun log n i activate_val st ->
   let rec loop i activate_val st =
     if !Register.verbose_level > 0 then
-      Printf.fprintf log "==> SasaSimuState.simuloop %d/%d \n%!" i n;
+      Printf.fprintf log "==> SasaSimuState.simuloop %d/%d \n%!" (n-i) n;
     let st, next_activate_val = simustep log n i activate_val st in
     if i > 0 then loop (i-1) next_activate_val st else (
       print_string "#q\n"; flush_all ()

test/dijkstra-ring/config.ml

@@ -2,14 +2,14 @@ open Algo
 open State
 
 (** Computes the value Z of the book, that is 0 if the values are convex,
-  * and the minimum number of incrementations the root has to do so that its value
-  * is different to every other value of the ring. 
-  *
-  * A disposition is convex if there is no value that is the same than the root seperated from the
-  * root with another value.
-  * 2 2 2 3 0 1 3 -> convex
-  * 2 4 5 3 0 1 3 -> convex
-  * 2 2 2 3 0 2 3 -> not convex
+  and the minimum number of incrementations the root has to do so that its value
+  is different to every other value of the ring. 
+  
+  A configuration is convex if there is no value that is the same than the root 
+  seperated from the root with another value.
+  2 2 2 3 0 1 3 -> convex, z=0
+  2 4 5 3 0 1 3 -> convex, z=0
+  2 2 2 3 0 2 3 -> not convex, z=2
 *)
 module IntSet = Set.Make(Int)
     
@@ -22,7 +22,7 @@ let compute_Z root root_st (get: Algo.pid -> State.t * (State.t Algo.neighbor *
     let next_st, next = 
       match get pid with 
         (_, [s,n]) -> state s, n | _ ->
-                failwith "Can't compute the cost of a topology that is not a directed ring"
+        failwith "Can't compute the cost of a topology that is not a directed ring"
     in
     if next = root then res
     else
@@ -51,16 +51,16 @@ let compute_sd (root: pid) (get: Algo.pid -> State.t * (State.t Algo.neighbor *
     else
     let st, ((n_state, neighbor): 's * pid) = 
       match get pid with 
-        (st, [n]) -> st, n | _ ->
-                failwith "Can't compute the cost of a topology that is not a directed ring"
+        (st, [n]) -> st, n
+      | _ -> failwith "Can't compute the cost of a topology that is not a directed ring"
     in
     let total = if (P.enable_f st [n_state]) <> [] then total + rang else total in
     compute neighbor total (rang+1)
   in
   let succ: pid = 
     match get root with 
-      (_, [_, n]) -> n | _ ->
-            failwith "Can't compute the cost of a topology that is not a directed ring"
+    | (_, [_, n]) -> n
+    | _ -> failwith "Can't compute the cost of a topology that is not a directed ring"
   in
   compute succ 0 1
 ;;

test/dijkstra-ring/p.ml

-(* Time-stamp: <modified the 01/09/2020 (at 17:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/05/2022 (at 09:46) by Erwan Jahier> *)
 
 open Algo
 
@@ -6,13 +6,21 @@ let k = card()
 open State
 let (init_state: int -> string -> 's) =
   fun _ _ ->
+  (* This algo is meant to work on directed rings *)
+  assert(is_directed());
+  assert(is_cyclic());
+  assert(is_connected());
+  assert(mean_degree() = 2.0);
+  assert(min_degree() = 2);
     (*     let k = (card() - 1) in *)
     (*     let _ = assert (k > 0) in *)
     { root = false ; v = Random.int k }
 
 let (enable_f: 's -> 's neighbor list -> action list) =
   fun e nl ->
-    let pred = match nl with [n] -> n | _ -> assert false in
+  let pred = match nl with [n] -> n | _ ->
+    failwith "Error: the topology should be a directed ring!\n%!"
+  in
     if e.v <> (state pred).v then ["T"] else []
   
 let (step_f : 's -> 's neighbor list -> action -> 's) =

test/k-clustering/config.ml

@@ -12,7 +12,7 @@ let rec (pot : pid -> (pid -> ('a * ('a neighbor*pid) list)) -> int -> int -> in
     let s, nl = get pid in
     let nl2 = List.map fst nl in
     let acc = if P.enable_f s nl2 <> [] then (
-        (*         if debug then Printf.printf "%s -> acc=%d+%d\n%!" pid acc level ; *)
+        if debug then Printf.printf "%s -> acc=%d+%d\n%!" pid acc level ; 
         acc+level
       )
       else acc in

test/k-clustering/p.ml

@@ -13,10 +13,10 @@ open State
   
 let isRoot p = p.isRoot
 
-let (isShort: 'st -> bool) =
+let (isShort: State.t -> bool) =
   fun p -> p.alpha < k
 
-let (isTall: 'st -> bool) =
+let (isTall: State.t -> bool) =
   fun p -> p.alpha >= k
 
 (* Actually unused *)
@@ -24,49 +24,58 @@ let (kDominator: 'v -> bool) =
   fun p -> (p.alpha = k) || ((isShort p) && (isRoot p)) 
 
 
-let rec (shortChildren: State.t neighbor list -> State.t list) =
-  fun nl ->
-  List.filter isShort (List.map state nl)
+let (children: State.t -> State.t list -> State.t list) =
+  fun p nl ->
+  List.filter (fun q -> q.par = reply q) nl
+    
+let (shortChildren: State.t -> State.t list -> State.t list) =
+  fun p nl ->
+  let cl = List.filter (children p) nl in
+  List.filter isShort cl
 
-let rec (tallChildren: State.t neighbor list -> 'st list) =
-  fun nl ->
-  List.filter isTall (List.map state nl)
+let (tallChildren: State.t -> State.t list -> State.t list) =
+  fun p nl ->
+  let cl = List.filter (children p) nl in
+  List.filter isTall cl
 
-let rec (max: 'st list -> int -> int) =
+let rec (max: State.t list -> int -> int) =
   fun sl cur ->
   match sl with
     [] -> cur
   | s::liste -> if (s.alpha) > cur then max liste (s.alpha) else max liste cur
   
-let rec (min: 'st list -> int -> int) =
+let rec (min: State.t list -> int -> int) =
   fun sl cur ->
   match sl with
     [] -> cur
   | s::liste -> if (s.alpha) < cur then min liste (s.alpha) else min liste cur
   
-let (maxAShort: 'st neighbor list -> int) =
-  fun nl -> max (shortChildren nl) (-1)
+let (maxAShort: State.t -> State.t list -> int) =
+  fun p nl -> max (shortChildren p nl) (-1)
 
-let (minATall: 'st neighbor list -> int) =
-  fun nl -> min (tallChildren nl) (2*k+1)
+let (minATall: State.t -> State.t list -> int) =
+  fun p nl -> min (tallChildren p nl) (2*k+1)
 
-let (newAlpha: 'st neighbor list -> int) =
-  fun nl ->
-  let mas = (maxAShort nl) in
-  let mit = (minATall nl) in
-  if (mas + mit) <= (2*k - 2) then (mit + 1) else (mas + 1)
-  
+let (newAlpha: State.t -> State.t neighbor list -> int) =
+  fun p nl ->
+  let nl = List.map state nl in
+  let mas = (maxAShort p nl) in
+  let mit = (minATall p nl) in
+  let res = if (mas + mit) <= (2*k - 2) then (mit + 1) else (mas + 1) in
+  (*   Printf.printf "newAlpha -> %d\n%!" res; *)
+  res
 (*end macros*)
 
-let (init_state: int -> string -> 'st) =
+let (init_state: int -> string -> State.t) =
   fun _ pid ->
+  (* assert(is_tree()); *)
   {
     isRoot = pid = "root"; (* ZZZ: The root of the tree should be named "root"! *)
     alpha = Random.int (2*k+1)
   }   
       
-let (enable_f: 'st -> 'st neighbor list -> action list) =
-  fun p nl -> if (p.alpha <> (newAlpha nl)) then ["change_alpha"] else []
+let (enable_f: State.t -> State.t neighbor list -> action list) =
+  fun p nl -> if (p.alpha <> (newAlpha p nl)) then ["change_alpha"] else []
 
-let (step_f : 'st -> 'st neighbor list -> action -> 'st ) =
+let (step_f : State.t -> State.t neighbor list -> action -> State.t ) =
   fun p nl a -> if a = "change_alpha" then {p with alpha = (newAlpha nl)} else assert false