demon.ml

(* Time-stamp: <modified the 14/05/2019 (at 10:18) 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 -> 
    if all = [] then [] else
      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 ->
    if all = [] then [] else
      (*     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 ->
  if all = [] then [] else
  let al = List.map random_list all in
  al

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)"
  
type pna = Process.t * Algo.neighbor list * Algo.action

let (custom: pna list list -> Process.t list -> bool list list ->
     (string -> string -> bool) -> bool list list * pna list) =
  fun pnall pl enab_ll get_action_value -> 
    let f p pnal enab_l =
      let actions = p.Process.actions in
      let trigger_l = List.map (get_action_value p.Process.pid) actions in
      let acti_l_al =
        map3
          (fun trig enab a ->
             let acti = trig && enab in
             acti, if acti
             then List.filter (fun (_,_,a') -> a=a') pnal 
             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 al = snd (List.split acti_l_al) in
    let acti = List.map (List.map fst) acti_l_all in
    acti, List.flatten al

let (remove_empty_list: 'a list list -> 'a list list) =
  fun ll ->
    List.filter (fun l -> l<>[]) ll

let (get_activate_val: pna list -> Process.t list -> bool list list)=
  fun al pl ->
    let actions =
      List.map (fun p -> List.map (fun a -> p,a) p.Process.actions) pl
    in
    let al = List.map (fun (p,_,a) -> p,a) al in
    List.map  (List.map (fun a -> List.mem a al)) actions 


let (f: bool -> bool -> t -> Process.t list -> pna list list -> bool list list ->
     (string -> string -> bool) -> bool list list * pna list) =
  fun dummy_input verbose_mode demon pl all enab get_action_value ->
    if demon <> Custom && dummy_input then
      ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
    match demon with
    | Synchronous  ->
      let al = synchrone (remove_empty_list all) in
      get_activate_val al pl, al
    | Central ->
      let al = random1 (remove_empty_list all) in
      get_activate_val al pl, al
    | LocallyCentral -> assert false
    | Distributed ->
      let al = random (remove_empty_list all) in
      get_activate_val al pl, al
    | Custom -> custom all pl enab get_action_value