demon.ml

(* Time-stamp: <modified the 13/03/2019 (at 17:44) by Erwan Jahier> *)

type t =
  | Synchronous (* select all actions *) 
  | Central (* select 1 action *)
  | LocallyCentral (* never activates two neighbors actions in the same step *)
  | Distributed (* select at least one action *)
  | Custom

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) =
  fun all -> 
   let al = List.map random_list all in
   let a = random_list al in
   [a]

let rec (random: 'a list list -> 'a list) =
  fun all ->
    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
   
let (synchrone: 'a list list -> 'a list) = fun all -> 
  let al = List.map random_list all in
  al


    
type pna = Process.t * Topology.neighbor list * Algo.action
(* From a list of enabled actions (pna) returns:
   - a string containing the values (in RIF) of activing_variables
   - the list of activated actions

As a side-effect, read on stdin which actions should be activated.

nb: it is possible that we read on stdin that an action should be
   activated even if it is not enabled (which would be a demon
   "error").  For the time being, we ignore the demon "error" and
   inhibit the activation.
*)
let rec map3 f l1 l2 l3 =
  match (l1, l2, l3) with
    ([], [], []) -> []
  | (a1::l1, a2::l2, a3::l3) -> let r = f a1 a2 a3 in r :: map3 f l1 l2 l3
  | ([], _, _) -> invalid_arg "map3 (1st arg too short)"
  | (_, [], _) -> invalid_arg "map3 (2nd arg too short)"
  | (_, _, []) -> invalid_arg "map3 (3rd arg too short)"
  

let (custom: bool -> pna list list -> Process.t list -> bool list list
     -> string * pna list) =
  fun verbose_mode pnall pl enab_ll -> 
    let f p pnal enab_l =
      let actions = p.Process.actions in
      let trigger_l = List.map (fun a -> RifRead.bool verbose_mode p a) actions in
      let acti_l_al =
        map3
          (fun trig enab a ->
             let acti = trig && enab in
             acti, if acti then
               let pna = List.find (fun (_,_,a') -> a=a') pnal in 
               [pna]
             else []
          ) trigger_l enab_l actions
      in
      acti_l_al
    in    
    let acti_l_all = map3 f pl pnall enab_ll in
    let acti_l_al = List.flatten acti_l_all in
    let acti_l,al = List.split acti_l_al in
    let acti = String.concat " " (List.map (fun b -> if b then "t" else "f") acti_l) in
    acti, List.flatten al

let (remove_empty_list: 'a list list -> 'a list list) =
  fun ll ->
    List.filter (fun l -> l<>[]) ll
      
let (f: bool -> t -> Process.t list -> pna list list -> bool list list ->
     string * pna list) =
  fun verbose_mode demon pl all enab ->
    match demon with
    | Synchronous  -> "", synchrone (remove_empty_list all)
    | Central -> "", random1 (remove_empty_list all)
    | LocallyCentral -> assert false
    | Distributed -> "", random (remove_empty_list all)
    | Custom -> custom verbose_mode all pl enab