From 680b45f731c649216595cc7a41c729632af9871f Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 6 Apr 2022 14:56:05 +0200
Subject: [PATCH] feat: add a --global-init-search option
---
lib/sasacore/sasArg.ml | 27 ++++++++++++-------
lib/sasacore/sasArg.mli | 8 +++---
lib/sasacore/simuState.ml | 13 +++++----
lib/sasacore/simuState.mli | 4 ++-
lib/sasacore/worstInit.ml | 54 +++++++++++++++++++++++++++++++++++---
lib/sasacore/worstInit.mli | 28 ++++++++++++++++++++
src/sasaMain.ml | 22 +++++++++++-----
7 files changed, 125 insertions(+), 31 deletions(-)
create mode 100644 lib/sasacore/worstInit.mli
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index 1a41a5ba..8eaf4f60 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -1,5 +1,7 @@
-(* Time-stamp: <modified the 14/11/2021 (at 18:34) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/04/2022 (at 10:07) by Erwan Jahier> *)
+type init_search =
+ No_init_search | Local of int | Global of int | Annealing of int
type t = {
mutable topo: string;
@@ -17,8 +19,7 @@ type t = {
mutable dummy_input: bool;
mutable output_algos: bool;
mutable gen_register: bool;
- mutable init_search_max_trials: int option;
- mutable init_search_sa: bool;
+ mutable init_search: init_search;
mutable _args : (string * Arg.spec * string) list;
mutable _user_man : (string * string list) list;
@@ -52,8 +53,7 @@ let (make_args : unit -> t) =
dummy_input = false;
output_algos = false;
gen_register = false;
- init_search_max_trials = None;
- init_search_sa = false;
+ init_search = No_init_search;
_args = [];
_user_man = [];
_hidden_man = [];
@@ -153,15 +153,22 @@ let (mkoptab : string array -> t -> unit) =
(* (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"]; *)
- mkopt args ["--init-search";"-is"]
- (Arg.Int(fun i -> args.init_search_max_trials <- Some i))
+ mkopt args ["--local-init-search";"-is"]
+ (Arg.Int(fun i -> args.init_search <- Local i))
["Use local search algorithms to find an initial configuration that pessimize ";
"the step number. The argument is the maximum number of trials to do the search. ";
"Require the state_to_nums Algo.to_register field to be defined."] ~arg:" <int>";
- mkopt args ["--init-search-sa";"-issa"]
- (Arg.Int(fun i -> args.init_search_sa <- true; args.init_search_max_trials <- Some i))
- ["ditto + simulated annealing. XXX experimental"] ~arg:" <int>";
+ mkopt args ["--global-init-search";"-gis"]
+ (Arg.Int(fun i -> args.init_search <- Global i))
+ ["Use global (i.e., completely random) search to find an initial configuration ";
+ "that pessimize the step number. The argument is the maximum number of trials";
+ " to do the search. "] ~arg:" <int>";
+
+(* mkopt args ["--init-search-simulated-annealing";"-issa"]
+ (Arg.Int(fun i -> args.init_search <- Annealing i))
+ ["ditto + simulated annealing. XXX NOT YET IMPLEMENTED"] ~arg:" <int>";
+*)
mkopt args ["--cores-nb";"-cn"]
(Arg.Int(fun i -> args.cores_nb <- i))
["Number of cores to use during --init-search simulations (default is 1)"];
diff --git a/lib/sasacore/sasArg.mli b/lib/sasacore/sasArg.mli
index 800c0e67..ab229e78 100644
--- a/lib/sasacore/sasArg.mli
+++ b/lib/sasacore/sasArg.mli
@@ -1,4 +1,7 @@
-(* Time-stamp: <modified the 14/11/2021 (at 18:34) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/04/2022 (at 09:32) by Erwan Jahier> *)
+
+type init_search =
+ No_init_search | Local of int | Global of int | Annealing of int
type t = {
mutable topo: string;
@@ -16,8 +19,7 @@ type t = {
mutable dummy_input: bool;
mutable output_algos: bool;
mutable gen_register: bool;
- mutable init_search_max_trials: int option;
- mutable init_search_sa: bool;
+ mutable init_search: init_search;
mutable _args : (string * Arg.spec * string) list;
mutable _user_man : (string * string list) list;
diff --git a/lib/sasacore/simuState.ml b/lib/sasacore/simuState.ml
index 3fe54131..bd988062 100644
--- a/lib/sasacore/simuState.ml
+++ b/lib/sasacore/simuState.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/11/2021 (at 10:59) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/04/2022 (at 11:07) by Erwan Jahier> *)
open Register
open Topology
@@ -265,7 +265,10 @@ let (make : bool -> string array -> 'v t) =
let e = update_env_with_init e pl in
let algo_neighors = List.map (update_neighbor_env e) algo_neighors in
let pl_n = List.combine pl algo_neighors in
-
+ let neighbors =
+ List.fold_left (fun acc (p,nl) -> StringMap.add p.pid nl acc)
+ StringMap.empty pl_n
+ in
if !Register.verbose_level > 1 then List.iter (dump_process "") pl_n;
if args.gen_lutin then (
let fn = (Filename.remove_extension args.topo) ^ ".lut" in
@@ -317,13 +320,9 @@ let (make : bool -> string array -> 'v t) =
(fun a -> ignore (RifRead.bool (args.verbose>1) p.pid (StringOf.action a)))
p.actions)
pl;
- Printf.eprintf "Ignoring the first vectors of sasa inputs\n%!";
+ Printf.eprintf "Ignoring the first vector 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;
diff --git a/lib/sasacore/simuState.mli b/lib/sasacore/simuState.mli
index e6e4efa7..156738d9 100644
--- a/lib/sasacore/simuState.mli
+++ b/lib/sasacore/simuState.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 31/03/2022 (at 17:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/04/2022 (at 14:51) by Erwan Jahier> *)
(** The module is used by
- the main sasa simulation loop (in ../../src/sasaMain.ml)
@@ -27,6 +27,8 @@ val get_enable_processes: 'v t -> 'v enable_processes
(** [update_config e c] updates c using e *)
val update_config: 'v Conf.t -> 'v t -> 'v t
+val update_env_with_init : 'v Conf.t -> 'v Process.t list -> 'v Conf.t
+
(** Get pid's state and neighbors *)
val neigbors_of_pid : 'v t -> string -> 'v * ('v Register.neighbor * string) list
diff --git a/lib/sasacore/worstInit.ml b/lib/sasacore/worstInit.ml
index a4e86f18..ba9a5330 100644
--- a/lib/sasacore/worstInit.ml
+++ b/lib/sasacore/worstInit.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/11/2021 (at 12:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/04/2022 (at 14:52) by Erwan Jahier> *)
open Register
@@ -261,9 +261,57 @@ let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
)
)
- in
-
+ in
match LocalSearch.run g None with
| LocalSearch.Stopped -> assert false (* SNO *)
| LocalSearch.NoMore-> assert false (* SNO *)
| LocalSearch.Sol (sol, more) -> run_more sol more
+
+open Topology
+open SimuState
+open Process
+(* generate a new random configuration using the user init functions *)
+let reinit_simu g ss =
+ let pl = List.map2
+ (fun n p ->
+ { p with
+ init = let algo_id = Filename.chop_suffix n.Topology.file ".ml" in
+ Register.get_init_state algo_id (List.length (g.succ p.pid)) p.pid
+ })
+ g.nodes
+ ss.network
+ in
+ let e = Conf.init () in
+ let e = SimuState.update_env_with_init e pl in
+
+ update_config e ss
+
+(*****************************************************************************)
+(* Global search : use no heuristic, the init wtate is chosen at random *)
+let (global : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
+ -> 'v SimuState.t) =
+ fun log run ss_init dmax ->
+ let dot_file = ss_init.sasarg.topo in
+ let g = Topology.read dot_file in
+ let percent_done = ref 0 in
+ let rec loop cpt (ss_worst, worst) =
+ let ss = reinit_simu g ss_init in
+ let ss_worst, worst =
+ let res = run ss in
+ Printf.fprintf log "simu %d, cost=%d\n%!" cpt res;
+ if res > worst then (
+ Printf.printf "Hey, I've found a conf of cost %d! (simu #%d)\n%!" res cpt;
+ ss, res
+ )
+ else
+ ss_worst, worst
+ in
+ let n_percent_done = cpt / (dmax / 100) in
+ if n_percent_done <> !percent_done then (
+ percent_done := n_percent_done;
+ Printf.printf "%d%% of the %d simulations have been tryied so far...\r%!"
+ n_percent_done dmax
+ );
+ if cpt > dmax then ss_worst else loop (cpt+1) (ss_worst, worst)
+ in
+ loop 1 (ss_init, run ss_init)
diff --git a/lib/sasacore/worstInit.mli b/lib/sasacore/worstInit.mli
new file mode 100644
index 00000000..7adaef62
--- /dev/null
+++ b/lib/sasacore/worstInit.mli
@@ -0,0 +1,28 @@
+(* Time-stamp: <modified the 06/04/2022 (at 14:55) by Erwan Jahier> *)
+
+(** 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 using various
+ heuristics. *)
+val fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int ->
+ 'v SimuState.t
+
+(** Global search : use no heuristic, the init wtate is chosen at
+ random using the user init functionstype 's node = { st : 's; d : int; cost : int; cpt : int; }
+val debug : bool
+type distance = Far | Close
+val mutate_value : 'a -> 'b -> 'c
+val one_dim_succ : 'a -> 'b array -> 'b array
+val ran_dim_succ : 'a -> 'b array -> 'b array
+val all_dim_succ : 'a -> 'b array -> 'b array
+val tf : int -> float
+val ti : float -> int
+module ValueArrayNode : sig val compare : 'a node -> 'b node -> int end
+module Q : sig end
+val value2str : 'a -> 'b
+val point2str : 'a array -> string
+val reinit_simu : 'a -> 'b -> 'ca*)
+val global : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int ->
+ 'v SimuState.t
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index 3b4bfa36..6cd7cf0c 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -7,7 +7,7 @@ let (print_step : out_channel -> 'v SimuState.t -> int -> int -> string -> strin
'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 = bll2str enab_ll in
- if st.sasarg.init_search_max_trials <> None then (
+ if st.sasarg.init_search <> No_init_search 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
@@ -191,8 +191,8 @@ let () =
let n = st.sasarg.length in
let oc_rif = match st.sasarg.output_file_name with None -> stdout | Some fn -> open_out fn in
try
- match st.sasarg.init_search_max_trials, st.sasarg.daemon with
- | None, (ExhaustSearch|ExhaustCentralSearch) ->
+ match st.sasarg.init_search, st.sasarg.daemon with
+ | No_init_search, (ExhaustSearch|ExhaustCentralSearch) ->
let log = open_out (st.sasarg.topo ^ ".log") in
let path = ExhaustSearch.f log (st.sasarg.daemon=ExhaustCentralSearch) st in
List.iteri
@@ -213,13 +213,15 @@ let () =
(if st.sasarg.rif then "#" else "#")
!moves (plur !moves) i (plur i) !rounds (plur !rounds);
- | None,_ ->
+ | No_init_search, _ ->
ignore (simuloop stdout n n "" st)
- | Some maxt, _ ->
+ | Annealing _, _ -> assert false (* TODO *)
+ | (Local maxt|Global 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
+ let search_kind = match st.sasarg.init_search with Local _ -> "local" | _ -> "global" in
let run s =
moves := 0;
rounds := 0;
@@ -245,7 +247,8 @@ let () =
if res = n then (
Printf.printf " (%s)\n%!" (StringOf.env_rif s.config st.network);
Printf.fprintf newdot "%s\n" (SimuState.to_dot s);
- Printf.printf "%s and %s have been generated\n" (s.sasarg.topo ^ ".log") newdot_fn;
+ Printf.printf "%s and %s have been generated using a %s search\n"
+ (s.sasarg.topo ^ ".log") newdot_fn search_kind;
flush_all();
close_out newdot;
close_out log;
@@ -257,7 +260,12 @@ let () =
else
res
in
- let st = (WorstInit.fchc log run st maxt) in
+ let st =
+ if search_kind = "local" then
+ WorstInit.fchc log run st maxt
+ else
+ WorstInit.global 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;
--
GitLab