diff --git a/lib/sasacore/daemon.ml b/lib/sasacore/daemon.ml
index ea58b0fbd797e47f37d441c25133f9e2f75bbc0d..cd95b78d20535afe8e4e87aaae5151fa7100242b 100644
--- a/lib/sasacore/daemon.ml
+++ b/lib/sasacore/daemon.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 31/07/2021 (at 09:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/10/2021 (at 15:47) by Erwan Jahier> *)
(* Enabled processes (with its enabling action + neighbors) *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
@@ -170,4 +170,6 @@ let (f: bool -> bool -> DaemonType.t -> 'v Process.t list ->
let al = Evil.bad i st nall in
get_activate_val al pl, al
| Custom -> custom all pl enab get_action_value
+
+ | ExhaustSearch -> assert false (* SNO *)
)
diff --git a/lib/sasacore/daemon.mli b/lib/sasacore/daemon.mli
index aa0ba5593e4905c81294437f61e121ef64318a49..487faa7d44195de4d6454e011dd113438510daab 100644
--- a/lib/sasacore/daemon.mli
+++ b/lib/sasacore/daemon.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 31/07/2021 (at 09:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 15/10/2021 (at 11:04) by Erwan Jahier> *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
type 'v enabled = 'v pna list list
@@ -37,6 +37,7 @@ val f : bool -> bool -> DaemonType.t -> 'v Process.t list ->
'v SimuState.t -> 'v enabled -> bool list list ->
(string -> string -> bool) -> 'v step -> bool list list * 'v triggered
+val get_activate_val: 'v triggered -> 'v Process.t list -> bool list list
(** Used in gtkgui.ml *)
val central: 'a list list -> 'a list
diff --git a/lib/sasacore/daemonType.ml b/lib/sasacore/daemonType.ml
index 5835adde1635c748c1fc79a98d743bfe7f6cff0c..400719828306167f97c4415c07743af4ef7a789f 100644
--- a/lib/sasacore/daemonType.ml
+++ b/lib/sasacore/daemonType.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/06/2021 (at 11:05) by Erwan Jahier> *)
+(* Time-stamp: <modified the 16/10/2021 (at 15:07) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
@@ -8,6 +8,9 @@ type t =
| 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 *)
+ | ExhaustSearch (* *)
+
+ (* not yet implemented *)
| Bad of int (* try to choose the set actions that maximize the
potential function but looking at sub-graphs of
size N at max *)
diff --git a/lib/sasacore/enumerate.ml b/lib/sasacore/enumerate.ml
new file mode 100644
index 0000000000000000000000000000000000000000..04313f26053745e751038a6f5e6ab081500fe9ee
--- /dev/null
+++ b/lib/sasacore/enumerate.ml
@@ -0,0 +1,54 @@
+
+
+(* Enumerate all schedules using continuations *)
+type 'a cont = NoMore | Elt of 'a * (unit -> 'a cont)
+
+(* compose continuations *)
+let rec (comp : 'a cont -> 'a cont -> 'a cont) =
+ fun c1 c2 ->
+ match c1 with
+ | NoMore -> c2
+ | Elt(x, c1) -> Elt(x, fun () -> comp (c1()) c2)
+
+(* Enumerate all possible schedules (with one action per process at most)
+ nb: it can be a lot!
+*)
+let (all : 'a list list -> 'a list cont) = fun all ->
+ let rec f acc all =
+ let res = match all with
+ | [] ->
+ if acc = [] then NoMore else Elt(acc, fun () -> NoMore)
+ | []::tl -> f acc tl
+ | al::tl ->
+ List.fold_left
+ (fun cont_acc a ->
+ let cont_a = f (a::acc) tl in
+ comp cont_a cont_acc
+ )
+ (f acc tl)
+ al
+ in
+ res
+ in
+ assert(List.exists (fun l -> l<>[]) all);
+ f [] all
+
+(* Enumerate all possible schedules for central daemons) *)
+let (central : 'a list list -> 'a cont) = fun all ->
+ let al = List.flatten all in
+ List.fold_left (fun acc a -> Elt(a, fun () -> acc)) NoMore al
+
+
+let (all_list : 'a list list -> 'a list list) = fun ll ->
+ let rec f acc c =
+ match c with
+ | NoMore -> acc
+ | Elt(x,c) -> f (x::acc) (c())
+ in
+ f [] (all ll)
+
+let (central_list : 'a list list -> 'a list list) = fun all ->
+ let al = List.flatten all in
+ List.map (fun x -> [x]) al
+
+
diff --git a/lib/sasacore/evil.ml b/lib/sasacore/evil.ml
index 06dbee44f0606e7b1e2bc1410d0af88781a3d867..b9e344aa71b2d1aaa104a775c2133e723929c186 100644
--- a/lib/sasacore/evil.ml
+++ b/lib/sasacore/evil.ml
@@ -1,47 +1,10 @@
-(* Time-stamp: <modified the 14/10/2021 (at 15:45) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/10/2021 (at 16:53) by Erwan Jahier> *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
type 'v enabled = 'v pna list list
type 'v triggered = 'v pna list
type 'v step = 'v triggered -> 'v SimuState.t -> 'v SimuState.t
-(* Enumerate all schedules using continuations *)
-type 'a cont = NoMore | Elt of 'a * (unit -> 'a cont)
-
-(* compose continuations *)
-let rec (comp : 'a cont -> 'a cont -> 'a cont) =
- fun c1 c2 ->
- match c1 with
- | NoMore -> c2
- | Elt(x, c1) -> Elt(x, fun () -> comp (c1()) c2)
-
-(* Enumerate all possible schedules (with one action per process at most)
- nb: it can be a lot!
-*)
-let (enumerate : 'a list list -> 'a list cont) = fun all ->
- let rec f acc all =
- let res = match all with
- | [] ->
- if acc = [] then NoMore else Elt(acc, fun () -> NoMore)
- | []::tl -> f acc tl
- | al::tl ->
- List.fold_left
- (fun cont_acc a ->
- let cont_a = f (a::acc) tl in
- comp cont_a cont_acc
- )
- (f acc tl)
- al
- in
- res
- in
- assert(List.exists (fun l -> l<>[]) all);
- f [] all
-
-(* Enumerate all possible schedules for central daemons) *)
-let (enumerate_central : 'a list list -> 'a cont) = fun all ->
- let al = List.flatten all in
- List.fold_left (fun acc a -> Elt(a, fun () -> acc)) NoMore al
module StringMap = Map.Make(String)
module StringSet = Set.Make(String)
@@ -141,14 +104,14 @@ let (greedy: bool -> 'v SimuState.t -> 'v Process.t list ->
let cpt = ref 0 in
let (get_max :'v pna list list -> 'v pna list * float) = fun all ->
let pnal1, p1, shedules =
- match time verb "Evil.greedy enumerate" enumerate all with
- | NoMore -> assert false
- | Elt(pnal, c) -> pnal, pf pnal, c
+ match time verb "Evil.greedy enumerate" Enumerate.all all with
+ | Enumerate.NoMore -> assert false
+ | Enumerate.Elt(pnal, c) -> pnal, pf pnal, c
in
let rec search_max acc (pnal_acc, v_acc) shedules =
match shedules with (* returns more than one max in case of equality *)
- | NoMore -> (pnal_acc, v_acc)::acc
- | Elt(pnal, c) ->
+ | Enumerate.NoMore -> (pnal_acc, v_acc)::acc
+ | Enumerate.Elt(pnal, c) ->
incr cpt;
let v = pf pnal in
if v = v_acc then search_max ((pnal_acc, v_acc)::acc) (pnal, v) (c())
@@ -189,14 +152,14 @@ let (greedy_central: bool -> 'v SimuState.t -> 'v Process.t list ->
let cpt = ref 0 in
let (get_max :'v pna list list -> 'v pna * float) = fun all ->
let pnal1, p1, shedules =
- match time verb "Evil.greedy_central enumerate" enumerate_central all with
- | NoMore -> assert false
- | Elt(pna, c) -> pna, pf pna, c
+ match time verb "Evil.greedy_central enumerate" Enumerate.central all with
+ | Enumerate.NoMore -> assert false
+ | Enumerate.Elt(pna, c) -> pna, pf pna, c
in
let rec search_max acc (pnal_acc, v_acc) shedules =
match shedules with
- | NoMore -> (pnal_acc, v_acc)::acc
- | Elt(pnal, c) ->
+ | Enumerate.NoMore -> (pnal_acc, v_acc)::acc
+ | Enumerate.Elt(pnal, c) ->
incr cpt;
let v = pf pnal in
if v = v_acc then search_max ((pnal_acc, v_acc)::acc) (pnal, v) (c())
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index 0c77190c821bf06a75af2d41334bb978c533840c..087aa88dbb9da5b67c8197e26dcf1e3ae1b02a84 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/10/2021 (at 16:54) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/10/2021 (at 15:47) by Erwan Jahier> *)
type t = {
@@ -131,6 +131,11 @@ let (mkoptab : string array -> t -> unit) =
["Use the daemon that maximizes the potential function";
"for the next step (greedy). Performs 2^|enabled| trials) "];
+ mkopt args ["--exhaustive-daemon";"-ed"]
+ (Arg.Unit(fun () -> args.daemon <- DaemonType.ExhaustSearch))
+ ["Use the daemon that maximizes the potential function. ";
+ "Performs *a lot* of trials)"];
+
(* mkopt args ["--bad-daemon";"-bd"] ~arg:" <int>" *)
(* (Arg.Int (fun i -> args.daemon <- DaemonType.Bad i)) *)
(* ["Use a daemon that tries to maximize the potential function, "; *)
diff --git a/lib/sasacore/simuState.ml b/lib/sasacore/simuState.ml
index c8a16968e5917f4f389042a1f91b9bcf19498756..d3ec6cf494ed69fdc95e7cbc7c019e9744d4d408 100644
--- a/lib/sasacore/simuState.ml
+++ b/lib/sasacore/simuState.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 14/10/2021 (at 15:45) by Erwan Jahier> *)
+(* Time-stamp: <modified the 16/10/2021 (at 14:55) by Erwan Jahier> *)
open Register
open Topology
@@ -41,11 +41,11 @@ open SasArg
module StringMap = Map.Make(String)
type 'v t = {
+ config: 'v Conf.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;
- config: 'v Conf.t
}
let (neigbors_of_pid : 'v t -> pid -> 's * ('s neighbor * pid) list) =
@@ -399,3 +399,10 @@ let (compute_potentiel: 'v t -> float) =
let pidl = List.map (fun p -> p.Process.pid) st.network in
let p = user_pf pidl (neigbors_of_pid st) in
p
+
+let (legitimate: 'v t -> bool) = fun st ->
+ match Register.get_legitimate () with
+ | None -> false
+ | Some ulf ->
+ let pidl = List.map (fun p -> p.Process.pid) st.network in
+ ulf pidl (neigbors_of_pid st)
diff --git a/lib/sasacore/simuState.mli b/lib/sasacore/simuState.mli
index f484876b6c7710a646acf5862dc9a0319b7745c6..4ad8d34fdb52f0f05ae0ea5295e9579a4d5c257f 100644
--- a/lib/sasacore/simuState.mli
+++ b/lib/sasacore/simuState.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 14/10/2021 (at 15:48) by Erwan Jahier> *)
+(* Time-stamp: <modified the 16/10/2021 (at 14:55) by Erwan Jahier> *)
(** The module is used by
- the main sasa simulation loop (in ../../src/sasaMain.ml)
@@ -10,10 +10,10 @@
(* type 'v t = SasArg.t * 'v layout * 'v Conf.t *)
type 'v t = {
+ config: 'v Conf.t;
sasarg: SasArg.t;
network: 'v Process.t list;
neighbors: ('v Register.neighbor list) Map.Make(String).t; (* pid's neighbors *)
- config: 'v Conf.t
}
(* [make dynlink_flag argv] *)
@@ -31,6 +31,7 @@ val update_config: 'v Conf.t -> 'v t -> 'v t
val neigbors_of_pid : 'v t -> string -> 'v * ('v Register.neighbor * string) list
val compute_potentiel: 'v t -> float
+val legitimate: 'v t -> bool
(* For SasaRun *)
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index 47231db694ffae922a87984f9123a6fdb9ad01f0..61532c2917c7a5ae1333aeba7b55cb74cb42ed5e 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -1,12 +1,12 @@
open Sasacore
+let bll2str bll =
+ String.concat " " (List.map (fun b -> if b then "t" else "f") (List.flatten bll))
+
let (print_step : out_channel -> 'v SimuState.t -> int -> int -> string -> string -> SasArg.t ->
'v Conf.t -> 'v Process.t list -> string -> bool list list -> unit) =
fun log st n i legitimate pot args e pl activate_val enab_ll ->
- let enable_val =
- String.concat " " (List.map (fun b -> if b then "t" else "f")
- (List.flatten enab_ll))
- in
+ let enable_val = bll2str enab_ll in
if st.sasarg.init_search_max_trials <> None then (
(* Printf.fprintf log "\n#step %s\n%!" (string_of_int (n-i)); *)
(* Printf.fprintf log "%s %s %s %s\n%!" (StringOf.env_rif e pl) enable_val legitimate pot; *)
@@ -56,18 +56,8 @@ let (update_round : bool list list -> bool list list -> unit) =
);
()
-let bool_ll_to_string bll =
- String.concat " "
- (List.map (fun b -> if b then "t" else "f") (List.flatten bll))
-
open Sasacore.SimuState
-let legitimate st =
- match Register.get_legitimate () with
- | None -> false
- | Some ulf ->
- let pidl = List.map (fun p -> p.Process.pid) st.network in
- ulf pidl (SimuState.neigbors_of_pid st)
module StringMap = Map.Make(String)
@@ -90,9 +80,9 @@ 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.simustep :1: Get enable processes\n%!";
+ if verb then Printf.fprintf log "==> SasaSimuState.simustp :1: Get enable processes\n%!";
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
- let pot = compute_potentiel st in
+ let pot = string_of_float (SimuState.compute_potentiel st) in
let pl = st.network in
let leg = legitimate st in
let st, all, enab_ll =
@@ -147,7 +137,7 @@ let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuS
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
+ let next_activate_val = bll2str next_activate_val in
(* 3: Do the steps *)
if verb then Printf.fprintf log "==> SasaSimuState.simustep : 3: Do the steps\n%!";
if st.sasarg.daemon <> DaemonType.Custom then
@@ -192,14 +182,27 @@ let rec (simuloop: out_channel -> int -> int -> string -> 'v SimuState.t -> int)
flush_all();
i
+let sob = fun b -> if b then "t" else "f"
+
let () =
let st = Sasacore.SimuState.make true Sys.argv in
let n = st.sasarg.length in
try
- match st.sasarg.init_search_max_trials with
- | None ->
+ match st.sasarg.init_search_max_trials, st.sasarg.daemon with
+ | None, ExhaustSearch ->
+ let log = open_out (st.sasarg.topo ^ ".log") in
+ let path = ExhaustSearch.f log n st in
+ List.iteri
+ (fun i (enab, trig, leg, pot, conf) ->
+ Printf.printf "#step %d\n#outs %s %s %s %s %s\n" (i+1)
+ (StringOf.env_rif conf st.network) (bll2str enab) (bll2str trig)
+ (sob leg) (string_of_float pot);
+ )
+ path
+ | None,_ ->
ignore (simuloop stdout n n "" st)
- | Some maxt ->
+
+ | Some maxt, _ ->
let log = open_out (st.sasarg.topo ^ ".log") in
let newdot_fn = (Filename.chop_extension st.sasarg.topo) ^ "_wi.dot" in
let newdot = open_out newdot_fn in
@@ -247,4 +250,3 @@ let () =
print_string "\nq\n#quit\n%!";
flush_all();
exit 2
-
diff --git a/test/coloring/grid4.dot b/test/coloring/grid4.dot
index 4d4a22f5f426cdaa83afb20705fe9fb5179e26c6..2fcc6209ed289948db09cb2af1758f47032f043c 100644
--- a/test/coloring/grid4.dot
+++ b/test/coloring/grid4.dot
@@ -1,20 +1,20 @@
graph g {
- p0 [algo="p.ml" init="0"]
- p1 [algo="p.ml" init="0"]
- p2 [algo="p.ml" init="0"]
- p3 [algo="p.ml" init="0"]
- p4 [algo="p.ml" init="0"]
- p5 [algo="p.ml" init="0"]
- p6 [algo="p.ml" init="0"]
- p7 [algo="p.ml" init="0"]
- p8 [algo="p.ml" init="0"]
- p9 [algo="p.ml" init="0"]
- p10 [algo="p.ml" init="0"]
- p11 [algo="p.ml" init="0"]
- p12 [algo="p.ml" init="0"]
- p13 [algo="p.ml" init="0"]
- p14 [algo="p.ml" init="0"]
- p15 [algo="p.ml" init="0"]
+ p0 [algo="p.ml" init="c=0"]
+ p1 [algo="p.ml" init="c=0"]
+ p2 [algo="p.ml" init="c=0"]
+ p3 [algo="p.ml" init="c=0"]
+ p4 [algo="p.ml" init="c=0"]
+ p5 [algo="p.ml" init="c=0"]
+ p6 [algo="p.ml" init="c=0"]
+ p7 [algo="p.ml" init="c=0"]
+ p8 [algo="p.ml" init="c=0"]
+ p9 [algo="p.ml" init="c=0"]
+ p10 [algo="p.ml" init="c=0"]
+ p11 [algo="p.ml" init="c=0"]
+ p12 [algo="p.ml" init="c=0"]
+ p13 [algo="p.ml" init="c=0"]
+ p14 [algo="p.ml" init="c=0"]
+ p15 [algo="p.ml" init="c=0"]
p0 -- p1 -- p2 -- p3 -- p7
p0 -- p4 -- p5 -- p6