p.ml

(* Time-stamp: <modified the 11/06/2019 (at 16:40) by Erwan Jahier> *)

(* This is algo 5.4 in the book *)

open Algo

let vars = ["d",It; "par",Nt ]
let d=10 (* degree() *)
let actions = ["CD";"CP"]
              
let (init_vars: neighbor list -> local_env) =
  fun nl ->
    let e = empty_env in
    let e = set e "d" (I (Random.int d)) in
    let e = set e "par" (N (Random.int ((List.length nl)))) in
    e
    
(* 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 (get 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 (get n.lenv "d")) nl in
  let md = List.fold_left min (List.hd dl) (List.tl dl) in
  i (get e "d") - 1 = md

let (get_parent: neighbor list -> local_env -> neighbor) =
  fun nl e ->
    let canal = i (get 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 (get e "d") <> dist nl then ["CD"] else []) @
    (if (dist_ok nl e) && (i (get par_env "d") <> i (get 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" -> set e "d" (I (dist nl)) 
    | "CP" ->
      let d = i (get e "d") in
      let ok_l = List.map (fun n -> i (get n.lenv "d") = d-1) nl in
      let q = index_of_first_true ok_l in
      set e "par" (I q)
        
    | _ -> 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;
  ()