New: implement a locally central demon

nb: this demon is not fair: it is biased by the degree of nodes.

lib/sasacore/demon.ml

-(* Time-stamp: <modified the 19/06/2019 (at 10:48) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/07/2019 (at 17:22) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -7,30 +7,67 @@ type t =
   | Distributed (* select at least one action *)
   | Custom
 
+type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
+
 let (random_list : 'a list -> 'a) = fun l ->
   assert (l <> []);
   List.nth l (Random.int (List.length l))
 
-let (random1: 'a list list -> 'a list) =
+(* returns a random element of a list as well as the rest of the list *)
+let (random_list2 : 'a list -> 'a * 'a list) = fun l ->
+  assert (l <> []);
+  let rec split acc i = function
+    | [] -> assert false (* sno *)
+    | x::l -> 
+      if i=0 then x, List.rev_append acc l else split (x::acc) (i-1) l
+  in
+  let i = Random.int (List.length l) in
+  split [] i l
+
+let (central: 'a list list -> 'a list) =
   fun all -> 
     if all = [] then [] else
       let al = List.map random_list all in
       let a = random_list al in
       [a]
 
-let rec (random: 'a list list -> 'a list) =
+let rec (distributed: 'a list list -> 'a list) =
   fun all ->
     if all = [] then [] else
       (*     assert (all <> []); *)
       let al = List.map random_list all in
       let al = List.filter (fun _ -> Random.bool ()) al in
-      if al = [] then random all else al
+      if al = [] then distributed all else al
    
 let (synchrone: 'a list list -> 'a list) = fun all ->
   if all = [] then [] else
   let al = List.map random_list all in
   al
 
+(* LC= 2 neighbors cannot be activated at the same step 
+
+XXX this demon is not fair: it is biased by the degree of nodes.
+*)
+let (locally_central: 'v pna list list -> 'v pna list) =
+  fun all ->
+    let remove_one_conflict al =
+      let _a, al = random_list2 al in
+      al
+    in
+    let rec remove_conflicts al =
+      let activated_pids = List.map (fun (p,_,_) -> p.Process.pid) al in
+      let conflicts, ok = List.partition (fun (_p,nl,_a) ->
+          List.exists (fun n -> List.mem (n.Register.pid ()) activated_pids) nl
+        ) al
+      in
+      if conflicts = [] then ok else
+        let conflicts = remove_one_conflict conflicts in
+        ok @ (remove_conflicts conflicts)
+    in
+    if all = [] then [] else
+      let al = distributed all in
+      remove_conflicts al
+
 let rec map3 f l1 l2 l3 =
   match (l1, l2, l3) with
     ([], [], []) -> []
@@ -39,7 +76,6 @@ let rec map3 f l1 l2 l3 =
   | (_, [], _) -> invalid_arg "map3 (2nd arg too short)"
   | (_, _, []) -> invalid_arg "map3 (3rd arg too short)"
   
-type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
 
 let (custom: 'v pna list list -> 'v Process.t list -> bool list list ->
      (string -> string -> bool) -> bool list list * 'v pna list) =
@@ -87,10 +123,12 @@ let (f: bool -> bool -> t -> 'v Process.t list -> 'v pna list list -> bool list
       let al = synchrone (remove_empty_list all) in
       get_activate_val al pl, al
     | Central ->
-      let al = random1 (remove_empty_list all) in
+      let al = central (remove_empty_list all) in
+      get_activate_val al pl, al
+    | LocallyCentral ->
+      let al = locally_central (remove_empty_list all) in
       get_activate_val al pl, al
-    | LocallyCentral -> assert false
     | Distributed ->
-      let al = random (remove_empty_list all) in
+      let al = distributed (remove_empty_list all) in
       get_activate_val al pl, al
     | Custom -> custom all pl enab get_action_value

lib/sasacore/demon.mli

-(* Time-stamp: <modified the 19/06/2019 (at 10:50) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/07/2019 (at 17:25) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
   | Central (* select 1 action *)
-  | LocallyCentral (* never activates two neighbors actions in the same step *)
+  | LocallyCentral (* never activates two neighbors actions in the same step [1] *)
   | Distributed (* select at least one action *)
   | Custom (* enable/actions are communicated via stdin/stdout in RIF *)
 
+(* [1] nb: the current implementation of locally central demon is
+   biased by the degree of nodes. *)
+
 
 type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
 

lib/sasacore/process.ml

-(* Time-stamp: <modified the 19/06/2019 (at 10:49) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/07/2019 (at 15:53) by Erwan Jahier> *)
 
 type 'v t = {
   pid : string;
@@ -25,7 +25,8 @@ let (make: bool -> Topology.node -> 'v -> 'v t) =
       try Register.get_actions id
       with _ ->
         if custom_mode then
-          failwith "Registering actions is mandatory in algorithms when using custom demon!"
+          failwith
+            "Registering actions is mandatory in algorithms when using custom demon!"
         else ["a"]
     in
     let process = {