module DefaultKeysGenerator : Prioqueue.KEYS_GENERATOR = struct (* K E Y ' S G E N E R A T O R S *) exception List_was_empty let if_not_empty f l = match l with [] -> raise List_was_empty | _ -> f l;; (* give list of all n elementh permutations (as lists) *) let rec permutations n = if n = 1 then [[1]] else let rev_sub_lists l = List.rev ( List.fold_left (* f *) (fun a e -> match a with [] -> [[e]] | h::t -> ((e::h)::a) ) (* a *) [] (* l *) l ) in let sub_lists l = (List.rev_map (function l -> List.rev l)) (rev_sub_lists l) and tail_lists l = List.rev_map (if_not_empty List.tl) l in let rec add_k_in_all_pos k l = fst (List.fold_left (fun (result, sub_lists) back -> let front = if_not_empty List.hd sub_lists in ((front@(k::back))::result, if_not_empty List.tl sub_lists) ) (* a *) ([k::l], sub_lists (List.rev l)) (* l *) (tail_lists(List.rev(rev_sub_lists l))) ) in List.fold_left (* f *) (fun a h -> ((add_k_in_all_pos n h)@a)) (* a *) [] (* l *) (permutations (n - 1)) (* integers from i to j *) let rec list_i_to_j i j = if j > i then List.rev(j::(List.rev (list_i_to_j i (j - 1)))) else if i = j then [i] else [] let init_random() = Random.self_init() let random_int_from_i_to_j i j = i + Random.int (j - i) let rec list_of_n_rand_from_i_to_j n i j = let rec pom k a = if k > 0 then pom (k-1) ((random_int_from_i_to_j i j)::a) else a in pom n [] (* gives true with propability s / r *) let prop_s_div_r s r = if s >= r then true else if Random.int r < s then true else false (* gives true with propability f(loat) *) let prop_float f = if f >= 1. then true else if (Random.float 1.) < f then true else false let list_of_n_i n i = let rec loni k a = if k = 0 then a else loni (k - 1) (i::a) in loni n [] (* adds k times element min to list l in random places *) let add_k_min_to_l k min l = let rec akm s r (result, rest) = match rest with [] -> List.rev ((list_of_n_i s min)@result) | h::t -> if r > 0 then if (prop_s_div_r s r) then akm (s - 1) (r - 1) (min::result, rest) else akm s (r - 1) ( h::result, t) else List.rev ((List.rev rest)@result) in akm k (k + List.length l) ([], l) exception Propability_was_unsigned (* gives a list in which f * 100% elements are average in rithg place, the rest of them are randomized *) let randomize f l = let switch e li = let rec sw p (result, rest) = match rest with [] -> (result, e) (* <- this shouldn't happen *) | h::t -> if p > 0 then if (prop_s_div_r 1 p) then ((List.rev result)@(e::t), h) else sw (p - 1) (h::result, t) else raise Propability_was_unsigned in sw (List.length li) ([], li) in List.rev (List.fold_left (fun result hd -> (* match result with *) (* [] -> [h] *) (* | h::t -> *) if (prop_float f) then (function (l, e) -> e::(List.tl l)) (switch hd (hd::result)) else (hd::result) ) [] l ) end;; module PrioqueueTesterFunctor (KeyGen : Prioqueue.KEYS_GENERATOR) : Prioqueue.PRIOQUEUE_TESTER = functor (Prioqueue : Prioqueue.PRIOQUEUE) -> struct type generation_method = Const | Sequential of bool | Random of float (* this module is parametrized *) (* feel free to change the default values *) (* though they can be changed dynamically *) (* P A R A M E T E R S *) (* elem and min need to be of same type 'a *) let min = ref 0 (* min should be only used with minimal key *) let elem = ref 1 (* defines the smallest key in the list *) let min_key = ref 0 (* number of min elements in generated keys list *) let num_of_min = ref 100 (* number of other elements in that same list *) let num_of_other = ref 1000 (* number of deletions when testing speed *) let num_of_delete = ref 1000 (* size of permutation when generated for stats *) let permutation_size = ref 7 (* how many elements will be inserted into queue when generating stats about certain permutations *) let queue_input_size = ref 1000 (* when random : float is level of randomization, const means only min_key is in keys list *) let key_gen_method = ref (Random 1.0) (* defines hom many times a test will be repeated for one permutation *) let how_precise = ref 2 (* please remember, that the same list is used for *) (* both speed and correctness testing *) let keys = ref [] (* M E T H O D S F O R M O D I F Y I N G P A R A M E T E R S *) let max_permutation_size = 30 exception Parameter_value_is_to_low exception Parameter_value_is_to_high let set_min m = begin min := m; end let set_elem e = begin elem := e; end let set_min_key mk = begin min_key := mk; end let set_num_of_min nom = begin if nom >= 0 then num_of_min := nom else raise Parameter_value_is_to_low end let set_num_of_other noo = begin if noo >= 0 then num_of_other := noo else raise Parameter_value_is_to_low end let set_num_of_delete nod = begin if nod >= 0 then num_of_delete := nod else raise Parameter_value_is_to_low end let set_same_ins_del id = begin if id >= 0 then begin num_of_other := id; num_of_min := 0; num_of_delete := id; end else raise Parameter_value_is_to_low end let set_permutation_size ps = begin if ps >= 0 then if ps <= max_permutation_size then permutation_size := ps else raise Parameter_value_is_to_high else raise Parameter_value_is_to_low end let set_queue_input_size qis= begin if qis > 0 then queue_input_size := qis else raise Parameter_value_is_to_low end let set_key_gen_method kgm = if kgm = 0. then key_gen_method := Const else if kgm > 0. then if kgm > 1. then key_gen_method := Sequential true else key_gen_method := Random kgm else key_gen_method := Sequential false let set_base_keys l = begin keys := l end let set_how_precise hp = begin if hp > 0 then how_precise := hp else raise Parameter_value_is_to_low end let key_gen () = match !keys with [] -> begin match !key_gen_method with Const -> keys := KeyGen.list_of_n_i (!num_of_other + !num_of_min) !min_key; | Sequential b -> begin keys := (KeyGen.list_i_to_j (!min_key) (!min_key + !num_of_other + !num_of_min)); if not b then keys := List.rev !keys; end | Random f -> begin KeyGen.init_random(); if f < 1. then begin keys := KeyGen.randomize f (KeyGen.list_i_to_j (!min_key) (!min_key + !num_of_other + !num_of_min)) end else (* mutch faster way of generating fully random keys, although list will NOT be unique. to pass by consider using values of f like 0.999999 etc. *) begin keys := ( KeyGen.add_k_min_to_l !num_of_min !min_key ( KeyGen.list_of_n_rand_from_i_to_j !num_of_other (!min_key + 1) (!min_key + !num_of_min + !num_of_other)) ); end end end | _ -> match !key_gen_method with Const -> keys := KeyGen.list_of_n_i (List.length !keys) !min_key; | Sequential b -> keys := List.fast_sort (compare) !keys; | Random f -> begin KeyGen.init_random(); if f < 1. then begin keys := KeyGen.randomize f !keys; end end (* T E S T E R *) let insert_keys() = List.fold_left (* f *) (fun q h -> if h = !elem then Prioqueue.insert q h !elem else Prioqueue.insert q h !min) (* a *) (Prioqueue.empty();) (* l *) !keys (* check's if queue correctly find's min after series of inputs *) let correct_insert_find_min () = (* creates queue by inserting into empty one *) let que = insert_keys() in let (result_priority, result_elem, _) = Prioqueue.find_min que in if result_priority = !min_key && result_elem = !min then true else false let correct_delete que = let (result_keys, result_elements, que) = List.fold_left (* f *) ( fun (rp, re, q) h -> let (nrp, nre, nq) = Prioqueue.delete_min q in (nrp::rp, nre::re, nq) ) (* a *) ([], [], que) (* l *) !keys in (* here we check if all min were before other elements *) let (min_before_other, _) = List.fold_left (* f *) ( fun (a, last) h -> if a then if last = !elem then if h = !min then (false, h) else (true, h) else (true, h) else (false, h)) (* a *) (true, !min) (* l *) (List.rev result_keys) in (* definitively key's ought to be sorted *) ( List.rev result_keys = (Sort.list (fun a b -> a <= b) !keys) && (* and all min shoul came before all other *) min_before_other ) let correct_insert_del_min () = (* creates queue by inserting into empty one *) let que = insert_keys() in correct_delete que let choose_fastest f = let rec cf c res = let t = f() in if c > 0 then if t < res then cf (c - 1) t else cf (c - 1) res else res in cf !how_precise (f()) let speed_insert_del_min () = let test() = let before = Unix.gettimeofday() in let que = insert_keys() in if !num_of_delete <= !num_of_min + !num_of_other then let rec delete_from_q q count = if count > 0 then delete_from_q ( (function(_,_,x)-> x)(Prioqueue.delete_min q) ) (count - 1) else q in let _ = delete_from_q que !num_of_delete in Unix.gettimeofday() -. before else 0.0 in choose_fastest test let insert_key_list key_list = List.fold_left (* f *) (fun q h -> if h = !elem then Prioqueue.insert q h !elem else Prioqueue.insert q h !min) (* a *) (Prioqueue.empty();) (* l *) key_list let divide_keys size_of_first = let (keys1, keys2, _) = List.fold_left (* f *) (fun (k1, k2, c) h -> if c > 0 then (h::k1, k2, c - 1) else (k1, h::k2, c) ) (* a *) ([], [], size_of_first) (* l *) !keys in (keys1, keys2) let correct_union size_of_first = let (keys1, keys2) = divide_keys size_of_first in (* creates queue by inserting into empty one *) let que1 = insert_key_list keys1 and que2 = insert_key_list keys2 in let que = Prioqueue.union que1 que2 in correct_delete que let correct_union_all () = let rec check count correct= if count > 0 && correct then check (count - 1) (correct_union count) else if count = 0 then true else false in check (!num_of_min + !num_of_other) true let speed_union size_of_first = let test() = let (keys1, keys2) = divide_keys size_of_first in (* creates queue by inserting into empty one *) let que1 = insert_key_list keys1 and que2 = insert_key_list keys2 in let before = Unix.gettimeofday() in let _ = Prioqueue.union que1 que2 in Unix.gettimeofday() -. before in choose_fastest test let at_most c l = List.rev ( fst (List.fold_left (* f *) (fun (a, count) h -> if count > 0 then (h::a, count - 1) else (a, 0) ) (* a *) ([], c) (* l *) l ) ) let gen_keys_from perm = let multi = ref (!queue_input_size / !permutation_size) in List.fold_left (* f *) (fun a h -> let v = !multi * h in match !key_gen_method with Const -> a@(KeyGen.list_of_n_i !multi v) | Sequential b -> let key_l = KeyGen.list_i_to_j v (v + !multi) in if b then key_l else List.rev key_l | Random f -> let key_l = KeyGen.list_of_n_rand_from_i_to_j !multi v (v + !multi) in KeyGen.randomize f key_l ) (* a *) [] (* l *) perm exception Invalid_input_list let remove_doubled perm_time = let rec rd l a = match l, a with [], _ -> a | h::t, _ -> rd (List.filter (function x -> (fst x) != (fst h) ) t ) (h::a) in List.rev (rd perm_time []) let choose_best_permutations () = let measure_input_time_for perms = List.fold_left (* f *) (fun a h -> begin keys := gen_keys_from h; num_of_other := List.length h; num_of_min := 0; num_of_delete := !num_of_other; (h, speed_insert_del_min())::a; end;) (* a *) [] (* l *) perms and compare (p1, t1) (p2, t2) = if t1 > t2 then 1 else if t2 > t1 then -1 else 0 in (* take at_most how_precise elements from measured input times *) let shortest_input_del_perms = List.rev_map fst (at_most !how_precise (List.fast_sort compare (measure_input_time_for (KeyGen.permutations !permutation_size) ) ) ) in let multiplied_shortest = let rec multiply c l = if c = 0 then l else multiply (c - 1) (l@shortest_input_del_perms) in multiply !how_precise [] in remove_doubled (List.fast_sort compare (measure_input_time_for multiplied_shortest)) let statistics_of_best_permutations() = let best_perms = choose_best_permutations() in let first = snd (List.hd best_perms) in let (maximum, minimum) = List.fold_left (fun (max, min) h -> let t = snd h in if t > max then (t, min) else if t < min then (max, t) else (max, min) ) (first, first) best_perms and average_diff = let (_, summaric_differences, count) = List.fold_left (fun (last, diff_sum, c) h -> (snd h, diff_sum +. snd h -. last, c +. 1.)) (first, 0., 0.) best_perms in summaric_differences /. count in (best_perms, maximum, minimum, average_diff) end;; module PrioqueueTester = PrioqueueTesterFunctor(DefaultKeysGenerator);;