Commit 749a8ea6 authored by erwan's avatar erwan
Browse files

Implement the automatic locally central daemon

parent cae2ab6b
(* 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
......
(* 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
(* 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
......
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