Commit b69ab053 authored by erwan's avatar erwan
Browse files

Fix: the list of neighbors provided to the potential function was wrong.

parent cd8e0e37
Pipeline #46599 passed with stages
in 14 minutes and 42 seconds
(* Time-stamp: <modified the 06/07/2020 (at 13:37) by Erwan Jahier> *)
(* Time-stamp: <modified the 06/07/2020 (at 17:03) by Erwan Jahier> *)
open Sasacore
(* Process programmer API *)
......@@ -42,7 +42,7 @@ type 's step_fun = 's -> 's neighbor list -> action -> 's
type 's state_init_fun = int -> string -> 's
type pid = string
type 's pf_info = { neighbors : pid list ; curr : 's ; next : 's ; action:action }
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
type 's algo_to_register = {
......@@ -74,7 +74,7 @@ let (to_reg_neigbor : 's Register.neighbor -> 's neighbor) =
let (to_reg_info : 's Register.pf_info -> 's pf_info) =
fun pfi ->
{
neighbors = pfi.Register.neighbors ;
neighbors = List.map to_reg_neigbor pfi.Register.neighbors ;
curr = pfi.Register.curr ;
next = pfi.Register.next ;
action = pfi.Register.action
......
(* Time-stamp: <modified the 06/07/2020 (at 13:27) by Erwan Jahier> *)
(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
(** {1 The Algorithm programming Interface.} *)
(**
{1 What's need to be provided by users.}
......@@ -84,7 +84,7 @@ val get_graph_attribute : string -> string
useful to explore best/worst case daemons
*)
type pid = string
type 's pf_info = { neighbors : pid list ; curr : 's ; next : 's ; action:action }
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
(** {1 Code Registration}
......
(* Time-stamp: <modified the 01/07/2020 (at 14:38) by Erwan Jahier> *)
(* Time-stamp: <modified the 06/07/2020 (at 16:55) by Erwan Jahier> *)
......@@ -106,19 +106,17 @@ let (worst: 'v Env.t -> 'v pna list list -> 'v pna list) =
match Register.get_potential () with
| None -> failwith "No potential function has been provided"
| Some user_pf ->
let rec action_of_pid pid = function
| [] -> assert false
| (p,_,a)::tail -> if p.Process.pid = pid then a else action_of_pid pid tail
in
let pf pnal =
let pf pnal = (* pnal contains a list of activated processes *)
let pidl = List.map (fun (p,_,_) -> p.Process.pid) pnal in
let p_nl_l = List.map (fun (p,nl,_) -> p.Process.pid, nl) pnal 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 = pidl ;
Register.neighbors = List.assoc pid p_nl_l;
Register.curr = Env.get e pid ;
Register.next = Env.get ne pid ;
Register.action = action_of_pid pid pnal
Register.action = List.assoc pid p_a_l
}
in
user_pf pidl get_info
......
(* Time-stamp: <modified the 06/07/2020 (at 13:35) by Erwan Jahier> *)
(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
......@@ -14,7 +14,7 @@ type 's enable_fun = 's neighbor list -> 's -> action list
type 's step_fun = 's neighbor list -> 's -> action -> 's
type pid = string
type 's pf_info = { neighbors : pid list ; curr : 's ; next : 's ; action:action }
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
type 's internal_tables = {
......
(* Time-stamp: <modified the 06/07/2020 (at 13:35) by Erwan Jahier> *)
(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
(** This module duplicates and extends the Algo module with get_*
functions.
......@@ -22,7 +22,7 @@ type 's enable_fun = 's neighbor list -> 's -> action list
type 's step_fun = 's neighbor list -> 's -> action -> 's
type pid = string
type 's pf_info = { neighbors : pid list ; curr : 's ; next : 's ; action:action }
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
val reg_init_state : algo_id -> (int -> string -> 's) -> unit
......
......@@ -13,7 +13,7 @@ let pf pidl get =
let clash = ref 0 in
let color pid = (get pid).next in
List.iter (fun pid ->
List.iter (fun npid -> if color npid = 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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment