Skip to content
Snippets Groups Projects
Commit ca567030 authored by erwan's avatar erwan
Browse files

fix: a bug in Greedy deamons (some paths were not tried)

parent 482d0001
No related branches found
No related tags found
No related merge requests found
(* Time-stamp: <modified the 14/10/2021 (at 16:53) by Erwan Jahier> *)
(* Time-stamp: <modified the 15/02/2023 (at 09:47) by Erwan Jahier> *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
type 'v enabled = 'v pna list list
......@@ -9,9 +9,13 @@ type 'v step = 'v triggered -> 'v SimuState.t -> 'v SimuState.t
module StringMap = Map.Make(String)
module StringSet = Set.Make(String)
(* Among the enabled nodes, groups the ones that are connected.
Indeed,
*)
let (connected_components_gen : bool -> 'v pna list list -> 'v pna list list list) =
fun only_one all ->
let pid2pnal =
let pid2pnal =
List.fold_left
(fun acc al ->
match al with
......@@ -37,32 +41,32 @@ let (connected_components_gen : bool -> 'v pna list list -> 'v pna list list lis
let component = List.map (fun pid -> StringMap.find pid pid2pnal) component in
if only_one then
[component]
else
else
f marked (component::acc) tl
and g marked nl acc =
match nl with
| [] -> marked, acc
| n::nl ->
| n::nl ->
if StringSet.mem n.Register.pid marked then
g marked nl acc
else
let marked = StringSet.add n.Register.pid marked in
if StringMap.mem n.Register.pid pid2pnal then
let marked = StringSet.add n.Register.pid marked in
if StringMap.mem n.Register.pid pid2pnal then
let n_nl = get_neighors (StringMap.find n.Register.pid pid2pnal) in
g marked (List.rev_append n_nl nl) (n.Register.pid::acc)
else
(* not all neighbors are enabled !*)
g marked nl acc
in
f StringSet.empty [] all
f StringSet.empty [] all
(* Returns all the connected components *)
let (_connected_components : 'v pna list list -> 'v pna list list list) =
fun all ->
fun all ->
connected_components_gen true all
(* Returns 1 connected component (the first its finds) *)
let (connected_component : 'v pna list list -> 'v pna list list) =
let (_connected_component : 'v pna list list -> 'v pna list list) =
fun all ->
List.hd (connected_components_gen false all)
......@@ -70,22 +74,22 @@ let time verb lbl f x =
let t = Sys.time() in
let fx = f x in
if verb then Printf.eprintf " [%s] Execution time: %fs\n" lbl (Sys.time() -. t);
fx
fx
let _time2 verb lbl f x y =
let t = Sys.time() in
let fxy = f x y in
if verb then Printf.eprintf " [%s] Execution time: %fs\n" lbl (Sys.time() -. t);
fxy
fxy
let time3 verb lbl f x y z =
let t = Sys.time() in
let fxy = f x y z in
if verb then Printf.eprintf " [%s] Execution time: %fs\n" lbl (Sys.time() -. t);
fxy
fxy
let (greedy: bool -> 'v SimuState.t -> 'v Process.t list ->
('v SimuState.t -> string -> 'v * ('v Register.neighbor * string) list) ->
('v SimuState.t -> string -> 'v * ('v Register.neighbor * string) list) ->
'v step -> 'v pna list list -> 'v pna list) =
fun verb st pl neigbors_of_pid step all ->
assert (all<>[]);
......@@ -102,11 +106,11 @@ let (greedy: bool -> 'v SimuState.t -> 'v Process.t list ->
user_pf pidl get_info
in
let cpt = ref 0 in
let (get_max :'v pna list list -> 'v pna list * float) = fun all ->
let (get_max :'v pna list list -> 'v pna list * float) = fun all ->
let pnal1, p1, shedules =
match time verb "Evil.greedy enumerate" Enumerate.all all with
| Enumerate.NoMore -> assert false
| Enumerate.Elt(pnal, c) -> pnal, pf pnal, c
| Enumerate.Elt(pnal, c) -> cpt:=1; pnal, pf pnal, c
in
let rec search_max acc (pnal_acc, v_acc) shedules =
match shedules with (* returns more than one max in case of equality *)
......@@ -122,6 +126,9 @@ let (greedy: bool -> 'v SimuState.t -> 'v Process.t list ->
let maxl =
time3 verb "Evil.greedy search" search_max [] (pnal1, p1) (shedules())
in
if verb then
Printf.eprintf "[Evil.greedy]: %d choices have the same potentials\n%!"
(List.length maxl) ;
List.nth maxl (Random.int (List.length maxl))
in
let res = fst (get_max all) in
......@@ -137,7 +144,7 @@ let (greedy_central: bool -> 'v SimuState.t -> 'v Process.t list ->
match Register.get_potential () with
| None -> failwith "No potential function has been provided"
| Some user_pf ->
let pf pna =
let pf pna =
let pidl = List.map (fun p -> p.Process.pid) pl in
let nst = step [pna] st in
let get_info pid =
......@@ -146,15 +153,15 @@ let (greedy_central: bool -> 'v SimuState.t -> 'v Process.t list ->
in
user_pf pidl get_info
in
let all =
(time verb "Evil.greedy_central connected component" connected_component all)
in
(* let all = time verb "Evil.greedy_central connected component" *)
(* connected_component all) *)
(* in *)
let cpt = ref 0 in
let (get_max :'v pna list list -> 'v pna * float) = fun all ->
let (get_max :'v pna list list -> 'v pna * float) = fun all ->
let pnal1, p1, shedules =
match time verb "Evil.greedy_central enumerate" Enumerate.central all with
| Enumerate.NoMore -> assert false
| Enumerate.Elt(pna, c) -> pna, pf pna, c
| Enumerate.Elt(pna, c) -> cpt :=1; pna, pf pna, c
in
let rec search_max acc (pnal_acc, v_acc) shedules =
match shedules with
......@@ -167,8 +174,13 @@ let (greedy_central: bool -> 'v SimuState.t -> 'v Process.t list ->
then search_max [] (pnal_acc, v_acc) (c())
else search_max [] (pnal, v) (c())
in
let maxl = (time3 verb "Evil.greedy_central search" search_max [] (pnal1, p1) (shedules())) in
List.nth maxl (Random.int (List.length maxl))
let maxl = time3 verb "Evil.greedy_central search"
search_max [] (pnal1, p1) (shedules())
in
let maxl_s = List.length maxl in
if verb && maxl_s >1 then
Printf.eprintf "[Evil.greedy]: %d choices have the same potentials\n%!" maxl_s;
List.nth maxl (Random.int maxl_s)
in
let res = fst (get_max all) in
if verb then (
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment