Implement the automatic locally central daemon

lib/sasacore/daemon.ml

-(* Time-stamp: <modified the 03/05/2021 (at 16:16) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 16:43) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -54,7 +54,7 @@ let (synchrone: 'a list list -> 'a list) = fun all ->
 
 XXX this daemon is not fair: it is biased by the degree of nodes.
 *)
-let (locally_central: 'v pna list list -> 'v pna list) =
+let (locally_central_pna: 'v pna list list -> 'v pna list) =
   fun all ->
     let remove_one_conflict al =
       let _a, al = random_list2 al in
@@ -74,6 +74,27 @@ let (locally_central: 'v pna list list -> 'v pna list) =
       let al = distributed all in
       remove_conflicts al
 
+(* Somewhat duplicate the previous one. Hard to avoid... *)
+let (locally_central: ('v * 'v list) list list -> 'v 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 (pid,_) -> pid) al in
+      let conflicts, ok = List.partition (fun (_p,nl) ->
+          List.exists (fun n -> List.mem n 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
+      fst (List.split (remove_conflicts al))
+
 let rec map3 f l1 l2 l3 =
   match (l1, l2, l3) with
     ([], [], []) -> []
@@ -137,7 +158,7 @@ let (f: bool -> bool -> t -> 'v Process.t list ->
     let al = central nall in
     get_activate_val al pl, al
   | LocallyCentral ->
-    let al = locally_central nall in
+    let al = locally_central_pna nall in
     get_activate_val al pl, al
   | Distributed ->
     let al = distributed nall in

lib/sasacore/daemon.mli

-(* Time-stamp: <modified the 07/05/2021 (at 15:25) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 16:42) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -53,3 +53,6 @@ val f : bool -> bool -> t -> 'v Process.t list ->
 (** Used in gtkgui.ml *)
 val central: 'a list list -> 'a list
 val distributed: 'a list list -> 'a list
+
+(* pid + its neighbors in input *)
+val locally_central: ('v * 'v list) list list -> 'v list

tools/rdbg4sasa/gtkgui.ml

-(* Time-stamp: <modified the 07/05/2021 (at 16:20) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/05/2021 (at 17:08) by Erwan Jahier> *)
 
 #thread
 #require "lablgtk3"
@@ -326,7 +326,7 @@ let custom_daemon p gtext vbox step_button round_button =
   let step () =
     let nodes_enabled = rdbg_nodes_enabled !e in
     let nodes = List.filter (fun (_,b) -> b) nodes_enabled in
-    let nodes = get_higher_prioriry nodes_enabled in
+    let nodes = get_higher_prioriry nodes in
     match !daemon_kind with
     | Distributed -> 
       let nodes = List.map (fun x -> [x]) nodes in
@@ -334,8 +334,7 @@ let custom_daemon p gtext vbox step_button round_button =
       Hashtbl.clear daemongui_activate;
       List.iter (fun n ->  Hashtbl.replace daemongui_activate n true) to_activate;
       sd ();
-
-      p  ("Distributed step : " ^  (String.concat "," to_activate))
+      p ("Distributed step : " ^  (String.concat "," to_activate))
     | Synchronous -> (
         Hashtbl.clear daemongui_activate;
         List.iter (fun n -> Hashtbl.replace daemongui_activate n true) nodes;
@@ -350,8 +349,20 @@ let custom_daemon p gtext vbox step_button round_button =
       sd ();
       p  ("Central step : " ^  (String.concat "," to_activate))
 
-    | LocCentral -> 
-      p  "finish me"
+    | LocCentral ->
+      let get_neigbors x =
+        let succ = snd (List.split (topology.succ x)) in
+        let pred = topology.pred x in
+        let res = List.fold_left (fun acc x -> if List.mem x acc then acc else x::acc) succ pred in
+        (* p (Printf.sprintf "voisins(%s)=%s\n" x (String.concat "," res)); *)
+        res
+      in
+      let nodes = List.map (fun x -> [x, get_neigbors x]) nodes in
+      let to_activate = Daemon.locally_central nodes in
+      Hashtbl.clear daemongui_activate;
+      List.iter (fun n ->  Hashtbl.replace daemongui_activate n true) to_activate;
+      sd ();
+      p  "Locally central step: finish me"
 
     | ManualCentral -> () (* SNO *)
     | Manual -> sd ()
@@ -612,7 +623,6 @@ let gui = main
 - couper les grosses fonctions en morceaux
 - cacher les messages issus du #use
 - lire les commandes dans text_in (comment ? c'est rdbgtop qui lance gtk maintenant...)
-- faire les modes automatiques
 - reglage de la taille des boites 
 - utiliser les GEdit.spin_button ?
     cf lablgtk/examples/spin.ml