diff --git a/test/bfs-spanning-tree/Makefile b/test/bfs-spanning-tree/Makefile new file mode 100644 index 0000000000000000000000000000000000000000..a111c0b5e268b080fdb775db8128d5a3ed19bca3 --- /dev/null +++ b/test/bfs-spanning-tree/Makefile @@ -0,0 +1,8 @@ +# Time-stamp: <modified the 08/03/2019 (at 16:12) by Erwan Jahier> + + +test: root.cmxs p.cmxs + $(sasa) -l 200 fig5.1.dot -sd + +-include ../Makefile.inc + diff --git a/test/bfs-spanning-tree/fig5.1.dot b/test/bfs-spanning-tree/fig5.1.dot new file mode 100644 index 0000000000000000000000000000000000000000..75e93f1656a80935620845a47d9bf612868a2912 --- /dev/null +++ b/test/bfs-spanning-tree/fig5.1.dot @@ -0,0 +1,14 @@ +graph fig4_1 { + + p1 [algo="root.cmxs" init="d=2" init="par=0"] + p2 [algo="p.cmxs" init="d=0" init="par=0"] + p3 [algo="p.cmxs" init="d=2" init="par=0"] + p4 [algo="p.cmxs" init="d=4" init="par=1"] + p5 [algo="p.cmxs" init="d=3" init="par=1"] + p6 [algo="p.cmxs" init="d=4" init="par=1"] + p7 [algo="p.cmxs" init="d=1" init="par=2"] + p8 [algo="p.cmxs" init="d=3" init="par=0"] + + p1 -- p2 -- p3 -- p4 -- p5 -- p6 -- p7 -- p8 -- p1 + p3 -- p7 +} diff --git a/test/bfs-spanning-tree/p.ml b/test/bfs-spanning-tree/p.ml new file mode 100644 index 0000000000000000000000000000000000000000..560ddabec6e8c9b6f0b5ab1b20dd788bff8d9ac1 --- /dev/null +++ b/test/bfs-spanning-tree/p.ml @@ -0,0 +1,70 @@ +(* 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; + () + diff --git a/test/bfs-spanning-tree/root.ml b/test/bfs-spanning-tree/root.ml new file mode 100644 index 0000000000000000000000000000000000000000..ef7e0f7b7f5ae9e10a489667cf49e42213d53a5c --- /dev/null +++ b/test/bfs-spanning-tree/root.ml @@ -0,0 +1,24 @@ +(* Time-stamp: <modified the 08/03/2019 (at 13:54) by Erwan Jahier> *) + +(* This is algo 5.3 in the book *) + +open Algo + +let vars = ["d",It] +let d=10 + +let init_vars = function _ -> I (Random.int d) + +let enable_f nl e = if (e "d") <> I 0 then ["CD"] else [] + +let step_f nl e = function | _ -> (function "d" -> I 0 | _ -> assert false) + + +let () = + let algo_id = "root" 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; + () +