p.ml

(* Time-stamp: <modified the 10/03/2019 (at 20:50) by Erwan Jahier> *)

(* This is algo 5.4 in the book *)

open Algo

let vars = ["d",It; "par",Nt ]
let d=10
let actions = ["CD";"CP"]
              
let (init_vars: neighbor list -> local_env) =
  fun nl -> function
  | "d" -> I (Random.int d)
  | "par" -> N (Random.int ((List.length nl)-1))
  | _ -> raise Not_found
    
(* casting *)
let i v = match v with I i | N i -> i | _ -> assert false

let (dist: neighbor list -> int) = fun nl -> 
  let dl = List.map (fun n -> i (n.lenv "d")) nl in
  1+(List.fold_left min (d-1) dl)

let (dist_ok: neighbor list -> local_env -> bool) =
  fun nl e -> 
  let dl = List.map (fun n -> i (n.lenv "d")) nl in
  let md = List.fold_left min (List.hd dl) (List.tl dl) in
  i (e "d") - 1 = md

let (get_parent: neighbor list -> local_env -> neighbor) =
  fun nl e ->
    let canal = i (e "par") in
    try List.nth nl canal
    with Failure _ -> failwith (Printf.sprintf "Canal %i does not exist (canal in [0..%i])\n" canal ((List.length nl)-1)) 

let (enable_f:neighbor list -> local_env -> action list) =
  fun nl e -> 
    let par = get_parent nl e in
    let par_env = par.lenv in
    (if i (e "d") <> dist nl then ["CD"] else []) @
    (if (dist_ok nl e) && (i (par_env "d") <> i (e "d") -1) then ["CP"] else [])


let (index_of_first_true : bool list -> int) = fun bl -> 
  let rec f i = 
  function
  | [] -> assert false
  | false::tail -> f (i+1) tail
  | true::_ -> i
 in
 f 0 bl
   
let (step_f : neighbor list -> local_env -> action -> local_env) =
  fun nl e -> 
    function
    | "CD" -> (function "d" -> I (dist nl) | o -> e o)
    | "CP" -> (
        function
        | "par" ->
          let d = i (e "d") in
          let ok_l = List.map (fun n -> i (n.lenv "d") = d-1) nl in
          let q = index_of_first_true ok_l in
          I q
        | o -> e o
      )
    | _ -> assert false

let () =
  let algo_id = "p" in
  Algo.reg_vars      algo_id vars;
  Algo.reg_init_vars algo_id init_vars; 
  Algo.reg_enable    algo_id enable_f;
  Algo.reg_step      algo_id step_f;
  Algo.reg_actions   algo_id actions;
  ()