From e5a41b8a1f8cbecc3507aa26dc872bddcf7fea0d Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Mon, 27 Feb 2023 16:59:02 +0100
Subject: [PATCH] delete outdated stuff
---
test/toy-example-sum/heuristic-bad-propag.ml | 132 ------------
test/toy-example-sum/heuristic-explore.ml | 202 -------------------
2 files changed, 334 deletions(-)
delete mode 100644 test/toy-example-sum/heuristic-bad-propag.ml
delete mode 100644 test/toy-example-sum/heuristic-explore.ml
diff --git a/test/toy-example-sum/heuristic-bad-propag.ml b/test/toy-example-sum/heuristic-bad-propag.ml
deleted file mode 100644
index 31ac490e..00000000
--- a/test/toy-example-sum/heuristic-bad-propag.ml
+++ /dev/null
@@ -1,132 +0,0 @@
-
-(* Heuristique : pour aller vers le pire cas du Toy Example, on cherche à maximiser le nombre
- de propagations (action top-down) d'un résultat erroné. Pour un noeud que l'action top-down R
- n'est pas possible si l'action bottom-up S est possible, il faut donc faire S lorsque
- c'est nécessaire afin de continuer à avancer, mais le moins souvent possible. *)
-
-open RdbgRun
-
-let daemon_i = ref 0
-
-type node_info = {
- lvl: int;
- s: bool;
- r: bool
-}
-
-(* Entrée : le contenu de !e.data
- Sortie : tuples ("n_S", activate) avec n le nom du noeud et S le nom de l'état, activate un booléen
- Attention, les noms ne doivent contenir que des lettres à cause du Data.type_to_string dans rdbgRun.ml:37 *)
-let custom_daemon (data: Data.subst list): Data.subst list option =
- (* liste des noeuds-états *)
- let sl = List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = "Enab_") data in
-
- (* regroupe les états par noeud *)
- let nodes = Hashtbl.create (List.length sl / 3) in
- List.iter (fun (n,v) ->
- let split = String.split_on_char '_' n in
- let enabled = match v with
- | Data.B b -> b
- | _ -> assert false
- in
-
- match split with
- | _::pid::state::[] -> (* Enab_pid_state *)
- let combine_info info =
- match state with
- | "S" -> {info with s=enabled}
- | "Rr" -> if info.lvl=0 then {info with r=enabled} else info
- | "Rp" -> if info.lvl>0 then {info with r=enabled} else info
- | _ -> assert false
- in
- (match Hashtbl.find_opt nodes pid with
- | None -> Hashtbl.add nodes pid (combine_info {lvl=Algo.level pid; s=false; r=false});
- | Some x -> Hashtbl.replace nodes pid (combine_info x);
- )
- | _ -> assert false
- ) sl;
- (* liste des états triés par niveau croissant (la racine en 1er) *)
- let nl = List.of_seq (Hashtbl.to_seq nodes) in
- let from_top = List.sort (fun (k1,v1) (k2,v2) -> Stdlib.compare v1.lvl v2.lvl) nl in
-
- (* Maximise le nombre de propagations en activant les noeuds tour à tour depuis la racine,
- Ã l'aide de la variable globale i *)
- let ni = !daemon_i in
- let n = List.length from_top in
- let res = List.flatten (List.mapi (fun i (k,v) ->
- let str_s = Printf.sprintf "%s_S" k in
- let str_rr = Printf.sprintf "%s_Rr" k in
- let str_rp = Printf.sprintf "%s_Rp" k in
- let s,rr,rp =
- if i = ni then
- (* c'est ce noeud-là qu'il faut activer, de préférence avec l'action R, sinon avec S puis R *)
- if v.r then (
- (* R maintenant *)
- daemon_i := (!daemon_i + 1) mod n;
- if v.lvl = 0 then
- false, true, false
- else
- false, false, true
- ) else (
- (* S au prochain coup *)
- assert v.s;
- true, false, false
- )
- else
- false, false, false
- in
- [(str_s, Data.B s); (str_rr, Data.B rr); (str_rp, Data.B rp)]
- ) from_top) in
-
- (* Simule le greedy daemon pour la fonction de potentiel du toy example : *)
- (* on fait R le + bas possible, sinon on fait S le + haut possible *)
- (*
- let from_bottom = List.sort (fun (k1,v1) (k2,v2) -> Stdlib.compare v2.lvl v1.lvl) nl in
- let activate_r = List.find_opt (fun (_,info) -> info.r) from_bottom in
- let activate_s = List.find_opt (fun (_,info) -> info.s) from_top in
-
- (* résultat du démon *)
- let res = List.map (fun (n,v) ->
- let split = String.split_on_char '_' n in
- match split with
- | "Enab"::pid::state::[] ->
- let activate = g
- if v = Data.B true then
- if state <> "S" then
- match activate_r with
- | Some (node,info) -> node=pid
- | None -> false
- else if activate_r = None then
- match activate_s with
- | Some (node,info) -> node=pid
- | None -> false
- else
- false
- else
- false
- in
- let str = Printf.sprintf "%s_%s" pid state in
- (str, Data.B activate)
- | _ -> assert false
- ) sl
- in *)
- Some res
-
-let is_end (e: RdbgEvent.t) =
- match (List.assoc_opt "potential" e.data) with
- | Some (Data.F 0.0) -> true
- | Some (Data.F x) -> false
- | _ -> assert false
-
-let auto () =
- let stop = ref false in
- while not !stop do
- e := next_cond !e (fun e -> e.lang = "sasa");
- pe ();
- stop := is_end !e;
- done;
- Printf.printf "done in %d moves\n" (!e.step - 1);
- ()
-
-let _ =
- rdbg_mv_hook := Some custom_daemon;
diff --git a/test/toy-example-sum/heuristic-explore.ml b/test/toy-example-sum/heuristic-explore.ml
deleted file mode 100644
index 740b6331..00000000
--- a/test/toy-example-sum/heuristic-explore.ml
+++ /dev/null
@@ -1,202 +0,0 @@
-
-(* Heuristique : pour aller vers le pire cas, on va simplement tester tous les coups
- possibles (ou presque) et choisir le scénario qui maximise le temps de stabilisation. *)
-
-open RdbgRun
-open RdbgStdLib
-
-type node_info = {
- lvl: int;
- s: bool;
- r: bool
-}
-
-let computed_moves: (string * string) list option ref = ref None
-
-let daemon_choice = ref ("", "")
-
-let set_daemon_choice (node: string) (state: string) =
- daemon_choice := node, state
-
-(* Liste des activables sous forme de couples (noeud,état) *)
-let enabled (e: RdbgEvent.t): (string * string) list =
- List.filter_map (fun (n,v) ->
- match v with
- | Data.B true -> (
- match String.split_on_char '_' n with
- | "Enab"::pid::state::[] -> Some (pid, state)
- | _ -> None
- )
- | _ -> None
- ) e.data
-
-(* Heuristique qui élimine des coups lors de l'exploration, pour en réduire le coût.
-Comme la fonction de potentiel ne mène pas toujours au pire cas sur le Toy Exemple,
-on se base sur les noeuds activables en essayant de faire l'action de propagation "R"
-en priorité. On pourrait aussi changer la fonction de potentiel et l'utiliser ici, ce
-qui rendrait la méthode beaucoup plus générale. *)
-let exploration_hint (enabled_list: (string * string) list) =
- let l = List.filter (fun (_, state) -> state = "Rp" || state = "Rr") enabled_list in
- if l = [] then enabled_list else l
-
-
-(* Explore un coup, donne le nombre de coups total qu'il engendre (pour aller jusqu'Ã la fin) *)
-let rec explore_count e i moves: int =
- let possible_choices = enabled e in
- match possible_choices with
- | [] ->
- moves (* fini *)
- | l ->
- e.save_state i;
- (* tout explorer coûte trop cher, on élimine les coups les moins intéressants *)
- let filtered = exploration_hint l in
-
- (* calcule le score de tous les coups sélectionnés *)
- let score = List.map (fun (node, st) ->
- set_daemon_choice node st;
- let next = next_cond e (fun x -> x.lang = "sasa") in
- let to_end = explore_count next (i+1) (moves+1) in
- e.restore_state i;
- to_end
- ) filtered in
-
- (* sélectionne le pire cas *)
- match score with
- | [] -> assert false
- | x::xs ->
- let worst_score = List.fold_left max x xs in
- worst_score
-
-
-(* Table des états déjà explorés, pour éviter de recalculer pour rien.
-On stocke les data des outputs en clé et les coups suivants en valeur. *)
-let explored = Hashtbl.create 64
-
-(* Donne la partie "outputs" de e.data *)
-let event_outputs (e: RdbgEvent.t) =
- (* On utilise le fait que les inputs viennent toujours en premier, puis les outputs *)
- let ins = (List.length e.inputs) + 3 in (* +3 pour enlever silent,legitimate,potential *)
- (List.filteri (fun i _ -> i >= ins) e.data)
-
- (* Autre méthode : filtrer par nom de variable et ne prendre que l'état des noeuds *)
- (* let states = ["input"; "sub"; "res"] in
- let res = List.filter_map (fun (n,v) ->
- let s = String.split_on_char '_' n in
- match s with
- | _::x::[] when List.mem x states -> Some (x,v)
- | _ -> None
- ) e.data
- in
- res *)
-
-
-(* Explore un état, donne le pire cas qu'il engendre
-(liste tous les coups suivants menant au pire cas possible à partir de cette configuration) *)
-let rec explore e i: (string * string) list =
- (* si on a déjà été dans la même situation avant, on réutilise le résultat *)
- let outputs = event_outputs e in
- match Hashtbl.find_opt explored outputs with
- | Some x -> x
- | None ->
- (
- let possible_choices = enabled e in
- match possible_choices with
- | [] -> [] (* fini: rien ensuite *)
- | l ->
- e.save_state i;
- (* tout explorer coûte trop cher, on élimine les coups les moins intéressants *)
- let filtered = exploration_hint l in
-
- (* calcule les coups suivants pour tous les coups sélectionnés *)
- let all_moves = List.map (fun (node, st) ->
- set_daemon_choice node st;
- let next = next_cond e (fun x -> x.lang = "sasa") in
- (* calcule jusqu'à la fin et choisit la pire suite de coups à partir d'ici *)
- let to_end = explore next (i+1) in
- (* restore l'évènement originel *)
- e.restore_state i;
- (* renvoie ce coup-là avec la pire suite, dans l'ordre chronologique (prepend pour + de perf) *)
- let elem = (node,st) in
- elem::to_end
- ) filtered in
-
- (* sélectionne le pire cas *)
- match all_moves with
- | [] -> assert false
- | x::xs ->
- let compare a b =
- let na = List.length a in
- let nb = List.length b in
- if nb > na then b else a
- in
- let worst_case = List.fold_left compare x xs in
- (* stocke le résultat pour éviter de le recalculer si on retombe sur cette config *)
- Hashtbl.add explored outputs worst_case;
- worst_case
- )
-
-
-(* Entrée : le contenu de !e.data
- Sortie : tuples ("n_S", activate) avec n le nom du noeud et S le nom de l'état, activate un booléen
- Attention, les noms ne doivent contenir que des lettres à cause du Data.type_to_string dans rdbgRun.ml:37 *)
-let custom_daemon (data: Data.subst list): Data.subst list option =
- (* liste des noeuds-états *)
- let sl = List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = "Enab_") data in
-
- (* évènement sasa courant *)
- let evt = !e in
-
- (* sortie du démon : active le noeud sélectionné *)
- let get_daemon_choice : string * string =
- match !computed_moves with
- | None ->
- (* lance l'exploration si elle n'est pas déjà en cours *)
- let a,b = !daemon_choice in
- if a = "" && b = "" then (
- Printf.printf "computing worst case...\n";
- let worst_case = explore evt 0 in
- let moves = worst_case in
- Printf.printf "found worst case: %d moves\n" (List.length moves);
- let first_move = List.hd moves in
- computed_moves := Some (List.tl moves);
- first_move
- )
- else
- a,b
- | Some (next_move::rest) ->
- computed_moves := Some rest;
- next_move
- | Some [] ->
- Printf.printf "no event left\n";
- assert false
- in
-
- let sel_pid, sel_state = get_daemon_choice in
- let res = List.map (fun (n,v) ->
- match String.split_on_char '_' n with
- | _::pid::state::[] ->
- let str = Printf.sprintf "%s_%s" pid state in
- let activate = (pid = sel_pid) && (sel_state = state) in
- (str, Data.B activate)
- | _ -> assert false
- ) sl in
-
- Some res
-
-let is_end (e: RdbgEvent.t) =
- match (List.assoc_opt "potential" e.data) with
- | Some (Data.F 0.0) -> true
- | _ -> false
-
-let auto () =
- let stop = ref false in
- while not !stop do
- e := next_cond !e (fun e -> e.lang = "sasa");
- pe ();
- stop := is_end !e;
- done;
- Printf.printf "done in %d moves\n" (!e.step - 1);
- ()
-
-let _ =
- rdbg_mv_hook := Some custom_daemon;
--
GitLab