Commit 680b45f7 authored by erwan's avatar erwan
Browse files

feat: add a --global-init-search option

parent 9e402d87
Pipeline #95745 failed with stages
in 3 minutes and 43 seconds
(* 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)"];
......
(* 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;
......
(* 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;
......
(* 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
......
(* 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)
(* 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
......@@ -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;
......
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