From 97ddb4733f4933319136bf18a2609893193fc0fa Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Tue, 12 May 2020 15:21:11 +0200
Subject: [PATCH] Test: add 2 missing algo files in test/alea-coloring-alt, and
fix a typo in tools/simca/Makefile
---
test/alea-coloring-alt/algo_321.ml | 65 ++++++++++++++++++++++++++++++
test/alea-coloring-alt/algo_331.ml | 50 +++++++++++++++++++++++
tools/simca/Makefile | 2 +-
3 files changed, 116 insertions(+), 1 deletion(-)
create mode 100644 test/alea-coloring-alt/algo_321.ml
create mode 100644 test/alea-coloring-alt/algo_331.ml
diff --git a/test/alea-coloring-alt/algo_321.ml b/test/alea-coloring-alt/algo_321.ml
new file mode 100644
index 00000000..26d35ef9
--- /dev/null
+++ b/test/alea-coloring-alt/algo_321.ml
@@ -0,0 +1,65 @@
+(* Time-stamp: <modified the 16/04/2020 (at 17:16) by Erwan Jahier> *)
+
+(* A variant of test/alea-coloring:
+
+ Algo 3.2.1 (page 14) of Self-stabilizing Vertex Coloring of Arbitrary Graphs
+ by Maria Gradinariu and Sebastien Tixeuil
+
+ http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.38.8441&rep=rep1&type=pdf
+*)
+
+open Algo
+
+let b=max_degree ()
+
+open State
+
+let (init_state: int -> string -> 'v) =
+ fun k id -> { id = id ; r = Random.int k }
+
+let color s = (state s).r
+
+let free_color cl = (* returns the max color that is not in cl (which is sorted) *)
+ let rec f c cl =
+ match cl with
+ [] -> c
+ | x::t ->
+ if c > x then c (* x is the max, so c is free *)
+ else if c = x then f (c-1) t (* c is not free *)
+ else assert false (* should not occur *)
+ in
+ f b cl
+
+(* returns the list of used colors *)
+let (used_colors : 'v neighbor list -> int list) = fun nl ->
+ let cl = List.map (fun n -> color n) nl in
+
+ List.sort_uniq (fun x y -> compare y x) cl
+
+(* cl is sorted, so the max is at the head *)
+let agree i cl = i = free_color cl
+
+let max_list = function
+ | [] -> assert false (* should not occur *)
+ | h :: t -> List.fold_left max h t
+
+let (enable_f: 'v -> 'v neighbor list -> action list) =
+ fun c nl ->
+ let cl = used_colors nl in
+ let agree_i = agree c.r cl in
+ let nl_same_color = List.filter (fun n -> c.r = color n) nl in
+ if not agree_i && nl_same_color <> [] && c.id > (state (max_list nl_same_color)).id
+ then ["C1"] else if
+ not agree_i && nl_same_color = []
+ then ["C2"] else []
+
+
+let (step_f : 'v -> 'v neighbor list -> action -> 'v) =
+ fun e nl ->
+ function
+ | "C1" | "C2" -> { e with r = free_color (used_colors nl) }
+ | _ -> e
+
+
+
+
diff --git a/test/alea-coloring-alt/algo_331.ml b/test/alea-coloring-alt/algo_331.ml
new file mode 100644
index 00000000..c941b39d
--- /dev/null
+++ b/test/alea-coloring-alt/algo_331.ml
@@ -0,0 +1,50 @@
+(* Time-stamp: <modified the 22/04/2020 (at 10:39) by Erwan Jahier> *)
+
+(* A variant of test/alea-coloring:
+
+ Algo 3.3.1 (page 16) of Self-stabilizing Vertex Coloring of Arbitrary Graphs
+ by Maria Gradinariu and Sebastien Tixeuil
+
+ http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.38.8441&rep=rep1&type=pdf
+*)
+
+open Algo
+open State
+
+let b=max_degree ()
+
+let (init_state: int -> string -> 'v) =
+ fun _k _id -> { id = "anonymous" ; r = 0 }
+
+let free_color cl = (* returns the max color that is not in cl, which is sorted *)
+ let rec f c cl =
+ match cl with
+ | [] -> c
+ | x::t ->
+ if c > x then c (* x is the max, so c is free *)
+ else if c = x then f (c-1) t (* c is not free: try a lower color *)
+ else assert false (* should not occur as cl is sorted *)
+ in
+ f b cl
+
+(* Returns the list of used colors, in ascending order *)
+let (used_colors : 'v neighbor list -> int list) = fun nl ->
+ let color s = (state s).r in
+ let cl = List.map color nl in
+ List.sort_uniq (fun x y -> compare y x) cl
+
+let agree i cl = i = free_color cl
+
+let (enable_f: 'v -> 'v neighbor list -> action list) =
+ fun c nl ->
+ if not (agree c.r (used_colors nl)) then ["C1"] else []
+
+let (step_f : 'v -> 'v neighbor list -> action -> 'v) =
+ fun e nl ->
+ function
+ | "C1" -> if (Random.bool ()) then e else { e with r = free_color (used_colors nl) }
+ | _ -> e
+
+
+
+
diff --git a/tools/simca/Makefile b/tools/simca/Makefile
index 2a281031..34e58a34 100644
--- a/tools/simca/Makefile
+++ b/tools/simca/Makefile
@@ -5,7 +5,7 @@ CAMPAIGN=nonreg_test_campaign.ml
Makefile.expe-rules: $(CAMPAIGN)
echo "#use \"$(CAMPAIGN)\";;\n gen_make_rules ();;" | ocaml
--include Makefile.expe-rulesexpe-rules
+-include Makefile.expe-rules
# CMXS and LOG are defined in Makefile.expe-rules, which must have been generated!
cmxs: $(CMXS)
log: $(LOG)
--
GitLab