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

lib/sasacore/sasArg.ml

-(* 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)"];

lib/sasacore/sasArg.mli

-(* 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; 

lib/sasacore/simuState.ml

-(* 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;

lib/sasacore/simuState.mli

-(* 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
 

lib/sasacore/worstInit.ml

-(* 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)

lib/sasacore/worstInit.mli

+(* 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

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;