add a bfs spanning tree exemple (chapter 5 of the book)

test/bfs-spanning-tree/Makefile

+# 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
+

test/bfs-spanning-tree/fig5.1.dot

+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
+}

test/bfs-spanning-tree/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;
+  ()
+

test/bfs-spanning-tree/root.ml

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