(* 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; ()