mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
use benchmark 1.4, with the upstreamed tree system
This commit is contained in:
Simon Cruanes
parent
f2890c56a6
commit
9e290d3ff6
2 changed files with 63 additions and 307 deletions
|
|
@ -1,252 +0,0 @@
|
|||
|
||||
(*
|
||||
copyright (c) 2013-2014, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
this software is provided by the copyright holders and contributors "as is" and
|
||||
any express or implied warranties, including, but not limited to, the implied
|
||||
warranties of merchantability and fitness for a particular purpose are
|
||||
disclaimed. in no event shall the copyright holder or contributors be liable
|
||||
for any direct, indirect, incidental, special, exemplary, or consequential
|
||||
damages (including, but not limited to, procurement of substitute goods or
|
||||
services; loss of use, data, or profits; or business interruption) however
|
||||
caused and on any theory of liability, whether in contract, strict liability,
|
||||
or tort (including negligence or otherwise) arising in any way out of the use
|
||||
of this software, even if advised of the possibility of such damage.
|
||||
*)
|
||||
|
||||
(** {1 helpers for benchmarks} *)
|
||||
|
||||
let print_line_ fmt () =
|
||||
Format.pp_print_string fmt (CCString.repeat "*" 80);
|
||||
Format.pp_print_newline fmt ()
|
||||
|
||||
let print_list_ ?(sep=", ") pp_item fmt l =
|
||||
let rec print fmt l = match l with
|
||||
| x::((_::_) as l) ->
|
||||
pp_item fmt x;
|
||||
Format.pp_print_string fmt sep;
|
||||
Format.pp_print_cut fmt ();
|
||||
print fmt l
|
||||
| x::[] -> pp_item fmt x
|
||||
| [] -> ()
|
||||
in
|
||||
print fmt l
|
||||
|
||||
(** {2 Bench Tree} *)
|
||||
|
||||
module SMap = Map.Make(String)
|
||||
|
||||
type single_bench = unit -> Benchmark.samples
|
||||
type bench =
|
||||
| Multiple of bench list * bench SMap.t
|
||||
| Bench of single_bench
|
||||
| WithInt of ((int -> bench) * int) list
|
||||
|
||||
let is_multiple = function
|
||||
| Multiple _ -> true
|
||||
| _ -> false
|
||||
|
||||
let rec merge_ t1 t2 = match t1, t2 with
|
||||
| Multiple (l, map), ((Bench _ | WithInt _) as x) ->
|
||||
Multiple (x :: l, map)
|
||||
| Multiple (l1, m1), Multiple (l2, m2) ->
|
||||
let m = SMap.merge
|
||||
(fun _ o1 o2 -> merge_opt_ o1 o2)
|
||||
m1 m2
|
||||
in
|
||||
Multiple (l1 @ l2, m)
|
||||
| (Bench _ | WithInt _), Multiple _ -> merge_ t2 t1
|
||||
| Bench _, _
|
||||
| WithInt _, _ ->
|
||||
Multiple ([t1; t2], SMap.empty) (* composite *)
|
||||
and merge_opt_ o1 o2 = match o1, o2 with
|
||||
| None, None -> None
|
||||
| Some o, None
|
||||
| None, Some o -> Some o
|
||||
| Some o1, Some o2 -> Some (merge_ o1 o2)
|
||||
|
||||
let mk_list = function
|
||||
| [] -> invalid_arg "mk_list"
|
||||
| x :: tail -> List.fold_left merge_ x tail
|
||||
|
||||
let raw f = Bench f
|
||||
|
||||
let throughput1 ?min_count ?style ?fwidth ?fdigits ?repeat time ?name f x =
|
||||
Bench (fun () ->
|
||||
Benchmark.throughput1 ?min_count ?style ?fwidth ?fdigits ?repeat time ?name f x)
|
||||
|
||||
let throughputN ?style ?fwidth ?fdigits ?repeat time f =
|
||||
Bench (fun () ->
|
||||
Benchmark.throughputN ?style ?fwidth ?fdigits ?repeat time f)
|
||||
|
||||
let (>::) n t =
|
||||
if n = "" then invalid_arg ">::";
|
||||
Multiple ([], SMap.singleton n t)
|
||||
|
||||
let (>:::) n l =
|
||||
if n = "" then invalid_arg ">:::";
|
||||
Multiple ([], SMap.singleton n (mk_list l))
|
||||
|
||||
let with_int f = function
|
||||
| [] -> invalid_arg "with_int: empty list"
|
||||
| l -> WithInt (List.map (fun n -> f, n) l)
|
||||
|
||||
let map_int l =
|
||||
if l = [] then invalid_arg "map_int";
|
||||
WithInt l
|
||||
|
||||
(* print the structure of the tree *)
|
||||
let rec print fmt = function
|
||||
| Multiple (l, m) ->
|
||||
Format.fprintf fmt "@[<hv>%a%a@]"
|
||||
print_map m
|
||||
(print_list_ ~sep:"," print) l
|
||||
| WithInt l ->
|
||||
Format.fprintf fmt "@[<hv>[%a]@]"
|
||||
(print_list_ print_pair)
|
||||
(List.map (fun (f, n) -> n, f n) l)
|
||||
| Bench _ -> Format.fprintf fmt "<>"
|
||||
and print_pair fmt (n,t) =
|
||||
Format.fprintf fmt "@[<h>%d: %a@]" n print t
|
||||
and print_map fmt m =
|
||||
let first = ref true in
|
||||
Format.pp_open_vbox fmt 0;
|
||||
SMap.iter (fun n t ->
|
||||
if !first then first := false else Format.pp_print_cut fmt ();
|
||||
Format.fprintf fmt "@[%s.%a@]" n print t) m;
|
||||
Format.pp_close_box fmt ()
|
||||
|
||||
(** {2 Path} *)
|
||||
|
||||
type path = string list
|
||||
|
||||
let print_path fmt path =
|
||||
Format.fprintf fmt "@[<h>%a@]"
|
||||
(print_list_ ~sep:"." Format.pp_print_string) path
|
||||
|
||||
let str_split_ ~by s =
|
||||
let len_by = String.length by in
|
||||
assert (len_by > 0);
|
||||
let l = ref [] in
|
||||
let n = String.length s in
|
||||
let rec search prev i =
|
||||
if i >= n
|
||||
then (
|
||||
if i>prev then l := String.sub s prev (n-prev) :: !l ;
|
||||
List.rev !l
|
||||
)
|
||||
else if is_prefix i 0
|
||||
then begin
|
||||
l := (String.sub s prev (i-prev)) :: !l; (* save substring *)
|
||||
search (i+len_by) (i+len_by)
|
||||
end
|
||||
else search prev (i+1)
|
||||
and is_prefix i j =
|
||||
if j = len_by
|
||||
then true
|
||||
else if i = n
|
||||
then false
|
||||
else s.[i] = by.[j] && is_prefix (i+1) (j+1)
|
||||
in search 0 0
|
||||
|
||||
let parse_path s = str_split_ ~by:"." s
|
||||
|
||||
let () =
|
||||
assert (parse_path "foo.bar" = ["foo";"bar"]);
|
||||
assert (parse_path "foo" = ["foo"]);
|
||||
assert (parse_path "" = []);
|
||||
()
|
||||
|
||||
let prefix path t = List.fold_right (fun s t -> s >:: t) path t
|
||||
|
||||
(** {2 Run} *)
|
||||
|
||||
(* run one atomic single_bench *)
|
||||
let run_single_bench_ fmt path f =
|
||||
print_line_ fmt ();
|
||||
Format.fprintf fmt "run bench %a@." print_path (List.rev path);
|
||||
let res = f () in
|
||||
Benchmark.tabulate res
|
||||
|
||||
(* run all benchs *)
|
||||
let rec run_all fmt path t = match t with
|
||||
| Bench f -> run_single_bench_ fmt path f
|
||||
| Multiple (l, m) ->
|
||||
List.iter (run_all fmt path) l;
|
||||
SMap.iter
|
||||
(fun n t' ->
|
||||
let path = n :: path in
|
||||
run_all fmt path t'
|
||||
) m
|
||||
| WithInt l ->
|
||||
List.iter (fun (f, n) -> run_all fmt (string_of_int n::path) (f n)) l
|
||||
|
||||
let run fmt t = run_all fmt [] t
|
||||
|
||||
let sprintf_ format =
|
||||
let b = Buffer.create 32 in
|
||||
let fmt = Format.formatter_of_buffer b in
|
||||
Format.kfprintf
|
||||
(fun fmt -> Format.pp_print_flush fmt (); Buffer.contents b) fmt format
|
||||
|
||||
(* run all within a path *)
|
||||
let rec run_path_rec_ fmt path remaining t = match t, remaining with
|
||||
| _, [] -> run_all fmt path t
|
||||
| Multiple (_, m), s :: remaining' ->
|
||||
begin try
|
||||
let t' = SMap.find s m in
|
||||
run_path_rec_ fmt (s::path) remaining' t'
|
||||
with Not_found ->
|
||||
let msg = sprintf_ "could not find %s under path %a"
|
||||
s print_path (List.rev path) in
|
||||
failwith msg
|
||||
end
|
||||
| WithInt l, _ ->
|
||||
List.iter (fun (f, n) -> run_path_rec_ fmt (string_of_int n::path) remaining (f n)) l
|
||||
| Bench _, _::_ -> ()
|
||||
|
||||
let run_path fmt t path = run_path_rec_ fmt [] path t
|
||||
|
||||
let run_main ?(argv=Sys.argv) ?(out=Format.std_formatter) t =
|
||||
let path = ref [] in
|
||||
let do_print_tree = ref false in
|
||||
let set_path_ s = path := parse_path s in
|
||||
let options =
|
||||
[ "-p", Arg.String set_path_, "only apply to subpath"
|
||||
; "-tree", Arg.Set do_print_tree, "print bench tree"
|
||||
] in
|
||||
try
|
||||
Arg.parse_argv argv options (fun _ -> ()) "run benchmarks [options]";
|
||||
if !do_print_tree
|
||||
then Format.fprintf out "@[%a@]@." print t
|
||||
else (
|
||||
Format.printf "run on path %a@." print_path !path;
|
||||
run_path out t !path (* regular path *)
|
||||
)
|
||||
with Arg.Help msg ->
|
||||
Format.pp_print_string out msg
|
||||
|
||||
(** {2 Global Registration} *)
|
||||
|
||||
let tree_ = ref (Multiple ([], SMap.empty))
|
||||
|
||||
let global_bench () = !tree_
|
||||
|
||||
let register ?(path=[]) new_t =
|
||||
tree_ := merge_ !tree_ (prefix path new_t)
|
||||
|
||||
let register' ~path new_t =
|
||||
register ~path:(parse_path path) new_t
|
||||
|
||||
let run_main ?argv ?out () =
|
||||
run_main ?argv ?out !tree_
|
||||
|
|
@ -1,5 +1,13 @@
|
|||
(** Generic benchs *)
|
||||
|
||||
module B = Benchmark
|
||||
let (@>) = B.Tree.(@>)
|
||||
let (@>>) = B.Tree.(@>>)
|
||||
let (@>>>) = B.Tree.(@>>>)
|
||||
|
||||
let app_int f n = string_of_int n @> lazy (f n)
|
||||
let app_ints f l = B.Tree.concat (List.map (app_int f) l)
|
||||
|
||||
(* composition *)
|
||||
let (%%) f g x = f (g x)
|
||||
|
||||
|
|
@ -17,7 +25,7 @@ module L = struct
|
|||
let l = lazy CCList.(1 -- n) in
|
||||
let flatten_map_ l = List.flatten (CCList.map f_ l)
|
||||
and flatten_ccmap_ l = List.flatten (List.map f_ l) in
|
||||
CCBench.throughputN time
|
||||
B.throughputN time
|
||||
[ "flat_map", CCList.flat_map f_ %% Lazy.force, l
|
||||
; "flatten o CCList.map", flatten_ccmap_ %% Lazy.force, l
|
||||
; "flatten o map", flatten_map_ %% Lazy.force, l
|
||||
|
|
@ -33,7 +41,7 @@ module L = struct
|
|||
let l2 = lazy CCList.(n+1 -- 2*n) in
|
||||
let l3 = lazy CCList.(2*n+1 -- 3*n) in
|
||||
let arg = l1, l2, l3 in
|
||||
CCBench.throughputN time
|
||||
B.throughputN time
|
||||
[ "CCList.append", append_ CCList.append, arg
|
||||
; "List.append", append_ List.append, arg
|
||||
]
|
||||
|
|
@ -51,7 +59,7 @@ module L = struct
|
|||
(fun i x -> CCList.(x -- (x+ min i 100)))
|
||||
CCList.(1 -- n))
|
||||
in
|
||||
CCBench.throughputN time
|
||||
B.throughputN time
|
||||
[ "CCList.flatten", CCList.flatten %% Lazy.force, l
|
||||
; "List.flatten", List.flatten %% Lazy.force, l
|
||||
; "fold_right append", fold_right_append_ %% Lazy.force, l
|
||||
|
|
@ -60,23 +68,23 @@ module L = struct
|
|||
|
||||
(* MAIN *)
|
||||
|
||||
let () = CCBench.register CCBench.(
|
||||
"list" >:::
|
||||
[ "flat_map" >::
|
||||
map_int
|
||||
[ bench_flat_map ~time:2, 100
|
||||
; bench_flat_map ~time:2, 10_000
|
||||
; bench_flat_map ~time:4, 100_000]
|
||||
; "flatten" >::
|
||||
map_int
|
||||
[ bench_flatten ~time:2, 100
|
||||
; bench_flatten ~time:2, 10_000
|
||||
; bench_flatten ~time:4, 100_000]
|
||||
; "append" >::
|
||||
map_int
|
||||
[ bench_append ~time:2, 100
|
||||
; bench_append ~time:2, 10_000
|
||||
; bench_append ~time:4, 100_000]
|
||||
let () = B.Tree.register (
|
||||
"list" @>>>
|
||||
[ "flat_map" @>>
|
||||
B.Tree.concat
|
||||
[ app_int (bench_flat_map ~time:2) 100
|
||||
; app_int (bench_flat_map ~time:2) 10_000
|
||||
; app_int (bench_flat_map ~time:4) 100_000]
|
||||
; "flatten" @>>
|
||||
B.Tree.concat
|
||||
[ app_int (bench_flatten ~time:2) 100
|
||||
; app_int (bench_flatten ~time:2) 10_000
|
||||
; app_int (bench_flatten ~time:4) 100_000]
|
||||
; "append" @>>
|
||||
B.Tree.concat
|
||||
[ app_int (bench_append ~time:2) 100
|
||||
; app_int (bench_append ~time:2) 10_000
|
||||
; app_int (bench_append ~time:4) 100_000]
|
||||
]
|
||||
)
|
||||
end
|
||||
|
|
@ -96,7 +104,7 @@ module Vec = struct
|
|||
|
||||
let bench_map n =
|
||||
let v = lazy (CCVector.init n (fun x->x)) in
|
||||
CCBench.throughputN 2
|
||||
B.throughputN 2
|
||||
[ "map", CCVector.map f %% Lazy.force, v
|
||||
; "map_push", map_push_ f %% Lazy.force, v
|
||||
; "map_push_cap", map_push_size_ f %% Lazy.force, v
|
||||
|
|
@ -113,15 +121,15 @@ module Vec = struct
|
|||
|
||||
let bench_append n =
|
||||
let v2 = lazy (CCVector.init n (fun x->n+x)) in
|
||||
CCBench.throughputN 2
|
||||
B.throughputN 2
|
||||
[ "append", try_append_ CCVector.append n v2, ()
|
||||
; "append_naive", try_append_ append_naive_ n v2, ()
|
||||
]
|
||||
|
||||
let () = CCBench.register CCBench.(
|
||||
"vector" >:::
|
||||
[ "map" >:: with_int bench_map [100; 10_000; 100_000]
|
||||
; "append" >:: with_int bench_append [100; 10_000; 50_000]
|
||||
let () = B.Tree.register (
|
||||
"vector" @>>>
|
||||
[ "map" @>> app_ints bench_map [100; 10_000; 100_000]
|
||||
; "append" @>> app_ints bench_append [100; 10_000; 50_000]
|
||||
]
|
||||
)
|
||||
end
|
||||
|
|
@ -158,11 +166,11 @@ module Cache = struct
|
|||
] @ l
|
||||
else l
|
||||
in
|
||||
CCBench.throughputN 3 l
|
||||
B.throughputN 3 l
|
||||
|
||||
let () = CCBench.register CCBench.(
|
||||
"cache" >:::
|
||||
[ "fib" >:: with_int bench_fib [10; 20; 100; 200; 1_000;]
|
||||
let () = B.Tree.register (
|
||||
"cache" @>>>
|
||||
[ "fib" @>> app_ints bench_fib [10; 20; 100; 200; 1_000;]
|
||||
]
|
||||
)
|
||||
end
|
||||
|
|
@ -267,7 +275,7 @@ module Tbl = struct
|
|||
h
|
||||
|
||||
let bench_maps1 n =
|
||||
CCBench.throughputN 3
|
||||
B.throughputN 3
|
||||
["phashtbl_add", (fun n -> ignore (phashtbl_add n)), n;
|
||||
"hashtbl_add", (fun n -> ignore (hashtbl_add n)), n;
|
||||
"ihashtbl_add", (fun n -> ignore (ihashtbl_add n)), n;
|
||||
|
|
@ -370,7 +378,7 @@ module Tbl = struct
|
|||
h
|
||||
|
||||
let bench_maps2 n =
|
||||
CCBench.throughputN 3
|
||||
B.throughputN 3
|
||||
["phashtbl_replace", (fun n -> ignore (phashtbl_replace n)), n;
|
||||
"hashtbl_replace", (fun n -> ignore (hashtbl_replace n)), n;
|
||||
"ihashtbl_replace", (fun n -> ignore (ihashtbl_replace n)), n;
|
||||
|
|
@ -455,7 +463,7 @@ module Tbl = struct
|
|||
let a = Array.init n (fun i -> string_of_int i) in
|
||||
let m = imap_add n in
|
||||
let h'''''' = icchashtbl_add n in
|
||||
CCBench.throughputN 3 [
|
||||
B.throughputN 3 [
|
||||
"phashtbl_find", (fun () -> phashtbl_find h n), ();
|
||||
"hashtbl_find", (fun () -> hashtbl_find h' n), ();
|
||||
"ihashtbl_find", (fun () -> ihashtbl_find h'' n), ();
|
||||
|
|
@ -468,11 +476,11 @@ module Tbl = struct
|
|||
"cchashtbl_find", (fun () -> icchashtbl_find h'''''' n), ();
|
||||
]
|
||||
|
||||
let () = CCBench.register CCBench.(
|
||||
"tbl" >:::
|
||||
[ "add" >:: with_int bench_maps1 [10; 100; 1_000; 10_000;]
|
||||
; "replace" >:: with_int bench_maps2 [10; 100; 1_000; 10_000]
|
||||
; "find" >:: with_int bench_maps3 [10; 20; 100; 1_000; 10_000]
|
||||
let () = B.Tree.register (
|
||||
"tbl" @>>>
|
||||
[ "add" @>> app_ints bench_maps1 [10; 100; 1_000; 10_000;]
|
||||
; "replace" @>> app_ints bench_maps2 [10; 100; 1_000; 10_000]
|
||||
; "find" @>> app_ints bench_maps3 [10; 20; 100; 1_000; 10_000]
|
||||
])
|
||||
end
|
||||
|
||||
|
|
@ -483,7 +491,7 @@ module Iter = struct
|
|||
let seq () = Sequence.fold (+) 0 Sequence.(0 --n) in
|
||||
let gen () = Gen.fold (+) 0 Gen.(0 -- n) in
|
||||
let klist () = CCKList.fold (+) 0 CCKList.(0 -- n) in
|
||||
CCBench.throughputN 3
|
||||
B.throughputN 3
|
||||
[ "sequence.fold", seq, ();
|
||||
"gen.fold", gen, ();
|
||||
"klist.fold", klist, ();
|
||||
|
|
@ -500,7 +508,7 @@ module Iter = struct
|
|||
0 -- n |> flat_map (fun x -> x-- (x+10)) |> fold (+) 0
|
||||
)
|
||||
in
|
||||
CCBench.throughputN 3
|
||||
B.throughputN 3
|
||||
[ "sequence.flat_map", seq, ();
|
||||
"gen.flat_map", gen, ();
|
||||
"klist.flat_map", klist, ();
|
||||
|
|
@ -523,17 +531,17 @@ module Iter = struct
|
|||
1 -- n |> iter (fun x -> i := !i * x)
|
||||
)
|
||||
in
|
||||
CCBench.throughputN 3
|
||||
B.throughputN 3
|
||||
[ "sequence.iter", seq, ();
|
||||
"gen.iter", gen, ();
|
||||
"klist.iter", klist, ();
|
||||
]
|
||||
|
||||
let () = CCBench.register CCBench.(
|
||||
"iter" >:::
|
||||
[ "fold" >:: with_int bench_fold [100; 1_000; 10_000; 1_000_000]
|
||||
; "flat_map" >:: with_int bench_flat_map [1_000; 10_000]
|
||||
; "iter" >:: with_int bench_iter [1_000; 10_000]
|
||||
let () = B.Tree.register (
|
||||
"iter" @>>>
|
||||
[ "fold" @>> app_ints bench_fold [100; 1_000; 10_000; 1_000_000]
|
||||
; "flat_map" @>> app_ints bench_flat_map [1_000; 10_000]
|
||||
; "iter" @>> app_ints bench_iter [1_000; 10_000]
|
||||
])
|
||||
end
|
||||
|
||||
|
|
@ -586,16 +594,16 @@ module Batch = struct
|
|||
CCPrint.printf "batch: %a\n" (CCArray.pp CCInt.pp) (batch a);
|
||||
*)
|
||||
assert (C.equal (batch a) (naive a));
|
||||
CCBench.throughputN time
|
||||
B.throughputN time
|
||||
[ C.name ^ "_naive", naive, a
|
||||
; C.name ^ "_batch", batch, a
|
||||
]
|
||||
|
||||
let bench = CCBench.(
|
||||
C.name >:: map_int
|
||||
[ bench_for ~time:1, 100
|
||||
; bench_for ~time:4, 100_000
|
||||
; bench_for ~time:4, 1_000_000
|
||||
let bench = B.(
|
||||
C.name @>> B.Tree.concat
|
||||
[ app_int (bench_for ~time:1) 100
|
||||
; app_int (bench_for ~time:4) 100_000
|
||||
; app_int (bench_for ~time:4) 1_000_000
|
||||
])
|
||||
end
|
||||
|
||||
|
|
@ -622,8 +630,8 @@ module Batch = struct
|
|||
let doubleton x y = CCKList.of_list [ x; y ]
|
||||
end)
|
||||
|
||||
let () = CCBench.register CCBench.(
|
||||
"batch" >:: mk_list
|
||||
let () = B.Tree.register (
|
||||
"batch" @>> B.Tree.concat
|
||||
[ BenchKList.bench
|
||||
; BenchArray.bench
|
||||
; BenchList.bench
|
||||
|
|
@ -631,4 +639,4 @@ module Batch = struct
|
|||
end
|
||||
|
||||
let () =
|
||||
CCBench.run_main ()
|
||||
B.Tree.run_global ()
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue