diff --git a/lib/sasacore/exhaustSearch.ml b/lib/sasacore/exhaustSearch.ml
index 264f5b40243383e3834e2a94da3fe4de3a003801..aba1d0f9855a7f6a259096e8ee73e60a9cc563c6 100644
--- a/lib/sasacore/exhaustSearch.ml
+++ b/lib/sasacore/exhaustSearch.ml
@@ -115,7 +115,17 @@ let (bnb : out_channel -> bool -> 'v ss ->
)
in
let pot0 = pot st0 in
- pot_init := pot0;
+ pot_init := pot0;
+(* let t0 = 1000. in
+ let lambda = 0.99 in
+ let sa_temp pt =
+ if args.init_search_sa then
+ pt *. lambda
+ else
+ min_float
+ in
+ let sa_reset
+ *)
let pb =
{
init = { st=marshall_ss st0; d=0; pot=pot0 ; cpt=0; path=[]; cost=pot0 }, Q.empty, ();
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index 8fb49d61e0804fc870dae890c89786092d55df7e..1a41a5ba0d93265743db46ca95fbb3056275ef6a 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/11/2021 (at 10:53) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/11/2021 (at 18:34) by Erwan Jahier> *)
type t = {
@@ -18,6 +18,7 @@ type t = {
mutable output_algos: bool;
mutable gen_register: bool;
mutable init_search_max_trials: int option;
+ mutable init_search_sa: bool;
mutable _args : (string * Arg.spec * string) list;
mutable _user_man : (string * string list) list;
@@ -52,6 +53,7 @@ let (make_args : unit -> t) =
output_algos = false;
gen_register = false;
init_search_max_trials = None;
+ init_search_sa = false;
_args = [];
_user_man = [];
_hidden_man = [];
@@ -156,6 +158,9 @@ let (mkoptab : string array -> t -> unit) =
["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 ["--cores-nb";"-cn"]
(Arg.Int(fun i -> args.cores_nb <- i))
diff --git a/lib/sasacore/sasArg.mli b/lib/sasacore/sasArg.mli
index 461b0cd252069b5ed8c3eaf7dccff5697aacbc37..800c0e67af3e380a4cf199a50af7f331e001e4ca 100644
--- a/lib/sasacore/sasArg.mli
+++ b/lib/sasacore/sasArg.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 19/10/2021 (at 15:11) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/11/2021 (at 18:34) by Erwan Jahier> *)
type t = {
mutable topo: string;
@@ -17,6 +17,7 @@ type t = {
mutable output_algos: bool;
mutable gen_register: bool;
mutable init_search_max_trials: int option;
+ mutable init_search_sa: bool;
mutable _args : (string * Arg.spec * string) list;
mutable _user_man : (string * string list) list;
diff --git a/lib/sasacore/worstInit.ml b/lib/sasacore/worstInit.ml
index a6f91a2b6a2804e3c8c94f086b2a240f8bb09012..a4e86f18362ba76fcc13395224dad18f1a75025c 100644
--- a/lib/sasacore/worstInit.ml
+++ b/lib/sasacore/worstInit.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/11/2021 (at 11:48) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/11/2021 (at 12:06) by Erwan Jahier> *)
open Register
@@ -7,13 +7,16 @@ type point = value Array.t
let debug = false
-
-let deltaf=1.0 (* something else ?? *)
-let mutate_value = function
+type distance = Far | Close
+let mutate_value distance = function
| F (minf,f,maxf) ->
+ let deltaf = match distance with
+ | Far -> (maxf-.minf)
+ | Close -> (maxf-.minf) /. 100.
+ in
let nf =
- if minf > f -. deltaf then
- minf+.(Random.float (2.0 *. deltaf))
+ if minf > f -. deltaf then
+ minf+.(Random.float (2.0 *. deltaf))
else if maxf < f +. deltaf then
maxf -. (Random.float (2.0 *. deltaf))
else
@@ -22,37 +25,42 @@ let mutate_value = function
F(minf, nf, maxf)
| I (mini,i,maxi) ->
- let ni = if i=mini then i+1 else if i=maxi then i-1 else
- if Random.bool () then i+1 else i-1
+ let deltai = match distance with
+ | Far -> (maxi - mini) / 2
+ | Close -> ((maxi - mini) / 100)
+ in
+ let deltai = 1+Random.int (max 1 deltai) in
+ let ni = if i=mini then i+deltai else if i=maxi then i-deltai else
+ if Random.bool () then i+deltai else i-deltai
in
I (mini,ni,maxi)
- | B b -> B (not b)
-
+ | B b -> B (not b)
-let one_dim_succ n =
+let one_dim_succ d n =
let p = Array.copy n in
let j = Random.int (Array.length p) in
- p.(j) <- mutate_value p.(j);
+ p.(j) <- mutate_value d p.(j);
p
-let ran_dim_succ n =
+let ran_dim_succ d n =
let p = Array.copy n in
for j=0 to Array.length p - 1 do
- if Random.bool () then p.(j) <- mutate_value p.(j)
+ if Random.bool () then p.(j) <- mutate_value d p.(j)
done;
p
-let all_dim_succ n =
+let all_dim_succ d n =
let p = Array.copy n in
for j=0 to Array.length p - 1 do
- p.(j) <- mutate_value p.(j)
+ p.(j) <- mutate_value d p.(j)
done;
p
-(* let tf = float_of_int *)
-
+let tf = float_of_int
+let ti = int_of_float
+
let (choose : int -> point -> (point -> point) -> point list) =
fun n p heuristic ->
(*choose n successors of p using heuristic *)
@@ -163,7 +171,8 @@ let point2str p =
let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
-> 'v SimuState.t) =
fun log run ss_init dmax ->
- let cpt = ref 0 in
+ let cpt = ref 0 in
+ let step_cpt = ref 1 in
let cost p = run (point_to_ss p ss_init) in
let pinit = ss_to_point ss_init in
let percent_done = ref 0 in
@@ -171,11 +180,27 @@ let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
{
init = ({ st = pinit ; d = 0 ; cost = cost pinit ; cpt = 0 }, Q.empty, ());
succ = (fun n ->
- let m = min 50 (max 1 (dmax / 10)) in
- let m = min m (max 1 (dmax - !cpt - 2)) in
- let pl = (choose m n.st one_dim_succ) @
- (choose 1 n.st ran_dim_succ) @
- (choose 1 n.st all_dim_succ)
+ (* let beam_size = min 50 (max 1 (dmax / 10)) in *)
+ (* let beam_size = min m (max 1 (dmax - !cpt - 2)) in *)
+ (* let beam_size = max 1 (dmax / (10 * !step_cpt)) in (* 10% of the points to simulate. *)
+
+ let beam_size_part0 = beam_size / 6 in
+ let beam_size_part1 = max 1 beam_size_part0 in
+
+ *)
+ let beam_size = max 50 ss_init.sasarg.cores_nb in
+ let percent_close = ((tf !cpt) /. (tf dmax)) ** 2.0 in
+ let percent_far = 1.0 -. percent_close in
+
+ let far_nb = max 1 (ti ((tf beam_size) *. percent_far) / 6) in
+ let close_nb = max 1 (ti ((tf beam_size) *. percent_close) / 6) in
+ incr step_cpt;
+ let pl = (choose far_nb n.st (one_dim_succ Close)) @
+ (choose far_nb n.st (ran_dim_succ Close)) @
+ (choose far_nb n.st (all_dim_succ Close)) @
+ (choose close_nb n.st (one_dim_succ Far)) @
+ (choose close_nb n.st (ran_dim_succ Far)) @
+ (choose close_nb n.st (all_dim_succ Far))
in
let new_cpt, res =
map_local_fold
diff --git a/salut/src/dune b/salut/src/dune
new file mode 100644
index 0000000000000000000000000000000000000000..f4c25e2510d78905b129b9b29d7f65c98ef05d5a
--- /dev/null
+++ b/salut/src/dune
@@ -0,0 +1,16 @@
+;; Time-stamp: <modified the 21/11/2021 (at 17:50) by Erwan Jahier>
+
+(executable
+ (name dot2lus)
+ (flags -noassert)
+ (link_flags (-linkall))
+ (libraries ocamlgraph lutils sasacore algo)
+)
+
+(install
+ (section bin)
+ (package sasa)
+ (files (dot2lus.exe as salut))
+; (files sasaRun.cmxa)
+)
+