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

lib/algo/algo.ml

-(* 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,10 +74,10 @@ 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
+    action = pfi.Register.action 
   }
 
   

lib/algo/algo.mli

-(* 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}

lib/sasacore/evil.ml

-(* 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

lib/sasacore/register.ml

-(* 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 = {

lib/sasacore/register.mli

-(* 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

test/coloring/state.ml

@@ -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