Comparison of comparisons, ^^

comp.ml

open Core_bench

module type S = sig
  type t
  val n : int
  val poly : t -> t -> int
  val quad : t -> t -> int
  val discr : t -> t -> int
  val test_values : (string * t * t) list
end

let make_test (module T : S) =
  let aux (name, t, t') =
    Bench.Test.create_group ~name [
    Bench.Test.create ~name:"poly" (fun () -> ignore (T.poly t t'));
    Bench.Test.create ~name:"quad" (fun () -> ignore (T.quad t t'));
    Bench.Test.create ~name:"discr" (fun () -> ignore (T.discr t t'));
  ] in
  Bench.Test.create_group
    ~name:(Format.asprintf "%d" T.n)
    (List.map aux T.test_values)


(* ### N = 2 ### *)
(* ############# *)
module T2 = struct

  type t =
    | C1
    | C2

  let n = 2

  let test_values = [
    "same", C1, C1;
    "cross", C2, C1;
  ]

  let poly = Stdlib.compare

  let quad t t' =
    match t, t' with
    | C1, C1 -> 0
    | C1, C2 -> -1
    | C2, C1 -> 1
    | C2, C2 -> 0

  let _discr = function
    | C1 -> 1
    | C2 -> 2

  let discr t t' =
    match t, t' with
    | C1, C1 -> 0
    | C2, C2 -> 0
    | _ -> _discr t - _discr t'

end

(* ### N = 3 ### *)
(* ############# *)
module T3 = struct

  type t =
    | C1
    | C2
    | C3

  let n = 3

  let test_values = [
    "same", C1, C1;
    "cross", C3, C1;
  ]

  let poly = Stdlib.compare

  let quad t t' =
    match t, t' with
    | C1, C1 -> 0
    | C1, C2 -> -1
    | C1, C3 -> -1
    | C2, C1 -> 1
    | C2, C2 -> 0
    | C2, C3 -> -1
    | C3, C1 -> 1
    | C3, C2 -> 1
    | C3, C3 -> 0

  let _discr = function
    | C1 -> 1
    | C2 -> 2
    | C3 -> 3

  let discr t t' =
    match t, t' with
    | C1, C1 -> 0
    | C2, C2 -> 0
    | C3, C3 -> 0
    | _ -> _discr t - _discr t'

end

(* ### N = 5 ### *)
(* ############# *)
module T5 = struct

  type t =
    | C1
    | C2
    | C3
    | C4
    | C5

  let n = 5

  let test_values = [
    "same", C1, C1;
    "cross", C3, C1;
  ]

  let poly = Stdlib.compare

  let quad t t' =
    match t, t' with
    | C1, C1 -> 0
    | C1, C2 -> -1
    | C1, C3 -> -1
    | C1, C4 -> -1
    | C1, C5 -> -1

    | C2, C1 -> 1
    | C2, C2 -> 0
    | C2, C3 -> -1
    | C2, C4 -> -1
    | C2, C5 -> -1

    | C3, C1 -> 1
    | C3, C2 -> 1
    | C3, C3 -> 0
    | C3, C4 -> -1
    | C3, C5 -> -1

    | C4, C1 -> 1
    | C4, C2 -> 1
    | C4, C3 -> 1
    | C4, C4 -> 0
    | C4, C5 -> -1

    | C5, C1 -> 1
    | C5, C2 -> 1
    | C5, C3 -> 1
    | C5, C4 -> 1
    | C5, C5 -> 0

  let _discr = function
    | C1 -> 1
    | C2 -> 2
    | C3 -> 3
    | C4 -> 4
    | C5 -> 5

  let discr t t' =
    match t, t' with
    | C1, C1 -> 0
    | C2, C2 -> 0
    | C3, C3 -> 0
    | C4, C4 -> 0
    | _ -> _discr t - _discr t'

end

(* Main function run *)
let () =
  Core.Command.run (Bench.make_command (
      make_test (module T2 : S) ::
      make_test (module T3 : S) ::
      make_test (module T5 : S) ::
      []
    ))

comp.res

Estimated testing time 3m (18 benchmarks x 10s). Change using '-quota'.
                                         
  Name            Time/Run   Percentage  
 --------------- ---------- ------------ 
  2/same/poly      11.79ns       90.82%  
  2/same/quad       5.53ns       42.59%  
  2/same/discr      5.08ns       39.10%  
  2/cross/poly     12.98ns      100.00%  
  2/cross/quad      5.40ns       41.57%  
  2/cross/discr     5.94ns       45.79%  
  3/same/poly      11.88ns       91.56%  
  3/same/quad       5.71ns       44.01%  
  3/same/discr      4.84ns       37.28%  
  3/cross/poly     12.26ns       94.45%  
  3/cross/quad      5.74ns       44.22%  
  3/cross/discr     5.53ns       42.58%  
  5/same/poly      12.27ns       94.53%  
  5/same/quad       6.11ns       47.09%  
  5/same/discr      5.18ns       39.87%  
  5/cross/poly     12.78ns       98.45%  
  5/cross/quad      6.69ns       51.52%  
  5/cross/discr     6.46ns       49.80%