From 197d46e39e358f77b132f6cc0b3f1cae79ccda5f Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Mon, 24 Aug 2020 16:01:13 +0200
Subject: [PATCH] Fix: the potential computed in SasaRun was wrong (and not
done at the first step with -custd)
---
lib/algo/algo.ml | 2 +-
lib/algo/algo.mli | 6 +++---
lib/sasa/sasaRun.ml | 25 +++++++++++++------------
lib/sasacore/evil.ml | 2 +-
lib/sasacore/register.ml | 2 +-
lib/sasacore/register.mli | 2 +-
test/coloring/p.ml | 5 +++--
test/coloring/state.ml | 7 +++++--
8 files changed, 28 insertions(+), 23 deletions(-)
diff --git a/lib/algo/algo.ml b/lib/algo/algo.ml
index ada7ea20..406fcdc0 100644
--- a/lib/algo/algo.ml
+++ b/lib/algo/algo.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/07/2020 (at 15:49) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:36) by Erwan Jahier> *)
open Sasacore
(* Process programmer API *)
diff --git a/lib/algo/algo.mli b/lib/algo/algo.mli
index 78a662dc..32bdca91 100644
--- a/lib/algo/algo.mli
+++ b/lib/algo/algo.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/08/2020 (at 16:11) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:56) by Erwan Jahier> *)
(** {1 The Algorithm programming Interface.} *)
(**
{1 What's need to be provided by users.}
@@ -86,8 +86,8 @@ Useful to explore best/worst case daemons
type pid = string
type 's pf_info = {
neighbors: 's neighbor list;
- curr: 's ; (* the current state *)
- next: 's; (* the state we want to compute the potential of *)
+ curr: 's; (* the current state *)
+ next: 's; (* the state we would reach if action is activated (<> None) *)
action: action option (* None if the pid has not been activated *)
}
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
diff --git a/lib/sasa/sasaRun.ml b/lib/sasa/sasaRun.ml
index 8b9dcd54..a5900398 100644
--- a/lib/sasa/sasaRun.ml
+++ b/lib/sasa/sasaRun.ml
@@ -40,15 +40,14 @@ let (get_sl_out: bool -> 'v Process.t list -> bool list list -> RdbgPlugin.sl) =
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
-let (compute_potentiel : 'v pna list -> ('v Process.t * 'v Register.neighbor list) list ->
- 'v Env.t -> RdbgPlugin.sl) =
- fun pnal p_nl_l e ->
+let (compute_potentiel: 'v pna list -> ('v Process.t * 'v Register.neighbor list) list ->
+ 'v Env.t -> 'v Env.t -> RdbgPlugin.sl) =
+ fun pnal p_nl_l e ne ->
match Register.get_potential () with
| None -> []
| Some user_pf ->
let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
let p_a_l = List.map (fun (p,_,a) -> p.Process.pid, a) pnal in
- let ne = Step.f pnal e in
let get_info pid =
{
Register.neighbors = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l);
@@ -88,12 +87,14 @@ let (make_do: string array -> SasArg.t ->
fun sl_in ->
let e = !sasa_env in
match !pre_enable_processes_opt with
- | None -> (* the first step *)
- (* 1: Get enable processes *)
- let pnall, enab_ll = Sasacore.Main.get_enable_processes p_nl_l e in
- let sasa_nenv = from_sasa_env p_nl_l e in
- pre_enable_processes_opt := Some(pnall, enab_ll);
- sasa_nenv @ (get_sl_out true pl enab_ll)
+ | None -> ( (* the first step *)
+ (* 1: Get enable processes *)
+ let pnall, enab_ll = Sasacore.Main.get_enable_processes p_nl_l e in
+ let sasa_nenv = from_sasa_env p_nl_l e in
+ let pot_sl = compute_potentiel (List.hd pnall) p_nl_l e e in
+ pre_enable_processes_opt := Some(pnall, enab_ll);
+ sasa_nenv @ (get_sl_out true pl enab_ll) @ pot_sl
+ )
| Some (pre_pnall, pre_enab_ll) ->
(* 2: read the actions from the outside process, i.e., from sl_in *)
let _, pnal = Daemon.f args.dummy_input
@@ -105,7 +106,7 @@ let (make_do: string array -> SasArg.t ->
let sasa_nenv = from_sasa_env p_nl_l ne in
(* 1': Get enable processes *)
let pnall, enab_ll = Sasacore.Main.get_enable_processes p_nl_l ne in
- let pot_sl = compute_potentiel pnal p_nl_l ne in
+ let pot_sl = compute_potentiel pnal p_nl_l e ne in
pre_enable_processes_opt := Some(pnall, enab_ll);
sasa_env := ne;
sasa_nenv @ (get_sl_out true pl enab_ll) @ pot_sl
@@ -123,7 +124,7 @@ let (make_do: string array -> SasArg.t ->
in
(* 3: Do the steps *)
let ne = Sasacore.Step.f pnal e in
- let pot_sl = compute_potentiel pnal p_nl_l ne in
+ let pot_sl = compute_potentiel pnal p_nl_l e ne in
sasa_env := ne;
(from_sasa_env p_nl_l e) @ (get_sl_out true pl enab_ll) @
(get_sl_out false pl activate_val) @ pot_sl
diff --git a/lib/sasacore/evil.ml b/lib/sasacore/evil.ml
index e4c010dc..0cf043ba 100644
--- a/lib/sasacore/evil.ml
+++ b/lib/sasacore/evil.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/07/2020 (at 09:27) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:39) by Erwan Jahier> *)
diff --git a/lib/sasacore/register.ml b/lib/sasacore/register.ml
index b7711334..a1e7fc81 100644
--- a/lib/sasacore/register.ml
+++ b/lib/sasacore/register.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/07/2020 (at 16:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:39) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
diff --git a/lib/sasacore/register.mli b/lib/sasacore/register.mli
index 4f61112f..55242e75 100644
--- a/lib/sasacore/register.mli
+++ b/lib/sasacore/register.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/07/2020 (at 16:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:39) by Erwan Jahier> *)
(** This module duplicates and extends the Algo module with get_*
functions.
diff --git a/test/coloring/p.ml b/test/coloring/p.ml
index db9dac26..e1b52c24 100644
--- a/test/coloring/p.ml
+++ b/test/coloring/p.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/04/2020 (at 10:24) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 14:31) by Erwan Jahier> *)
(* This is algo 3.1 in the book *)
open Algo
@@ -31,5 +31,6 @@ let (enable_f: 'v -> 'v neighbor list -> action list) =
if List.exists (fun n -> state n = c) nl then ["conflict"] else []
let (step_f : 'v -> 'v neighbor list -> action -> 'v) =
- fun _ nl _ ->
+ fun _ nl _ ->
+ incr State.x;
List.hd (free nl) (* Returns the smallest possible color *)
diff --git a/test/coloring/state.ml b/test/coloring/state.ml
index 622613b0..72ad22db 100644
--- a/test/coloring/state.ml
+++ b/test/coloring/state.ml
@@ -13,10 +13,13 @@ let pf pidl get =
let clash = ref 0 in
let color pid = (get pid).next in
List.iter (fun pid ->
- List.iter (fun n -> if state n = color pid then incr clash) (get pid).neighbors)
+ List.iter (fun n -> if state n = color pid then incr clash) ((get pid).neighbors))
pidl;
float_of_int !clash
-let potential = Some pf
+let x = ref 0
+let incre _ _ = float_of_int !x
+
+let potential = Some incre
let legitimate = None
let fault = None
--
GitLab