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);;