From 220c5cc2c2e1785848ac4377ca0a9e0ce55ccbd5 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Tue, 4 May 2021 08:50:28 +0200
Subject: [PATCH] Chore: use a string map instead of an assoc list for getting
pid's neighbors
---
lib/sasa/sasaRun.ml | 29 +++++++-----------
lib/sasacore/daemon.ml | 62 +++++++++++++++++++-------------------
lib/sasacore/daemon.mli | 9 +++---
lib/sasacore/evil.ml | 30 +++++++++---------
lib/sasacore/evil.mli | 12 +++++---
lib/sasacore/simuState.ml | 38 ++++++++++++++++++-----
lib/sasacore/simuState.mli | 14 ++++++---
src/sasaMain.ml | 46 +++++++++-------------------
test/coloring/config.ml | 1 +
9 files changed, 123 insertions(+), 118 deletions(-)
diff --git a/lib/sasa/sasaRun.ml b/lib/sasa/sasaRun.ml
index f51feb52..5b2301cf 100644
--- a/lib/sasa/sasaRun.ml
+++ b/lib/sasa/sasaRun.ml
@@ -18,7 +18,7 @@ open Process
let (from_sasa_env : 'v SimuState.t -> RdbgPlugin.sl) =
fun st ->
List.fold_left
- (fun acc (p,_) ->
+ (fun acc p ->
let state = Env.get st.config p.pid in
let sl = SasaState.to_rdbg_subst p.pid state in
acc@sl
@@ -37,18 +37,14 @@ let (get_sl_out: bool -> 'v Process.t list -> bool list list -> RdbgPlugin.sl) =
pl ll
)
+module StringMap = Map.Make(String)
let (compute_potentiel: 'v SimuState.t -> RdbgPlugin.sl) =
fun st ->
match Register.get_potential () with
| None -> []
| Some user_pf ->
- let pidl = List.map (fun (p,_) -> p.Process.pid) st.network in
- let get_info pid =
- let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) st.network) in
- Env.get st.config pid,
- List.map (fun n -> n, n.Register.pid) nl
- in
- let p = (user_pf pidl get_info) in
+ let pidl = List.map (fun p -> p.Process.pid) st.network in
+ let p = user_pf pidl (SimuState.neigbors_of_pid st) in
[("potential", Data.F p)]
let (compute_legitimate: bool -> 'v SimuState.t -> bool) =
@@ -57,18 +53,13 @@ let (compute_legitimate: bool -> 'v SimuState.t -> bool) =
match Register.get_legitimate () with
| None -> silent
| Some f ->
- let pidl = List.map (fun (p,_) -> p.Process.pid) st.network in
- let get_info pid =
- let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) st.network) in
- Env.get st.config pid,
- List.map (fun n -> n, n.Register.pid) nl
- in
- f pidl get_info
+ let pidl = List.map (fun p -> p.Process.pid) st.network in
+ f pidl (SimuState.neigbors_of_pid st)
open SimuState
let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
fun argv st ->
- let pl = fst (List.split st.network) in
+ let pl = st.network in
let prog_id = Printf.sprintf "%s (with sasa Version %s)"
(String.concat " " (Array.to_list argv)) SasaVersion.str
in
@@ -111,7 +102,8 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
(* if was_silent then failwith "Silent"; *)
(* 2: read the actions from the outside process, i.e., from sl_in *)
let _, pnal = Daemon.f st.sasarg.dummy_input
- (st.sasarg.verbose > 0) st.sasarg.daemon st.network st.config pre_pnall pre_enab_ll
+ (st.sasarg.verbose > 0) st.sasarg.daemon st.network
+ (SimuState.neigbors_of_pid st) st.config pre_pnall pre_enab_ll
(get_action_value sl_in)
in
(* 3: Do the steps *)
@@ -148,7 +140,8 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
else
(* 2: read the actions from the outside process, i.e., from sl_in *)
let activate_val, pnal = Daemon.f st.sasarg.dummy_input
- (st.sasarg.verbose > 0) st.sasarg.daemon st.network st.config pnall enab_ll
+ (st.sasarg.verbose > 0) st.sasarg.daemon st.network (SimuState.neigbors_of_pid st)
+ st.config pnall enab_ll
(get_action_value sl_in)
in
(* 3: Do the steps *)
diff --git a/lib/sasacore/daemon.ml b/lib/sasacore/daemon.ml
index 9756932d..e4f2a3ec 100644
--- a/lib/sasacore/daemon.ml
+++ b/lib/sasacore/daemon.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/12/2020 (at 16:09) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/05/2021 (at 16:16) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
@@ -120,35 +120,35 @@ let (get_activate_val: 'v pna list -> 'v Process.t list -> bool list list)=
let al = List.map (fun (p,_,a) -> p,a) al in
List.map (List.map (fun a -> List.mem a al)) actions
-let (f: bool -> bool -> t -> ('v Process.t * 'v Register.neighbor list) list ->
- 'v Env.t -> 'v pna list list -> bool list list ->
- (string -> string -> bool) -> bool list list * 'v pna list) =
- fun dummy_input verbose_mode daemon p_nl_l e all enab get_action_value ->
+let (f: bool -> bool -> t -> 'v Process.t list ->
+ (string -> 'v * ('v Register.neighbor * string) list) -> 'v Env.t ->
+ 'v pna list list -> bool list list -> (string -> string -> bool) ->
+ bool list list * 'v pna list) =
+ fun dummy_input verbose_mode daemon pl neigbors_of_pid e all enab get_action_value ->
let nall = remove_empty_list all in
if nall = [] then assert false (* failwith "Silent" *);
- let pl = fst(List.split p_nl_l) in
- if daemon <> Custom && dummy_input then
- ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
- match daemon with
- | Synchronous ->
- let al = synchrone nall in
- get_activate_val al pl, al
- | Central ->
- let al = central nall in
- get_activate_val al pl, al
- | LocallyCentral ->
- let al = locally_central nall in
- get_activate_val al pl, al
- | Distributed ->
- let al = distributed nall in
- get_activate_val al pl, al
- | Greedy ->
- let al = Evil.greedy verbose_mode e p_nl_l nall in
- get_activate_val al pl, al
- | GreedyCentral ->
- let al = Evil.greedy_central verbose_mode e p_nl_l nall in
- get_activate_val al pl, al
- | Bad i ->
- let al = Evil.bad i e nall in
- get_activate_val al pl, al
- | Custom -> custom all pl enab get_action_value
+ if daemon <> Custom && dummy_input then
+ ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
+ match daemon with
+ | Synchronous ->
+ let al = synchrone nall in
+ get_activate_val al pl, al
+ | Central ->
+ let al = central nall in
+ get_activate_val al pl, al
+ | LocallyCentral ->
+ let al = locally_central nall in
+ get_activate_val al pl, al
+ | Distributed ->
+ let al = distributed nall in
+ get_activate_val al pl, al
+ | Greedy ->
+ let al = Evil.greedy verbose_mode e pl neigbors_of_pid nall in
+ get_activate_val al pl, al
+ | GreedyCentral ->
+ let al = Evil.greedy_central verbose_mode e pl neigbors_of_pid nall in
+ get_activate_val al pl, al
+ | Bad i ->
+ let al = Evil.bad i e nall in
+ get_activate_val al pl, al
+ | Custom -> custom all pl enab get_action_value
diff --git a/lib/sasacore/daemon.mli b/lib/sasacore/daemon.mli
index 182fca66..1c5d94fb 100644
--- a/lib/sasacore/daemon.mli
+++ b/lib/sasacore/daemon.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 30/09/2020 (at 13:53) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/05/2021 (at 16:16) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
@@ -44,7 +44,8 @@ nb: it is possible that we read on stdin that an action should be
inhibit the activation.
*)
-val f : bool -> bool -> t -> ('v Process.t * 'v Register.neighbor list) list ->
- 'v Env.t -> 'v pna list list -> bool list list ->
- (string -> string -> bool) -> bool list list * 'v pna list
+val f : bool -> bool -> t -> 'v Process.t list ->
+ (string -> 'v * ('v Register.neighbor * string) list) ->
+ 'v Env.t -> 'v pna list list -> bool list list ->
+ (string -> string -> bool) -> bool list list * 'v pna list
diff --git a/lib/sasacore/evil.ml b/lib/sasacore/evil.ml
index 732e349c..e8ed51c1 100644
--- a/lib/sasacore/evil.ml
+++ b/lib/sasacore/evil.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/12/2020 (at 10:20) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/05/2021 (at 16:17) by Erwan Jahier> *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
@@ -118,20 +118,20 @@ let time3 verb lbl f x y z =
if verb then Printf.eprintf " [%s] Execution time: %fs\n" lbl (Sys.time() -. t);
fxy
-let (greedy: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list ->
- 'v pna list list -> 'v pna list) =
- fun verb e p_nl_l all ->
+let (greedy: bool -> 'v Env.t -> 'v Process.t list ->
+ (string -> 'v * ('v Register.neighbor * string) list) -> 'v pna list list ->
+ 'v pna list) =
+ fun verb e pl neigbors_of_pid all ->
assert (all<>[]);
match Register.get_potential () with
| None -> failwith "No potential function has been provided"
| Some user_pf ->
let pf pnal = (* pnal contains a list of activated processes *)
- let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
+ let pidl = List.map (fun p -> p.Process.pid) pl in
let ne = Step.f pnal e in
let get_info pid =
- let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l) in
- Env.get ne pid,
- List.map (fun n -> n, n.Register.pid) nl
+ let _, nl = neigbors_of_pid pid in
+ Env.get ne pid, nl
in
user_pf pidl get_info
in
@@ -160,20 +160,20 @@ let (greedy: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list
if verb then Printf.eprintf " [Evil.greedy] Number of trials: %i\n%!" !cpt;
res
-let (greedy_central: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list
- -> 'v pna list list -> 'v pna list) =
- fun verb e p_nl_l all ->
+(* val greedy_central: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list -> *)
+let (greedy_central: bool -> 'v Env.t -> 'v Process.t list ->
+ (string -> 'v * ('v Register.neighbor * string) list) -> 'v pna list list -> 'v pna list) =
+ fun verb e pl neigbors_of_pid all ->
assert (all<>[]);
match Register.get_potential () with
| None -> failwith "No potential function has been provided"
| Some user_pf ->
let pf pna =
- let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
+ let pidl = List.map (fun p -> p.Process.pid) pl in
let ne = Step.f [pna] e in
let get_info pid =
- let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l) in
- Env.get ne pid,
- List.map (fun n -> n, n.Register.pid) nl
+ let _, nl = neigbors_of_pid pid in
+ Env.get ne pid, nl
in
user_pf pidl get_info
in
diff --git a/lib/sasacore/evil.mli b/lib/sasacore/evil.mli
index 10d6aa37..6cee4338 100644
--- a/lib/sasacore/evil.mli
+++ b/lib/sasacore/evil.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/12/2020 (at 10:16) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/05/2021 (at 16:17) by Erwan Jahier> *)
(** This module gathers daemons that tries to reach the worst case with
@@ -6,15 +6,17 @@
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
-(** [greedy verb e p_nl_l all] take the worst case among the combinations of
+(** [greedy verb e pl neigbors_of_pid all] take the worst case among the combinations of
length 1, i.e., O(2^n) where n is the number of enabled processes
(|all|) *)
-val greedy: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list ->
+val greedy: bool -> 'v Env.t -> 'v Process.t list ->
+ (string -> 'v * ('v Register.neighbor * string) list) ->
'v pna list list -> 'v pna list
(** Ditto, but for central daemons (of a connected component) *)
-val greedy_central: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list ->
- 'v pna list list -> 'v pna list
+val greedy_central: bool -> 'v Env.t -> 'v Process.t list ->
+ (string -> 'v * ('v Register.neighbor * string) list) -> 'v pna list list ->
+ 'v pna list
(** Returns the worst case among the combinations of length 1 for
convex potential functions, and just a bad one otherwise (O(n)
diff --git a/lib/sasacore/simuState.ml b/lib/sasacore/simuState.ml
index 787df8f1..bd1d9875 100644
--- a/lib/sasacore/simuState.ml
+++ b/lib/sasacore/simuState.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 16/04/2021 (at 15:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/05/2021 (at 08:36) by Erwan Jahier> *)
open Register
@@ -37,32 +37,49 @@ let (dump_process: string -> 'v Process.t * 'v Register.neighbor list -> unit) =
open Process
open SasArg
+module StringMap = Map.Make(String)
+
type 'v t = {
sasarg: SasArg.t;
- network: ('v Process.t * 'v Register.neighbor list) list;
+ (* network: ('v Process.t * 'v Register.neighbor list) list; *)
+ network: 'v Process.t list;
+ neighbors: ('v Register.neighbor list) Map.Make(String).t;
config: 'v Env.t
}
+let (neigbors_of_pid : 'v t -> pid -> 's * ('s neighbor * pid) list) =
+ fun st pid ->
+ let nl =
+ match StringMap.find_opt pid st.neighbors with
+ | Some x -> x
+ | None ->
+ failwith (
+ Printf.sprintf "no %s found in %s" pid
+ (String.concat "," (List.map (fun p -> p.Process.pid) st.network)))
+ in
+ Env.get st.config pid, List.map (fun n -> n, n.Register.pid) nl
+
+
let (update_neighbor_env: 'v Env.t -> 'v Register.neighbor list -> 'v Register.neighbor list) =
fun e nl ->
List.map (fun n -> { n with state = Env.get_copy e n.Register.pid }) nl
-let update_network config network = List.map
- (fun (p,nl) -> p, update_neighbor_env config nl)
- network
+let update_neighbors config neighbors = StringMap.map
+ (fun nl -> update_neighbor_env config nl)
+ neighbors
let (update_config: 'v Env.t -> 'v t -> 'v t) =
fun e st ->
let verb = !Register.verbose_level > 0 in
if verb then Printf.eprintf " ===> update_neighbor_env\n%!";
- { st with network = update_network e st.network ; config = e }
+ { st with neighbors = update_neighbors e st.neighbors ; config = e }
type 'v enable_processes =
('v Process.t * 'v Register.neighbor list * Register.action) list list * bool list list
let (get_enable_processes: 'v t -> 'v enable_processes) =
fun st ->
- let pl_n = st.network in
+ let pl_n = List.map (fun p -> p, StringMap.find p.pid st.neighbors) st.network in
let e = st.config in
assert (pl_n <> []);
let all = List.fold_left
@@ -306,9 +323,14 @@ let (make : bool -> string array -> 'v t) =
Printf.eprintf "Ignoring the first vectors of sasa inputs\n%!";
);
if !Register.verbose_level > 0 then Printf.eprintf "==> SimuState.make done !\n%!";
+ let neighbors =
+ List.fold_left (fun acc (p,nl) -> StringMap.add p.pid nl acc)
+ StringMap.empty pl_n
+ in
{
sasarg = args;
- network = pl_n;
+ network = pl;
+ neighbors = neighbors;
config = e
}
with
diff --git a/lib/sasacore/simuState.mli b/lib/sasacore/simuState.mli
index b7db9e31..6c02a144 100644
--- a/lib/sasacore/simuState.mli
+++ b/lib/sasacore/simuState.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 16/04/2021 (at 15:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/05/2021 (at 08:27) by Erwan Jahier> *)
(** The module is used by
- the main sasa simulation loop (in ../../src/sasaMain.ml)
@@ -6,10 +6,13 @@
*)
+
+
(* type 'v t = SasArg.t * 'v layout * 'v Env.t *)
type 'v t = {
sasarg: SasArg.t;
- network: ('v Process.t * 'v Register.neighbor list) list;
+ network: 'v Process.t list;
+ neighbors: ('v Register.neighbor list) Map.Make(String).t; (* pid's neigbors *)
config: 'v Env.t
}
@@ -23,9 +26,10 @@ val get_enable_processes: 'v t -> 'v enable_processes
(** update the config and network processes *)
val update_config: 'v Env.t -> 'v t -> 'v t
-
+
+(** Get pid's state and neigbors *)
+val neigbors_of_pid : 'v t -> string -> 'v * ('v Register.neighbor * string) list
+
(* For SasaRun *)
val get_inputs_rif_decl : SasArg.t -> 'v Process.t list -> (string * string) list
val get_outputs_rif_decl: SasArg.t -> 'v Process.t list -> (string * string) list
-
-
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index b6137dad..65f1918a 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -55,28 +55,20 @@ let bool_ll_to_string bll =
String.concat " "
(List.map (fun b -> if b then "t" else "f") (List.flatten bll))
-let legitimate p_nl_l e =
+open Sasacore.SimuState
+
+let legitimate st =
match Register.get_legitimate () with
| None -> false
| Some ulf ->
- let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
- let rec from_pid p_nl_l pid = (* XXX use StringMap instead *)
- match p_nl_l with
- | [] -> assert false (* sno *)
- | (p,nl)::tail ->
- if p.Process.pid = pid then
- let nl = List.map (fun n -> n,n.Register.pid) nl in
- Env.get e pid,
- nl
- else
- from_pid tail pid
- in
- ulf pidl (from_pid p_nl_l)
+ let pidl = List.map (fun p -> p.Process.pid) st.network in
+ ulf pidl (SimuState.neigbors_of_pid st)
-open Sasacore.SimuState
+module StringMap = Map.Make(String)
let inject_fault ff st =
- let update_nodes e (p,nl) =
+ let update_nodes e p =
+ let nl = StringMap.find p.Process.pid st.neighbors in
let pid = p.Process.pid in
let v = Env.get e pid in
let v = ff (List.length nl) pid v in
@@ -92,19 +84,8 @@ let (compute_potentiel: 'v SimuState.t -> string) =
match Register.get_potential () with
| None -> ""
| Some user_pf ->
- let pidl = List.map (fun (p,_) -> p.Process.pid) st.network in
- let get_info pid =
- let nl = match List.find_opt (fun (p,_) -> p.Process.pid = pid) st.network with
- None ->
- failwith (
- Printf.sprintf "no %s found in %s" pid
- (String.concat "," (List.map (fun (p,_) -> p.Process.pid) st.network)))
- | Some (_,x) -> x
- in
- Env.get st.config pid,
- List.map (fun n -> n, n.Register.pid) nl
- in
- let p = user_pf pidl get_info in
+ let pidl = List.map (fun p -> p.Process.pid) st.network in
+ let p = user_pf pidl (SimuState.neigbors_of_pid st) in
string_of_float p
@@ -115,7 +96,7 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
if verb then Printf.eprintf "==> SasaSimuState.simustep :1: Get enable processes\n%!";
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
let pot = compute_potentiel st in
- let pl = fst(List.split st.network) in
+ let pl = st.network in
let st, all, enab_ll =
if
(* not (args.rif) && *)
@@ -136,7 +117,7 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
st, all, enab_ll
)
- else if legitimate st.network st.config then (
+ else if legitimate st then (
match Register.get_fault () with
| None ->
print_step n i pot st.sasarg st.config pl activate_val enab_ll;
@@ -161,7 +142,8 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
if verb then Printf.eprintf "==> SasaSimuState.simustep : 2: read the actions\n%!";
let get_action_value = RifRead.bool (st.sasarg.verbose > 1) in
let next_activate_val, pnal = Daemon.f st.sasarg.dummy_input
- (st.sasarg.verbose >= 1) st.sasarg.daemon st.network st.config all enab_ll get_action_value
+ (st.sasarg.verbose >= 1) st.sasarg.daemon st.network (SimuState.neigbors_of_pid st)
+ st.config all enab_ll get_action_value
in
List.iter (List.iter (fun b -> if b then incr moves)) next_activate_val;
update_round next_activate_val enab_ll;
diff --git a/test/coloring/config.ml b/test/coloring/config.ml
index aa5fd985..2c5a0137 100644
--- a/test/coloring/config.ml
+++ b/test/coloring/config.ml
@@ -10,5 +10,6 @@ let clash_number pidl get =
float_of_int !clash
let potential = Some clash_number
+(* let potential = None *)
let legitimate = None
let fault = None
--
GitLab