From 9e9446a75e28264db7679cd75ed5bc4af0b10eb8 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 8 Oct 2021 10:06:01 +0200
Subject: [PATCH] use the core number provided in the sasa cli
---
lib/sasacore/sasArg.ml | 3 ++-
lib/sasacore/worstInit.ml | 34 +++++++++++++++++++++-------------
src/sasaMain.ml | 9 ++-------
test/coloring/grid10.dot | 2 +-
4 files changed, 26 insertions(+), 22 deletions(-)
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index b11adaad..0c77190c 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/10/2021 (at 10:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/10/2021 (at 16:54) by Erwan Jahier> *)
type t = {
@@ -241,6 +241,7 @@ let parse argv = (
let args = make_args () in
mkoptab argv args;
Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg argv.(0));
+ Functory.Cores.set_number_of_cores args.cores_nb;
(List.iter
(fun f ->
if (String.sub f 0 1 = "-") then
diff --git a/lib/sasacore/worstInit.ml b/lib/sasacore/worstInit.ml
index 2b3d3f96..61a394ab 100644
--- a/lib/sasacore/worstInit.ml
+++ b/lib/sasacore/worstInit.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/10/2021 (at 17:34) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/10/2021 (at 10:05) by Erwan Jahier> *)
open Register
@@ -132,13 +132,20 @@ module NumArrayNode = struct
let compare n1 n2 = compare n2.cost n1.cost
end
-
-let _ = Functory.Cores.set_number_of_cores 4
-
(* open Functory.Sequential *)
open Functory.Cores
module Q = Psq.Make (Int) (NumArrayNode)
-
+
+let num2str = function
+ Register.F f -> string_of_float f
+ | Register.I i -> string_of_int i
+ | Register.B true -> "t"
+ | Register.B false -> "f"
+
+let point2str p =
+ Array.fold_right (fun num acc -> (num2str num)::acc) p []
+ |> String.concat ";"
+
(* First Choice Hill Climbing: a successor is chosen at random (using
some heuristics), and became the current state if its cost is
better.
@@ -146,7 +153,8 @@ module Q = Psq.Make (Int) (NumArrayNode)
The heuristic to choose the succ is chosen at random in an array of
heuristics. The probability of each heuristic evolves, but is
never null. *)
-let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int -> 'v SimuState.t) =
+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 cost p = run (point_to_ss p ss_init) in
@@ -160,29 +168,29 @@ let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int -> '
(choose 1 n.st ran_dim_succ) @
(choose 1 n.st all_dim_succ)
in
- Printf.fprintf log "fchc: %d+2=%d points have been drawn\n " m (List.length pl);
- (* List.map (fun p -> *)
- (* Functory.Cores.map ~f: (fun p -> *)
let new_cpt, res =
map_local_fold
~f: (fun p -> cost p, p)
~fold:(fun (cpt,nl) (c,p) ->
- Printf.fprintf log "At depth %d, cost=%d\n" (n.d+1) c;
+ Printf.fprintf log "At depth %d, cost=%d\n%!" (n.d+1) c;
cpt+1,{ d=n.d+1; cost=c; st=p ; cpt = cpt}::nl
)
(!cpt, [])
pl
in
+ Printf.fprintf log "fchc: cpt=%d->%d cost=[%s]\n%!" !cpt new_cpt
+ (String.concat "," (List.map (fun n -> string_of_int n.cost) res));
cpt:=new_cpt;
res
);
stop = (fun _ _n -> !cpt > dmax);
is_goal = (fun _n -> true);
push = (fun tv n ->
- Printf.fprintf log "Pushing a point of cost %d (queue size=%d)\n" (n.cost) (Q.size tv);
+ Printf.fprintf log "Pushing a point of cost %d (queue size=%d)\n%!"
+ (n.cost) (Q.size tv);
Q.add n.cpt n tv);
pop = (fun tv -> match Q.pop tv with None -> None | Some((i,x),t) ->
- Printf.fprintf log "Poping a point of cost %d (simu #%d)\n" x.cost i;
+ Printf.fprintf log "Poping a point of cost %d (simu #%d)\n%!" x.cost i;
Some(x, t));
visiting = (fun _ x -> x);
visited = (fun _ _ -> false);
@@ -202,7 +210,7 @@ let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int -> '
| LocalSearch.Sol (nsol, more) ->
if nsol.cost > psol.cost then (
- Printf.printf "Hey, I've found a configuration cost %d! (simu #%d, depth %d)\n"
+ Printf.printf "Hey, I've found a conf of cost %d! (simu #%d, depth %d)\n%!"
nsol.cost nsol.cpt nsol.d;
run_more nsol more
) else (
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index 88e3ca82..3176265a 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -192,9 +192,6 @@ let rec (simuloop: out_channel -> int -> int -> string -> 'v SimuState.t -> int)
flush_all();
i
-
-
-
let () =
let st = Sasacore.SimuState.make true Sys.argv in
let log = open_out (st.sasarg.topo ^ ".log") in
@@ -206,16 +203,14 @@ let () =
| None ->
ignore (simuloop stdout n n "" st)
| Some maxt ->
- let i = ref 1 in
let run s =
moves := 0;
rounds := 0;
round_mask := [];
- Printf.fprintf log "-------------------------- New simu (%d) \n%!" !i;
let s = SimuState.update_config s.config s in
+ Printf.fprintf log "------------- New simu from %s\n%!"
+ (StringOf.env_rif s.config s.network);
let res = simuloop log n n "" s in
- Printf.fprintf log "initial conf=(%s)\n%!" (StringOf.env_rif s.config s.network);
- incr i;
res
in
let st = (WorstInit.fchc log run st maxt) in
diff --git a/test/coloring/grid10.dot b/test/coloring/grid10.dot
index c2846222..b6f6f949 100644
--- a/test/coloring/grid10.dot
+++ b/test/coloring/grid10.dot
@@ -4,7 +4,7 @@ graph [min_deg=2
max_deg=4
is_connected=true
is_cyclic=true
- is_tree=true
+ is_tree=false
links_number=180]
p0 [algo="p.ml"]
p1 [algo="p.ml"]
--
GitLab