Commit 1cb82084 authored by erwan's avatar erwan
Browse files

build: undo part of the changes done in sha:f70bcede

(i was on the wrong branch)
parent 9f7903f6
Pipeline #76811 failed with stages
in 3 minutes and 2 seconds
(* 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
......
(* 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
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
Markdown is supported
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