diff --git a/lib/algo/algo.mli b/lib/algo/algo.mli
index d1ecc10363b81b56436639837b0269c3fc977f73..fdc6e0f3f3864aac2d04d2ba8bb9d0d5a93faa05 100644
--- a/lib/algo/algo.mli
+++ b/lib/algo/algo.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 14/09/2021 (at 16:12) by Erwan Jahier> *)
+(* Time-stamp: <modified the 31/08/2021 (at 15:43) by Erwan Jahier> *)
(** {1 The Algorithm programming Interface}
A SASA process is an instance of an algorithm defined via this
@@ -160,10 +160,6 @@ val get_graph_attribute : string -> string
(** Get the value of a graph attribute. Returns None if the attribute doesn't exist. *)
val get_graph_attribute_opt : string -> string option
-(** {3 Finding bad initial state } *)
-type num = F of float | I of int | B of bool
-type 's state_of_nums : num list -> 's
-
(** {2 Code Registration}
The [register: 's to_register -> unit] function must be called once in
@@ -181,11 +177,9 @@ type 's to_register = {
state_of_string: (string -> 's) option;
copy_state: 's -> 's;
actions : action list (** Mandatory in custom daemon mode, or to use oracles *);
- legitimate_function : 's legitimate_fun option;
potential_function: 's potential_fun option (** Mandatory with Evil daemons *);
+ legitimate_function : 's legitimate_fun option;
fault_function : 's fault_fun option (** called at legitimate configuration *)
-
- state_of_nums : 's state_of_nums option;
}
(** - For the [state_to_string] field, the idea is to print the raw
values contained in ['s]. If a value is omitted, one won't see it
diff --git a/lib/sasacore/worstInit.ml b/lib/sasacore/worstInit.ml
deleted file mode 100644
index 08c08330bd533f4dad51fb4dce92a55701ed4fdd..0000000000000000000000000000000000000000
--- a/lib/sasacore/worstInit.ml
+++ /dev/null
@@ -1,219 +0,0 @@
-(* Time-stamp: <modified the 01/10/2021 (at 11:58) by Erwan Jahier> *)
-
-open Register
-
-type 's node = { st : 's ; d : int }
-type point = num Array.t
-
-let debug = false
-
-type succ_heuristic = (* Various heuristic to choose the neighbor *)
- | OneDim (* only move one value at a time *)
- | RanDim (* move a value or not at random *)
- | AllDim (* move all values *)
-
-let succ_heuristic_nb = 3
-let int_of_succ_heuristic = function OneDim -> 0 | RanDim -> 1 | AllDim -> 2
-let succ_heuristic_of_int = function 0 -> OneDim | 1 -> RanDim | 2 -> AllDim
- | _ -> assert false
-
-let mutate_num = function
- | F f -> F(f+.(Random.float 2.0) -. 1.0)
- | I i -> if Random.bool () then I(i+1) else I(i-1)
- | B b -> B (not b)
-
-
-let (one_dim_succ : point -> point) = fun p ->
- let j = Random.int (Array.length p) in
- p.(j) <- mutate_num p.(j);
- p
-
-let ran_dim_succ p =
- for j=0 to Array.length p - 1 do
- if Random.bool () then p.(j) <- mutate_num p.(j)
- done;
- p
-let all_dim_succ p =
- for j=0 to Array.length p - 1 do
- p.(j) <- mutate_num p.(j)
- done;
- p
-
-let succ_heuristic_to_succ = function
- OneDim -> one_dim_succ | RanDim -> ran_dim_succ | AllDim -> all_dim_succ
-
-(* each succ_heuristic has a weight between 1 and 100, initialized at 50 *)
-let hw = Array.make succ_heuristic_nb 50
-let decr_w log i =
- Printf.fprintf log "Decrementing heuristic %d\n%!" i;
- try hw.(i) <- max 1 (hw.(i)-1) with _ -> assert false
-let incr_w log i =
- Printf.fprintf log "Incrementing heuristic %d\n%!" i;
- try hw.(i) <- min 100 (hw.(i)+1) with _ -> assert false
-
-let tf = float_of_int
-
-let (choose_succ_heuristic : unit -> succ_heuristic) =
- fun () -> (* Choose one succ_heuristic with a probability defined by their weights in hw *)
- let sum = tf(Array.fold_left (+) 0 hw) in
- let r = ref (sum *. Random.float 1.0) in
- let ri = ref (-1) in
- assert(sum>0.0);
- assert(!r>0.0);
- while !r>0.0 do
- incr ri;
- assert (!ri<Array.length hw);
- r := !r -. (tf hw.(!ri));
- done;
- if debug then Printf.printf "choose heuristics %d, %!" !ri;
- succ_heuristic_of_int !ri
-
-let h = ref (choose_succ_heuristic ())
-let choose_succ s =
- let s_st = Array.copy s.st in
- let ns = (succ_heuristic_to_succ !h) s_st in
- (* update heuristic weights depending on their success at the previous step *)
- (*if ns = pre_s then decr_w else incr_w) (int_of_succ_heuristic !h*)
- h := choose_succ_heuristic ();
- { st = ns ; d = s.d+1 }
-
-
-let print_stat log =
- Printf.fprintf log " ===> heuristic array: [|%s|]\n%!"
- (Array.fold_left (fun acc d -> Printf.sprintf "%s,%d" acc d) "" hw);
-
-
-(*****************************************************************************)
-(* XXX a ranger ailleurs !!! *)
-
-open Process
-
-let (point_to_ss : point -> 'v SimuState.t -> 'v SimuState.t) =
- fun point ss ->
-
- let (state_to_nums, nums_to_state :
- ('v -> Register.num list) * (Register.num list -> 'v -> 'v )) =
- match Register.get_for_init_search () with
- | None -> assert false
- | Some (f, g) -> f, g
- in
- let state_size =
- assert (ss.network <> []);
- let p0 = List.hd ss.network in
- let s0 = state_to_nums p0.init in
- List.length s0
- in
- let make_num l i j =
- if debug then
- Printf.printf "make_num i=%d j=%d size=%dx%d \n%!"
- i j (Array.length point) state_size;
- let rec f l i j =
- if i=0 then l else f (point.(i+j-1)::l) (i-1) j
- in
- f l i j
- in
- let new_config, _ =
- List.fold_left
- (fun (e,j) p ->
- let num = make_num [] state_size (j*state_size) in
- let st = nums_to_state num (Env.get e p.pid) in
- let e = Env.set e p.pid st in
- e, j+1
- )
- (ss.config, 0)
- ss.network
- in
- if debug then Printf.printf "point_to_ss ok\n%!";
- { ss with config = new_config }
-
-
-let (ss_to_point : 'v SimuState.t -> point) =
- fun ss ->
- let (state_to_nums : ('v -> Register.num list) ) =
- match Register.get_for_init_search () with
- | None ->
- failwith "the Algo.for_init_search registration field should provide state_to_nums functions"
- | Some (f, _) -> f
- in
- let size =
- assert (ss.network <> []);
- let p0 = List.hd ss.network in
- let s0 = state_to_nums p0.init in
- (List.length s0) * (List.length ss.network)
- in
- let point = Array.make size (I 0) in
- let i = ref 0 in
- List.iter
- (fun p ->
- let nums = state_to_nums p.init in
- List.iter (fun num ->
- assert (!i<Array.length point);
- point.(!i) <- num; incr i) nums
- )
- ss.network;
- point
-(*****************************************************************************)
-
-open LocalSearch
-
-
-
-(* First Choice Hill Climbing: a successor is chosen at random (using
- some heuristics), and became the current state if its cost is
- better.
-
- The heuristic to choose the succ is chosen at random in an array of
- heuristics. The probability of each heuristic evolves, but is
- never null. *)
-let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int -> 'v SimuState.t) =
- fun log run ss_init dmax ->
- let cost p = run (point_to_ss p ss_init) in
-
- let g =
- {
- init = ({ st = ss_to_point ss_init ; d = 0 }, None, ());
- succ = (fun n -> [choose_succ n]);
- stop = (fun _ _n -> false);
- is_goal = (fun _n -> true);
- push = (fun _tv n -> Some n);
- pop = (fun tv -> Some(Option.get tv, None));
- visiting = (fun _ x -> x);
- visited = (fun _ _ -> false);
- cut = (fun _ _ -> false);
- }
- in
- let cpt = ref 0 in
- let av_cost = ref 0 in
- let rec run_more pcost psol more =
- print_stat log;
- incr cpt;
- if !cpt < dmax then
- ( match more (Some psol) with
- | LocalSearch.Stopped -> assert false (* SNO *)
- | LocalSearch.NoMore-> assert false (* SNO *)
- | LocalSearch.Sol (nsol, more) ->
- av_cost := (!av_cost * (!cpt-1) + pcost) / !cpt;
- let ncost = cost nsol.st in
- Printf.fprintf log "%d > %d? " ncost pcost;
- if ncost > pcost then
- incr_w log (int_of_succ_heuristic !h)
- else
- decr_w log (int_of_succ_heuristic !h);
- if ncost > pcost then (
- run_more ncost nsol more
- ) else (
- run_more pcost psol more
- )
- )
- else (
- Printf.printf "The worst initial configuration, which costs %d, is " pcost;
- point_to_ss psol.st ss_init
- (* XXX generate a dot file using this initialisation *)
-
- )
- in
-
- match LocalSearch.run g None with
- | LocalSearch.Stopped -> assert false (* SNO *)
- | LocalSearch.NoMore-> assert false (* SNO *)
- | LocalSearch.Sol (sol, more) -> run_more (cost sol.st) sol more
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index 88e3ca82e5af179677942aa084c6015651817108..4d51a68921be635f8a9628de00f9ae4f6414a7cf 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -1,16 +1,12 @@
open Sasacore
-let (print_step : out_channel -> 'v SimuState.t -> int -> int -> string -> string -> SasArg.t ->
- 'v Env.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 (print_step : int -> int -> string -> string -> SasArg.t -> 'v Env.t ->
+ 'v Process.t list -> string -> bool list list -> unit) =
+ fun 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
- 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; *)
- ) else
if args.no_data_file then (
Printf.printf "\n#step %s\n%!" (string_of_int (n-i))
) else (
@@ -26,8 +22,7 @@ let (print_step : out_channel -> 'v SimuState.t -> int -> int -> string -> strin
) else (
(* rif mode, internal daemons *)
if args.rif then
- Printf.printf " %s %s %s %s %s\n%!"
- (StringOf.env_rif e pl) enable_val activate_val legitimate pot
+ Printf.printf " %s %s %s %s %s\n%!" (StringOf.env_rif e pl) enable_val activate_val legitimate pot
else (
Printf.printf "\n#step %s\n" (string_of_int (n-i));
Printf.printf "%s%s %s %s %s %s\n%!"
@@ -94,11 +89,11 @@ let (compute_potentiel: 'v SimuState.t -> string) =
string_of_float p
-let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string) =
- fun log n i activate_val st ->
+let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string) =
+ fun 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.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 = st.network in
@@ -110,15 +105,15 @@ let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuS
then (
match Register.get_fault () with
| None ->
- print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
+ print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
incr rounds;
raise (Silent (n-i))
| Some ff ->
- print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
+ print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
let str = if st.sasarg.rif then "#" else "" in
- Printf.fprintf log "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n"
+ Printf.eprintf "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n"
str !moves (plur !moves) (n-i) (plur (n-i)) !rounds (plur !rounds);
- Printf.fprintf log "%s==> Inject a fault\n%!" str;
+ Printf.eprintf "%s==> Inject a fault\n%!" str;
let st = inject_fault ff st in
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
st, all, enab_ll
@@ -126,15 +121,15 @@ let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuS
else if leg then (
match Register.get_fault () with
| None ->
- print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
+ print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
raise (Legitimate (n-i))
| Some ff ->
- print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
+ print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
let str = if st.sasarg.rif then "#" else "#" in
- Printf.fprintf log
+ Printf.eprintf
"\n%sThis algo reached a legitimate configuration after %i move%s, %i step%s, %i round%s.\n"
str !moves (plur !moves) (n-i) (plur (n-i)) !rounds (plur !rounds);
- Printf.fprintf log "%s==> Inject a fault\n%!" str;
+ Printf.eprintf "%s==> Inject a fault\n%!" str;
let st = inject_fault ff st in
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
st, all, enab_ll
@@ -144,9 +139,9 @@ let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuS
in
let leg_str = if leg then "t" else "f" in
if st.sasarg.daemon = DaemonType.Custom then
- print_step log st n i leg_str pot st.sasarg st.config pl activate_val enab_ll;
+ print_step n i leg_str pot st.sasarg st.config pl activate_val enab_ll;
(* 2: read the actions *)
- if verb then Printf.fprintf log "==> SasaSimuState.simustep : 2: read the actions\n%!";
+ 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
@@ -156,79 +151,44 @@ let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuS
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.fprintf log "==> SasaSimuState.simustep : 3: Do the steps\n%!";
+ if verb then Printf.eprintf "==> SasaSimuState.simustep : 3: Do the steps\n%!";
if st.sasarg.daemon <> DaemonType.Custom then
- print_step log st n i leg_str pot st.sasarg st.config pl next_activate_val enab_ll;
+ print_step n i leg_str pot st.sasarg st.config pl next_activate_val enab_ll;
let st = Sasacore.Step.f pnal st in
st, next_activate_val
-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;
- 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 ()
- )
- in
- try (loop i activate_val st); n
+let rec (simuloop: int -> int -> string -> 'v SimuState.t -> unit) =
+ fun n i activate_val st ->
+ if !Register.verbose_level > 0 then Printf.eprintf "==> SasaSimuState.simuloop %d/%d \n%!" i n;
+ let st, next_activate_val = simustep n i activate_val st in
+ if i > 0 then simuloop n (i-1) next_activate_val st else (
+ print_string "#q\n"; flush_all ()
+ )
+
+let () =
+ let st = Sasacore.SimuState.make true Sys.argv in
+ try
+ let n = st.sasarg.length in
+ simuloop n n "" st
with
| Silent i ->
let str = if st.sasarg.rif then "#" else "" in
- Printf.fprintf log "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n%!"
+ Printf.printf "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n%!"
str !moves (plur !moves) i (plur i) !rounds (plur !rounds);
print_string "\nq\n#quit\n%!";
- flush_all();
- i
+ flush_all()
| Legitimate i ->
let str = if st.sasarg.rif then "#" else "" in
- Printf.fprintf log
+ Printf.printf
"\n%s%sThis algo reached a legitimate configuration after %i move%s, %i step%s, %i round%s.\n%!"
(if st.sasarg.rif then "#" else "#")
str !moves (plur !moves) i (plur i) !rounds (plur !rounds);
- Printf.fprintf log "\n#quit\n";
- flush_all();
- i
-
-
-
-
-let () =
- let st = Sasacore.SimuState.make true Sys.argv in
- 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
- let n = st.sasarg.length in
- try
- match st.sasarg.init_search_max_trials with
- | None ->
- ignore (simuloop stdout n n "" st)
- | Some maxt ->
- let i = ref 1 in
- let run s =
- moves := 0;
- rounds := 0;
- round_mask := [];
- Printf.fprintf log "-------------------------- New simu (%d) \n%!" !i;
- let s = SimuState.update_config s.config s in
- let res = simuloop log n n "" s in
- Printf.fprintf log "initial conf=(%s)\n%!" (StringOf.env_rif s.config s.network);
- incr i;
- res
- in
- let st = (WorstInit.fchc log run st maxt) in
- Printf.printf " (%s)\n%!" (StringOf.env_rif st.config st.network);
- Printf.fprintf newdot "%s\n" (SimuState.to_dot st);
- Printf.printf "%s and %s have been generated\n" (st.sasarg.topo ^ ".log") newdot_fn;
- flush_all();
- close_out newdot;
- close_out log
- with
+ print_string "\n#quit\n";
+ flush_all()
| e ->
Printf.printf "%s%s\n%!" (if st.sasarg.rif then "#" else "") (Printexc.to_string e);
print_string "\nq\n#quit\n%!";
flush_all();
exit 2
-
+