diff --git a/test/alea-coloring/p.ml b/test/alea-coloring/p.ml index c7fb2513e9423df1dcebd5e06ad0cea9f209e986..d1c687a522e3a82e80f7b67b493415b2ee0c79f0 100644 --- a/test/alea-coloring/p.ml +++ b/test/alea-coloring/p.ml @@ -1,36 +1,36 @@ -(* Time-stamp: <modified the 05/03/2020 (at 21:08) by Erwan Jahier> *) +(* Time-stamp: <modified the 22/04/2020 (at 10:23) by Erwan Jahier> *) +(* Randomized version of algo 3.1 in the book *) open Algo +let k=max_degree () + 1 -let k=max_degree () - -let (init_state: int -> string -> 'v) = fun _i _ -> Random.int k - -let (clash : 'v neighbor list -> 'v list) = fun nl -> - let res = List.map (fun n -> state n) nl in - res +let (init_state: int -> string -> 'v) = fun _i _ -> 0 +(* Random.int i *) +(* Returns the free colors is ascending order (n.log(n)) *) let (free : 'v neighbor list -> 'v list) = fun nl -> - let clash_list = List.sort_uniq compare (clash nl) in - let rec aux free clash i = - if i > k then free else - (match clash with + let comp_neg x y = - (compare x y) in + let n_colors = List.map (fun n -> state n) nl in (* neighbor colors *) + let n_colors = (* neighbor colors, no duplicate, in descending order *) + List.sort_uniq comp_neg n_colors in + let rec aux free n_colors i = + (* for i=k-1 to 0, put i in free if not in n_colors *) + if i < 0 then free else + (match n_colors with | x::tail -> - if x = i then aux free tail (i+1) else aux (i::free) clash (i+1) - | [] -> aux (i::free) clash (i+1) + if x = i then aux free tail (i-1) else aux (i::free) n_colors (i-1) + | [] -> aux (i::free) n_colors (i-1) ) in - let res = aux [] clash_list 0 in - List.rev res + aux [] n_colors (k-1) let (enable_f: 'v -> 'v neighbor list -> action list) = - fun e nl -> - if List.mem e (clash nl) then ["conflict"] else [] - -let (step_f : 'v -> 'v neighbor list -> action -> 'v) = - fun e nl -> - function | _ -> - if (Random.bool ()) then e else (List.hd (free nl)) - - + fun c nl -> + if List.exists (fun n -> state n = c) nl then ["conflict"] else [] +let (step_f : 'v -> 'v neighbor list -> action -> 'v) = + fun e nl _ -> + if (Random.bool ()) then e else + (* Returns the smallest possible color *) + (List.hd (free nl)) + diff --git a/test/coloring/p.ml b/test/coloring/p.ml index 6bfb45cc176aeae6f93d534de1a69b583b30f3b0..db9dac26eb104aaf64d0ef7790ac1e1ffcb9faf8 100644 --- a/test/coloring/p.ml +++ b/test/coloring/p.ml @@ -1,48 +1,35 @@ -(* Time-stamp: <modified the 05/03/2020 (at 21:09) by Erwan Jahier> *) - +(* Time-stamp: <modified the 22/04/2020 (at 10:24) by Erwan Jahier> *) (* This is algo 3.1 in the book *) open Algo +let k=max_degree () + 1 -let k=max_degree () - -let (init_state: int -> string -> 'v) = fun _i _ -> Random.int k - -let verbose = false -let (state_to_string: ('v -> string)) = string_of_int -let (copy_state : ('v -> 'v)) = fun x -> x - -let (neigbhors_values : 'v neighbor list -> 'v list) = - fun nl -> - List.map (fun n -> state n) nl +let (init_state: int -> string -> 'v) = fun i _ -> Random.int i -let (clash : 'v -> 'v neighbor list -> bool) = fun v nl -> - let vnl = neigbhors_values nl in - let res = List.mem v vnl in - res +let (colors : 'v neighbor list -> 'v list) = fun nl -> + List.map (fun n -> state n) nl +(* Returns the free colors is ascending order (n.log(n)) *) let (free : 'v neighbor list -> 'v list) = fun nl -> - let clash_list = List.sort_uniq compare (neigbhors_values nl) in - let rec aux free clash i = - if i > k then free else - (match clash with + let comp_neg x y = - (compare x y) in + let n_colors = List.map (fun n -> state n) nl in (* neighbor colors *) + let n_colors = (* neighbor colors, no duplicate, in descending order *) + List.sort_uniq comp_neg n_colors in + let rec aux free n_colors i = + (* for i=k-1 to 0, put i in free if not in n_colors *) + if i < 0 then free else + (match n_colors with | x::tail -> - if x = i then aux free tail (i+1) else aux (i::free) clash (i+1) - | [] -> aux (i::free) clash (i+1) + if x = i then aux free tail (i-1) else aux (i::free) n_colors (i-1) + | [] -> aux (i::free) n_colors (i-1) ) in - let res = aux [] clash_list 0 in - List.rev res + aux [] n_colors (k-1) let (enable_f: 'v -> 'v neighbor list -> action list) = - fun e nl -> - if (clash e nl) then ["conflict"] else [] - + fun c nl -> + if List.exists (fun n -> state n = c) nl then ["conflict"] else [] + let (step_f : 'v -> 'v neighbor list -> action -> 'v) = - fun e nl a -> - let f = free nl in - if f = [] then e else - match a with - | _ -> List.hd f - - + fun _ nl _ -> + List.hd (free nl) (* Returns the smallest possible color *)