Skip to content

GitLab

Commit cc029128 authored by erwan's avatar erwan
Browse files

Chore: refactor the code to be able to provide the whole SimuState.t to Daemons

parent 803b8e99
Pipeline #69293 passed with stages
in 4 minutes and 59 seconds
Hide whitespace changes
Inline Side-by-side
guides/contributors/Makefile
View file @ cc029128
......@@ -6,7 +6,7 @@ module-deps.dot:
git ls-files ../.. | depgraph -i "test" -i "tools" | tred > $@
dune-deps.dot:
dune-deps ../.. > $@
dune-deps ../.. | tred > $@
%.pdf: %.dot
dot -Tpdf $< > $@
......
lib/sasa/sasaRun.ml
View file @ cc029128
......@@ -104,12 +104,12 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
(* 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
(SimuState.neigbors_of_pid st) st.config pre_pnall pre_enab_ll
(get_action_value sl_in)
(SimuState.neigbors_of_pid st) st pre_pnall pre_enab_ll
(get_action_value sl_in) Step.f
in
(* 3: Do the steps *)
let ne = Sasacore.Step.f pnal st.config in
let nst = update_config ne st in
let st = Sasacore.Step.f pnal st in
let nst = update_config st.config st in
let sasa_nenv = from_sasa_env nst in
(* 1': Get enable processes *)
let pnall, enab_ll = Sasacore.SimuState.get_enable_processes nst in
......@@ -117,7 +117,7 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
let silent = List.for_all (fun b -> not b) (List.flatten enab_ll) in
let legit = compute_legitimate silent nst in
pre_enable_processes_opt := Some(pnall, enab_ll);
sasa_config := ne;
sasa_config := st.config;
("silent", Data.B silent)::("legitimate", Data.B legit)::pot_sl @
sasa_nenv @ (get_sl_out true pl enab_ll)
in
......@@ -140,19 +140,25 @@ 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 (SimuState.neigbors_of_pid st)
st.config pnall enab_ll
(get_action_value sl_in)
let activate_val, pnal =
Daemon.f st.sasarg.dummy_input
(st.sasarg.verbose > 0) st.sasarg.daemon st.network
(SimuState.neigbors_of_pid st) st pnall enab_ll
(get_action_value sl_in) Step.f
in
(* 3: Do the steps *)
let ne = Sasacore.Step.f pnal st.config in
sasa_config := ne;
let st = Sasacore.Step.f pnal st in
sasa_config := st.config;
("silent", Data.B silent)::("legitimate", Data.B legit)::pot_sl @
(from_sasa_env st) @ (get_sl_out true pl enab_ll) @
(get_sl_out false pl activate_val)
in
let step = if st.sasarg.daemon = Daemon.Custom then step_custom else step_internal_daemon in
let step =
if st.sasarg.daemon = DaemonType.Custom then
step_custom
else
step_internal_daemon
in
let ss_table = Hashtbl.create 10 in
let step_dbg sl_in ctx cont =
let sl_out = step sl_in in
......@@ -200,7 +206,7 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
sasa_config := e; pre_enable_processes_opt := pepo
| None ->
Printf.eprintf "Cannot restore state %i from sasa\n" i;
flush stderr
flush stderr
);
}
......
lib/sasacore/daemon.ml
View file @ cc029128
(* Time-stamp: <modified the 31/05/2021 (at 11:22) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
| Central (* select 1 action *)
| LocallyCentral (* never activates two neighbors actions in the same step *)
| Distributed (* select at least one action *)
| Custom
| Greedy (* always choose the set of actions that maximize the potential function *)
| GreedyCentral (* Ditto, but chooses one action only *)
| Bad of int (* try to choose the set actions that maximize the
potential function but looking at sub-graphs of size
N at max *)
(* Time-stamp: <modified the 17/06/2021 (at 11:32) by Erwan Jahier> *)
(* Enabled processes (with its enabling action + neighbors) *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
type 'v step = 'v pna list -> 'v SimuState.t -> 'v SimuState.t
let (random_list : 'a list -> 'a) = fun l ->
assert (l <> []);
......@@ -141,18 +130,18 @@ 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 list ->
(string -> 'v * ('v Register.neighbor * string) list) -> 'v Env.t ->
'v pna list list -> bool list list -> (string -> string -> bool) ->
let (f: bool -> bool -> DaemonType.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) -> 'v SimuState.t ->
'v pna list list -> bool list list -> (string -> string -> bool) -> 'v step ->
bool list list * 'v pna list) =
fun dummy_input verbose_mode daemon pl neigbors_of_pid e all enab get_action_value ->
fun dummy_in verbose_mode daemon pl neigbors_of_pid st all enab get_action_value step ->
let nall = remove_empty_list all in
if nall = [] then (
Printf.printf "Warning: the algorithm is now Silent\n%!";
get_activate_val [] pl, []
)
else (
if daemon <> Custom && dummy_input then
if daemon <> Custom && dummy_in then
ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
match daemon with
| Synchronous ->
......@@ -168,13 +157,13 @@ let (f: bool -> bool -> t -> 'v Process.t list ->
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
let al = Evil.greedy verbose_mode st pl neigbors_of_pid step nall in
get_activate_val al pl, al
| GreedyCentral ->
let al = Evil.greedy_central verbose_mode e pl neigbors_of_pid nall in
let al = Evil.greedy_central verbose_mode st pl neigbors_of_pid step nall in
get_activate_val al pl, al
| Bad i ->
let al = Evil.bad i e nall in
let al = Evil.bad i st nall in
get_activate_val al pl, al
| Custom -> custom all pl enab get_action_value
)
lib/sasacore/daemon.mli
View file @ cc029128
(* Time-stamp: <modified the 07/05/2021 (at 16:42) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
| Central (* select 1 action *)
| LocallyCentral (* never activates two neighbors actions in the same step [1] *)
| Distributed (* select at least one action *)
| Custom (* enable/actions are communicated via stdin/stdout in RIF *)
| Greedy (* always choose the set that maximize the potential function *)
| GreedyCentral (* Ditto, but chooses one action only *)
| Bad of int (* try to choose the set actions that maximize the
potential function but looking at sub-graphs of
size N at max *)
(* [1] nb: the current implementation of locally central daemon is
biased by the degree of nodes. *)
(* Time-stamp: <modified the 17/06/2021 (at 11:33) by Erwan Jahier> *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
......@@ -44,10 +28,12 @@ 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 list ->
type 'v step = 'v pna list -> 'v SimuState.t -> 'v SimuState.t
val f : bool -> bool -> DaemonType.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
'v SimuState.t -> 'v pna list list -> bool list list ->
(string -> string -> bool) -> 'v step -> bool list list * 'v pna list
(** Used in gtkgui.ml *)
......
lib/sasacore/daemonType.ml 0 → 100644
View file @ cc029128
(* Time-stamp: <modified the 17/06/2021 (at 11:05) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
| Central (* select 1 action *)
| LocallyCentral (* never activates two neighbors actions in the same step [1] *)
| Distributed (* select at least one action *)
| Custom (* enable/actions are communicated via stdin/stdout in RIF *)
| Greedy (* always choose the set that maximize the potential function *)
| GreedyCentral (* Ditto, but chooses one action only *)
| Bad of int (* try to choose the set actions that maximize the
potential function but looking at sub-graphs of
size N at max *)
(* [1] nb: the current implementation of locally central daemon is
biased by the degree of nodes. *)
lib/sasacore/evil.ml
View file @ cc029128
(* Time-stamp: <modified the 03/05/2021 (at 16:17) by Erwan Jahier> *)
(* Time-stamp: <modified the 17/06/2021 (at 11:32) by Erwan Jahier> *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
type 'v step = 'v pna list -> 'v SimuState.t -> 'v SimuState.t
(* Enumerate all schedules using continuations *)
type 'a cont = NoMore | Elt of 'a * (unit -> 'a cont)
......@@ -118,20 +119,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 list ->
(string -> 'v * ('v Register.neighbor * string) list) -> 'v pna list list ->
'v pna list) =
fun verb e pl neigbors_of_pid all ->
let (greedy: bool -> 'v SimuState.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) ->
'v step -> 'v pna list list -> 'v pna list) =
fun verb st pl neigbors_of_pid step 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) pl in
let ne = Step.f pnal e in
let nst = step pnal st in
let get_info pid =
let _, nl = neigbors_of_pid pid in
Env.get ne pid, nl
Env.get nst.config pid, nl
in
user_pf pidl get_info
in
......@@ -153,7 +154,9 @@ let (greedy: bool -> 'v Env.t -> 'v Process.t list ->
then search_max [] (pnal_acc, v_acc) (c())
else search_max [] (pnal, v) (c())
in
let maxl = (time3 verb "Evil.greedy search" search_max [] (pnal1, p1) (shedules())) in
let maxl =
time3 verb "Evil.greedy search" search_max [] (pnal1, p1) (shedules())
in
List.nth maxl (Random.int (List.length maxl))
in
let res = fst (get_max all) in
......@@ -161,19 +164,20 @@ let (greedy: bool -> 'v Env.t -> 'v Process.t list ->
res
(* 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 ->
let (greedy_central: bool -> 'v SimuState.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) ->
'v step -> 'v pna list list -> 'v pna list) =
fun verb st pl neigbors_of_pid step 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) pl in
let ne = Step.f [pna] e in
let nst = step [pna] st in
let get_info pid =
let _, nl = neigbors_of_pid pid in
Env.get ne pid, nl
Env.get nst.config pid, nl
in
user_pf pidl get_info
in
......@@ -208,12 +212,12 @@ let (greedy_central: bool -> 'v Env.t -> 'v Process.t list ->
[res]
(* exported *)
let (bad: int -> 'v Env.t -> 'v pna list list -> 'v pna list) =
let (bad: int -> 'v SimuState.t -> 'v pna list list -> 'v pna list) =
fun _max_size _e _all ->
assert false (* todo *)
(* exported *)
let (worst4convex: 'v Env.t -> 'v pna list list -> 'v pna list) =
let (worst4convex: 'v SimuState.t -> 'v pna list list -> 'v pna list) =
fun _e _all ->
assert false (* todo *)
lib/sasacore/evil.mli
View file @ cc029128
(* Time-stamp: <modified the 03/05/2021 (at 16:17) by Erwan Jahier> *)
(* Time-stamp: <modified the 17/06/2021 (at 15:28) by Erwan Jahier> *)
(** This module gathers daemons that tries to reach the worst case with
a potential function using various heuristic. *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
type 'v step = 'v pna list -> 'v SimuState.t -> 'v SimuState.t
(** [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 list ->
(** [greedy verb st pl neighbors_of_pid step 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 SimuState.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) ->
'v pna list list -> 'v pna list
'v step -> '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 list ->
(string -> 'v * ('v Register.neighbor * string) list) -> 'v pna list list ->
'v pna list
val greedy_central:
bool -> 'v SimuState.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) ->
'v step -> '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)
where n is the number of enabled processes). *)
val worst4convex: 'v Env.t -> 'v pna list list -> 'v pna list
val worst4convex: 'v SimuState.t -> 'v pna list list -> 'v pna list
(** enumerate all the cases (of length 1) in sub-graphs of given size (O(2^size_max)) *)
val bad: int -> 'v Env.t -> 'v pna list list -> 'v pna list
val bad: int -> 'v SimuState.t -> 'v pna list list -> 'v pna list
lib/sasacore/sasArg.ml
View file @ cc029128
(* Time-stamp: <modified the 20/05/2021 (at 09:02) by Erwan Jahier> *)
(* Time-stamp: <modified the 17/06/2021 (at 11:10) by Erwan Jahier> *)
type t = {
mutable topo: string;
mutable length: int;
mutable verbose: int;
mutable daemon: Daemon.t;
mutable daemon: DaemonType.t;
mutable rif: bool;
mutable no_data_file: bool;
mutable quiet: bool;
......@@ -36,7 +36,7 @@ let (make_args : unit -> t) =
topo = "";
length = 10000;
verbose = 0;
daemon = Daemon.Distributed;
daemon = DaemonType.Distributed;
rif = false;
no_data_file = false;
quiet = false;
......@@ -97,38 +97,38 @@ let (mkoptab : string array -> t -> unit) =
fun argv args ->
(
mkopt args ["--synchronous-daemon";"-sd"]
(Arg.Unit(fun () -> args.daemon <- Daemon.Synchronous))
(Arg.Unit(fun () -> args.daemon <- DaemonType.Synchronous))
["Use a Synchronous daemon"];
mkopt args ["--central-daemon";"-cd"]
(Arg.Unit(fun () -> args.daemon <- Daemon.Central))
(Arg.Unit(fun () -> args.daemon <- DaemonType.Central))
["Use a Central daemon (selects exactly one action)"];
mkopt args ["--locally-central-daemon";"-lcd"]
(Arg.Unit(fun () -> args.daemon <- Daemon.LocallyCentral))
(Arg.Unit(fun () -> args.daemon <- DaemonType.LocallyCentral))
["Use a Locally Central daemon";
"(i.e., never activates two neighbors actions in the same step)"];
mkopt args ["--distributed-daemon";"-dd"]
(Arg.Unit(fun () -> args.daemon <- Daemon.Distributed))
(Arg.Unit(fun () -> args.daemon <- DaemonType.Distributed))
["Use a Distributed daemon (which select at least one action).";
"This is the default daemon."];
mkopt args ["--custom-daemon";"-custd"]
(Arg.Unit(fun () -> args.daemon <- Daemon.Custom;args.rif <- true))
(Arg.Unit(fun () -> args.daemon <- DaemonType.Custom;args.rif <- true))
["Use a Custom daemon (forces --rif)"];
mkopt args ["--greedy-central-daemon";"-gcd"]
(Arg.Unit(fun () -> args.daemon <- Daemon.GreedyCentral))
(Arg.Unit(fun () -> args.daemon <- DaemonType.GreedyCentral))
["Use the central daemon that maximizes the potential function";
"for the next step (greedy). Performs |enabled| trials)"];
mkopt args ["--greedy-daemon";"-gd"]
(Arg.Unit(fun () -> args.daemon <- Daemon.Greedy))
(Arg.Unit(fun () -> args.daemon <- DaemonType.Greedy))
["Use the daemon that maximizes the potential function";
"for the next step (greedy). Performs 2^|enabled| trials) "];
(* mkopt args ["--bad-daemon";"-bd"] ~arg:" <int>" *)
(* (Arg.Int (fun i -> args.daemon <- Daemon.Bad i)) *)
(* (Arg.Int (fun i -> args.daemon <- DaemonType.Bad i)) *)
(* ["Use a daemon that tries to maximize the potential function, "; *)
(* "considering sub-graphs of a given maximal size"]; *)
......
lib/sasacore/sasArg.mli
View file @ cc029128
(* Time-stamp: <modified the 20/05/2021 (at 09:02) by Erwan Jahier> *)
(* Time-stamp: <modified the 17/06/2021 (at 11:09) by Erwan Jahier> *)
type t = {
mutable topo: string;
mutable length: int;
mutable verbose: int;
mutable daemon: Daemon.t;
mutable daemon: DaemonType.t;
mutable rif: bool;
mutable no_data_file: bool;
mutable quiet: bool;
......
lib/sasacore/simuState.mli
View file @ cc029128
(* Time-stamp: <modified the 04/05/2021 (at 08:27) by Erwan Jahier> *)
(* Time-stamp: <modified the 17/06/2021 (at 15:29) by Erwan Jahier> *)
(** The module is used by
- the main sasa simulation loop (in ../../src/sasaMain.ml)
......@@ -24,7 +24,7 @@ type 'v enable_processes =
val get_enable_processes: 'v t -> 'v enable_processes
(** update the config and network processes *)
(** update the config *)
val update_config: 'v Env.t -> 'v t -> 'v t
(** Get pid's state and neigbors *)
......
lib/sasacore/step.ml
View file @ cc029128
......@@ -9,7 +9,8 @@ let (update_env: 'v Env.t -> 'v Process.t * 'v -> 'v Env.t) =
Env.set e p.pid st
let (f : ('v Process.t * 'v Register.neighbor list * action) list -> 'v Env.t -> 'v Env.t) =
let (f2 :
('v Process.t * 'v Register.neighbor list * action) list -> 'v Env.t -> 'v Env.t) =
fun pnal e ->
let lenv_list =
List.map (fun (p,nl,a) ->
......@@ -22,3 +23,9 @@ let (f : ('v Process.t * 'v Register.neighbor list * action) list -> 'v Env.t ->
(* 4: update the env *)
let ne = List.fold_left update_env e lenv_list in
ne
let (f : ('v Process.t * 'v Register.neighbor list * Register.action) list ->
'v SimuState.t -> 'v SimuState.t) =
fun pnal st ->
let e = f2 pnal st.config in
SimuState.update_config e st
lib/sasacore/step.mli
View file @ cc029128
(* [f pnal e] performs a step (according to the actions in pnal) and returns a new env *)
val f : ('v Process.t * 'v Register.neighbor list * Register.action) list -> 'v Env.t
-> 'v Env.t
val f : ('v Process.t * 'v Register.neighbor list * Register.action) list ->
'v SimuState.t -> 'v SimuState.t
src/sasaMain.ml
View file @ cc029128
......@@ -10,7 +10,7 @@ let (print_step : int -> int -> string -> SasArg.t -> 'v Env.t -> 'v Process.t l
if args.no_data_file then (
Printf.printf "\n#step %s\n%!" (string_of_int (n-i))
) else (
if args.daemon = Daemon.Custom then (
if args.daemon = DaemonType.Custom then (
(* in custom mode, to be able to talk with lurette, this should not be
printed on stdout
*)
......@@ -136,24 +136,23 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
else
st, all, enab_ll
in
if st.sasarg.daemon = Daemon.Custom then
if st.sasarg.daemon = DaemonType.Custom then
print_step n i pot st.sasarg st.config pl activate_val enab_ll;
(* 2: read the actions *)
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 (SimuState.neigbors_of_pid st)
st.config all enab_ll get_action_value
st all enab_ll get_action_value Step.f
in
List.iter (List.iter (fun b -> if b then incr moves)) next_activate_val;
update_round next_activate_val enab_ll;
let next_activate_val = bool_ll_to_string next_activate_val in
(* 3: Do the steps *)
if verb then Printf.eprintf "==> SasaSimuState.simustep : 3: Do the steps\n%!";
if st.sasarg.daemon <> Daemon.Custom then
if st.sasarg.daemon <> DaemonType.Custom then
print_step n i pot st.sasarg st.config pl next_activate_val enab_ll;
let ne = Sasacore.Step.f pnal st.config in
let st = update_config ne st in
let st = Sasacore.Step.f pnal st in
st, next_activate_val
let rec (simuloop: int -> int -> string -> 'v SimuState.t -> unit) =
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment