diff --git a/lib/algo/algo.mli b/lib/algo/algo.mli
index 352842b0805faf9ccd8bf60e1a4d6a9195b37f3b..efdf853f555fdd01be52f04068cf85c0e2d662c2 100644
--- a/lib/algo/algo.mli
+++ b/lib/algo/algo.mli
@@ -1,4 +1,4 @@
-(* 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
diff --git a/lib/sasacore/topology.ml b/lib/sasacore/topology.ml
index baa14d953e3ef4bd30e7ef5e31541a2988ae6896..d9a7b40b15c8f3108423b9f9209fb562aa274725 100644
--- a/lib/sasacore/topology.ml
+++ b/lib/sasacore/topology.ml
@@ -1,4 +1,4 @@
-(* 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 *)
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index 6cd7cf0cd45b161824307a171b8c63a88e138152..14b3841de2f5b883bfbdc6bd0210ef76f0386079 100644
--- a/src/sasaMain.ml
+++ b/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 ()
diff --git a/test/dijkstra-ring/config.ml b/test/dijkstra-ring/config.ml
index b6dc28452145c3f7a381e05e4e0901ed8803d42a..97f0c070a56a6b1b18930bc307ce33d15bbc7fd8 100644
--- a/test/dijkstra-ring/config.ml
+++ b/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
;;
diff --git a/test/dijkstra-ring/p.ml b/test/dijkstra-ring/p.ml
index 3698b449dbe0211478a29de9c0219dac34706eea..64102a243558dc9c2aaedc9161c30dafd8c3bbce 100644
--- a/test/dijkstra-ring/p.ml
+++ b/test/dijkstra-ring/p.ml
@@ -1,4 +1,4 @@
-(* 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) =
diff --git a/test/k-clustering/config.ml b/test/k-clustering/config.ml
index 705f516c554498ffcf4413be282c6e975c48f9e5..8cbc35bc689c9ac9deb3a7ff6200fb36d4343b5d 100644
--- a/test/k-clustering/config.ml
+++ b/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
diff --git a/test/k-clustering/p.ml b/test/k-clustering/p.ml
index bef8df291239231ca0cf811560820fde9ecc3831..7309645f94ac42cb823a103625af1b62f8408be0 100644
--- a/test/k-clustering/p.ml
+++ b/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