p.ml

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

(* This is algo 5.4 in the book *)

open Algo

let vars = ["d",It; "par",It; ]
let d=10

let init_vars = function
  | "d" -> I (Random.int d)
  | "par" -> I (-1) (* the init should be done the graph *)
  | _ -> assert false

(* casting *)
let i v = match v with I i -> i | _ -> assert false
(* let neighbor n = match n with N n -> n | _ -> 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 enable_f nl e =
  let par = List.nth nl (i (e "par")) 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 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;
  ()