From c779951d807a10c5c1baa0a67f81d379bfecdf5a Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Mon, 27 Feb 2023 15:18:40 +0100
Subject: [PATCH] feat: add 2 options for exaustive searches: --es-dfs and
--es-continue-when-best-sol-found
---
lib/sasacore/exhaustSearch.ml | 50 +++++++++++++++++++++--------------
lib/sasacore/sasArg.ml | 15 +++++++++--
lib/sasacore/sasArg.mli | 4 ++-
3 files changed, 46 insertions(+), 23 deletions(-)
diff --git a/lib/sasacore/exhaustSearch.ml b/lib/sasacore/exhaustSearch.ml
index 050fbfbc..db1918f7 100644
--- a/lib/sasacore/exhaustSearch.ml
+++ b/lib/sasacore/exhaustSearch.ml
@@ -1,13 +1,13 @@
-(* Time-stamp: <modified the 08/02/2023 (at 14:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 16/02/2023 (at 09:23) by Erwan Jahier> *)
open LocalSearch
type 'v ss = 'v SimuState.t
-let pot = SimuState.compute_potentiel
+let pot st = if SimuState.legitimate st then 0.0 else SimuState.compute_potentiel st
type node = {
d : int;
- cost : float;
+ cost : float; (* pot+depth *)
pot : float;
cpt : int; (* => no sharing between config *)
path : (bool list list * bool list list * bool * float * string) list;
@@ -23,11 +23,13 @@ let delta = 1.0 (* the potential decreases of at least delta at each step *)
let best = ref None
let pot_init = ref max_float
+let dfs = ref false
+
let priority n =
let d = float_of_int n.d in
- match !best with
- | None -> if n.pot <= 0.0 then d else d -. (1.0 /. (n.pot/.delta))
- | Some b -> d +. n.pot *. (b /. !pot_init)
+ match !best, !dfs with
+ | None, _ | _, true -> if n.pot <= 0.0 then d else d -. (1.0 /. (n.pot/.delta))
+ | Some b, false -> d +. n.pot *. (b /. !pot_init)
let _priority n =
let d = float_of_int n.d in
@@ -73,6 +75,7 @@ open SimuState
let (bnb : out_channel -> bool -> 'v ss ->
(bool list list * bool list list * bool * float * 'v Conf.t) list) =
fun log central st0 ->
+ dfs := st0.sasarg.es_dfs;
let max_step = st0.sasarg.length in
let cpt = ref 0 in
let cpt_of_last_improvement = ref 0 in (* to measure the progress of the search*)
@@ -90,7 +93,8 @@ let (bnb : out_channel -> bool -> 'v ss ->
(fun al ->
incr cpt;
if !cpt mod (st0.sasarg.length / 100) = 0 && not st0.sasarg.quiet then
- Printf.printf "%d%% of steps have been tryied so far...\r%!" (!cpt / (st0.sasarg.length / 100));
+ Printf.printf "%d%% of steps have been tryied so far...\r%!"
+ (!cpt / (st0.sasarg.length / 100));
let nst = Step.f al st in
let pot_nst = pot nst in
let nst_str = marshall_ss nst in
@@ -125,7 +129,7 @@ let (bnb : out_channel -> bool -> 'v ss ->
visiting, visited
else
visiting,
- (* (fun _ v -> v), (fun _ _ -> false) *)
+ (* (fun _ v -> v), (fun _ _ -> false) *)
(fun n v -> if not (StrMap.mem n.st v) then incr visited_config_cpt; false)
in
let pot0 = pot st0 in
@@ -139,18 +143,19 @@ let (bnb : out_channel -> bool -> 'v ss ->
in
let pb =
{
- init = { st=marshall_ss st0; d=0; pot=pot0 ; cpt=0; path=[]; cost=pot0 }, Q.empty, StrMap.empty;
+ init = { st=marshall_ss st0; d=0; pot=pot0 ; cpt=0; path=[]; cost=pot0 },
+ Q.empty, StrMap.empty;
succ = successors;
stop = (fun _ _node ->
if !cpt >= max_step then (
- pf log "Max number of step reached (%d). Queue size=%d; visited confirations=%d\n%!"
+ pf log "W: Max number of step reached (%d). |Q|=%d; visited config=%d\n%!"
!cpt !qsize !visited_config_cpt;
- pf stdout "Max number of step reached (%d); use -l to change it\n%!" !cpt ;
+ pf stdout "W: Max number of step reached (%d); use -l to change it\n%!" !cpt;
true
) else if not_progressing st0.sasarg.es_stop_if_no_progress then (
- pf log "The exhaustive search did not progress for a long time (%d steps): Abort.\n%!"
+ pf log "W: The search is stuck for a long time (%d steps): Abort.\n%!"
(!cpt - !cpt_of_last_improvement);
- pf stdout "The exhaustive search did not progress for a long time (%d steps): Abort.\n%!"
+ pf stdout "W: The search is stuck for a long time (%d steps): Abort.\n%!"
(!cpt - !cpt_of_last_improvement);
true
) else (
@@ -161,7 +166,7 @@ let (bnb : out_channel -> bool -> 'v ss ->
push = (fun tv n ->
qsize := Q.size tv;
if do_log args then
- pf log " ==> Pushing a node (#%d) of cost %.1f (pot=%.1f ; d=%d ; queue size=%d ; priority=%.3f)\n%!"
+ pf log " ==> Pushing a node (#%d) of cost %.1f (pot=%.1f; d=%d; |Q|=%d; priority=%.3f)\n%!"
n.cpt n.cost n.pot n.d !qsize (priority n);
Q.add n.cpt n tv);
pop = (fun tv ->
@@ -185,7 +190,8 @@ let (bnb : out_channel -> bool -> 'v ss ->
let format sol =
let msg = Printf.sprintf " - the worst path is of length %d
- %f seconds have been spent in the priority queue
- - %d configurations have been (re-)visited\n%!" sol.d !cumulated_Q_time !visited_config_cpt
+ - %d configurations have been (re-)visited
+ - %d steps have been performed\n%!" sol.d !cumulated_Q_time !visited_config_cpt !cpt
in
print_string msg;
output_string log msg;
@@ -202,8 +208,9 @@ let (bnb : out_channel -> bool -> 'v ss ->
(List.rev path)
in
let rec run_more psol more =
- if psol.d = int_of_float !pot_init then (
- pf log "The length of this solution is equal to the initial potential (%.1f). %s\n" !pot_init
+ if psol.d = int_of_float !pot_init && not args.es_continue_after_best then (
+ pf log "The length of this solution is equal to the initial potential (%.1f). %s\n"
+ !pot_init
"\n\tIt is therefore the best we can find. \n\tStop the search.\n%!";
pf stdout "The length of this solution is equal to the initial potential (%.1f). %s\n" !pot_init
"\n\tIt is therefore the best we can find. \n\tStop the search.\n%!";
@@ -214,9 +221,10 @@ let (bnb : out_channel -> bool -> 'v ss ->
match more_sol with
| LocalSearch.Stopped
| LocalSearch.NoMore ->
+ pf log "longuest_path: %d %d %s\n" (psol.d) !cpt (if !dfs then "dfs" else "promising");
if more_sol = LocalSearch.Stopped then (
- pf log "The search stopped before the end\n";
- pf stdout "The search stopped before the end\n"
+ pf log "W: The search stopped before the end\n";
+ pf stdout "W: The search stopped before the end\n"
)
else (
pf log "All possible paths have been explored!\n";
@@ -227,7 +235,8 @@ let (bnb : out_channel -> bool -> 'v ss ->
if nsol.cost > psol.cost then (
pf stdout "==> [New longuest path] I've found a path of length %d! (after #%d steps)\n%!" (nsol.d) !cpt;
update_Q_now := true;
- pf log "==> [New longuest path] I've found a path of length %d! (after #%d steps)\n%!" (nsol.d) !cpt;
+ pf log "==> [New longuest path] I've found a path of length %d! (after #%d steps)\n%!" (nsol.d) !cpt;
+ pf log "longuest_path: %d %d %s\n" (nsol.d) !cpt (if !dfs then "dfs" else "promising");
best := Some (float_of_int nsol.d);
cpt_of_last_improvement := nsol.cpt;
run_more nsol more
@@ -244,6 +253,7 @@ let (bnb : out_channel -> bool -> 'v ss ->
| LocalSearch.NoMore-> failwith "There is no solution!"
| LocalSearch.Sol (sol, more) ->
pf log "==> The first solution has a path of length %d (step #%d)\n%!" sol.d !cpt;
+ pf log "longuest_path: %d %d %s\n" (sol.d) !cpt (if !dfs then "dfs" else "promising");
pf stdout "==> The first solution has a path of length %d (step #%d)\n%!" sol.d !cpt;
update_Q_now := true;
best := Some (float_of_int sol.d);
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index 542f422a..72a818ad 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/02/2023 (at 15:19) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/02/2023 (at 09:46) by Erwan Jahier> *)
type init_search =
No_init_search | Local of int | Global of int | Annealing of int
@@ -12,8 +12,9 @@ type t = {
(* for exhaustive daemon only *)
mutable es_stop_if_no_progress: int option;
+ mutable es_dfs: bool;
mutable es_tabu_mode: bool;
-
+ mutable es_continue_after_best: bool;
mutable rif: bool;
mutable output_file_name: string option;
mutable no_data_file: bool;
@@ -50,7 +51,9 @@ let (make_args : unit -> t) =
verbose = 0;
daemon = DaemonType.Distributed;
es_stop_if_no_progress = None;
+ es_dfs = false;
es_tabu_mode = true;
+ es_continue_after_best = false;
rif = false;
output_file_name = None;
no_data_file = false;
@@ -162,10 +165,18 @@ let (mkoptab : string array -> t -> unit) =
(Arg.Int(fun i -> args.es_stop_if_no_progress <- Some i))
["Abort the exhaustive search if not progressing (i.e., when #step>step(last sol)x<int>)." ] ~arg:" <int>";
+ mkopt args ["--es-dfs"]
+ (Arg.Unit(fun () -> args.es_dfs <- true))
+ ["Use a depth first search to exploration." ];
+
mkopt args ["--es-no-tabu"]
(Arg.Unit(fun () -> args.es_tabu_mode <- false))
["Do not use Tabu list during the exhaustive search." ];
+ mkopt args ~hide:true ["--es-continue-when-best-sol-found"]
+ (Arg.Unit(fun () -> args.es_continue_after_best <- true))
+ ["For experiment purposes: do not stop when |path(sol)|=pot(init)" ];
+
(* mkopt args ["--bad-daemon";"-bd"] ~arg:" <int>" *)
(* (Arg.Int (fun i -> args.daemon <- DaemonType.Bad i)) *)
diff --git a/lib/sasacore/sasArg.mli b/lib/sasacore/sasArg.mli
index 9c72b14b..97dbd043 100644
--- a/lib/sasacore/sasArg.mli
+++ b/lib/sasacore/sasArg.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/02/2023 (at 14:24) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/02/2023 (at 09:46) by Erwan Jahier> *)
type init_search =
No_init_search | Local of int | Global of int | Annealing of int
@@ -10,7 +10,9 @@ type t = {
mutable verbose: int;
mutable daemon: DaemonType.t;
mutable es_stop_if_no_progress: int option;
+ mutable es_dfs: bool;
mutable es_tabu_mode: bool;
+ mutable es_continue_after_best: bool;
mutable rif: bool;
mutable output_file_name: string option;
mutable no_data_file: bool;
--
GitLab