diff --git a/benchmarks/compare.ml b/benchmarks/compare.ml new file mode 100644 index 0000000..2551d09 --- /dev/null +++ b/benchmarks/compare.ml @@ -0,0 +1,182 @@ +open Core + +module Both = struct + type 'a t = + { lhs : 'a + ; rhs : 'a + } +end + +module Value = struct + type t = + | Int of int + | Float of float + + let of_string s = + try Int (Int.of_string s) with + | _ -> Float (Float.of_string s) + ;; + + let rec percent_delta x y = + match x, y with + | Int x, Int y -> + let delta = y - x in + let open Float in + Float (100. * Float.of_int delta / Float.of_int x) + | Float x, Float y -> Float Float.(100. * (y - x) / x) + | Float x, Int y -> percent_delta (Float x) (Float (Float.of_int y)) + | Int x, Float y -> percent_delta (Float (Float.of_int x)) (Float y) + ;; + + let to_csv t = + match t with + | Float f -> Float.to_string_hum f + | Int x -> Int.to_string_hum x + ;; + + let compare x y = + match x, y with + | Float x, Float y -> Float.compare x y + | Int x, Int y -> Int.compare x y + | _, _ -> assert false + ;; +end + +type 'a bench = + { name : string + ; time_per_run_nanos : 'a + ; major_words_per_run : 'a + ; promoted_words_per_run : 'a + ; minor_words_per_run : 'a + } + +let of_sexp (sexp : Sexp.t) = + match sexp with + | Atom _ -> failwith "expected list" + | List fields -> + let kv (sexp : Sexp.t) = + match sexp with + | List [ Atom k; Atom v ] -> Some (k, v) + | _ -> None + in + let fields = List.filter_map fields ~f:kv in + let field name = + List.find_map_exn fields ~f:(fun (k, v) -> + if String.equal k name then Some v else None) + in + let name = field "full_benchmark_name" in + let time_per_run_nanos = Value.of_string (field "time_per_run_nanos") in + let major_words_per_run = Value.of_string (field "major_words_per_run") in + let promoted_words_per_run = Value.of_string (field "promoted_words_per_run") in + let minor_words_per_run = Value.of_string (field "minor_words_per_run") in + { name + ; time_per_run_nanos + ; major_words_per_run + ; promoted_words_per_run + ; minor_words_per_run + } +;; + +let parse_all s = + match Sexp.of_string s with + | Atom _ -> failwith "list expected" + | List benches -> + List.map benches ~f:of_sexp + |> String.Map.of_list_with_key_exn ~get_key:(fun v -> v.name) +;; + +let merge_one + { name + ; time_per_run_nanos + ; major_words_per_run + ; promoted_words_per_run + ; minor_words_per_run + } + b + = + assert (String.equal name b.name); + { b with + time_per_run_nanos = { Both.lhs = time_per_run_nanos; rhs = b.time_per_run_nanos } + ; major_words_per_run = { Both.lhs = major_words_per_run; rhs = b.major_words_per_run } + ; promoted_words_per_run = + { Both.lhs = promoted_words_per_run; rhs = b.promoted_words_per_run } + ; minor_words_per_run = { Both.lhs = minor_words_per_run; rhs = b.minor_words_per_run } + } +;; + +let merge lhs rhs = + Map.merge lhs rhs ~f:(fun ~key:_ v -> + match v with + | `Left _ -> None + | `Right _ -> None + | `Both (lhs, rhs) -> Some (merge_one lhs rhs)) +;; + +let run ~prev ~next = + let report = + let prev = Stdio.In_channel.read_all prev |> parse_all in + let next = Stdio.In_channel.read_all next |> parse_all in + merge prev next + in + let records = + let headers = + [ "name" + ; "time_per_run_nanos" + ; "delta (%)" + ; "major_words_per_run" + ; "delta (%)" + ; "promoted_words_per_run" + ; "delta (%)" + ; "minor_words_per_run" + ; "delta (%)" + ] + in + let values = + Map.to_alist report + |> List.map ~f:snd + |> List.map + ~f: + (fun + ({ name + ; time_per_run_nanos + ; major_words_per_run + ; promoted_words_per_run + ; minor_words_per_run + } : + Value.t Both.t bench) + -> + let time_delta = + Value.percent_delta time_per_run_nanos.lhs time_per_run_nanos.rhs + in + let make_delta { Both.lhs; rhs } = + let delta = Value.percent_delta lhs rhs in + [ Value.to_csv lhs; Value.to_csv delta ] + in + ( time_delta + , name + :: List.concat + [ make_delta time_per_run_nanos + ; make_delta major_words_per_run + ; make_delta promoted_words_per_run + ; make_delta minor_words_per_run + ] )) + |> List.sort ~compare:(fun (x, _) (y, _) -> Value.compare x y) + |> List.map ~f:snd + in + headers :: values + in + let chan = Csv.to_channel Stdio.stdout in + Csv.output_all chan records +;; + +let command = + let open Command.Param in + let open Command.Param.Applicative_infix in + Command.basic + ~summary:"compare two runs" + (let prev = flag "prev" (required string) ~doc:"sexp file" in + let next = flag "next" (required string) ~doc:"sexp file" in + Command.Param.return (fun prev next () -> run ~prev ~next) <*> prev <*> next) +;; + +let () = Command_unix.run command diff --git a/benchmarks/dune b/benchmarks/dune index 50d43fe..5af1cef 100644 --- a/benchmarks/dune +++ b/benchmarks/dune @@ -13,4 +13,19 @@ core_bench core_unix.command_unix memtrace) + (modules :standard \ compare) (names benchmark)) + +(executable + (name compare) + (modules compare) + (libraries + core + csv + base + core_unix + core_unix.command_unix + core_unix.filename_unix + spawn + stdio + sexplib)) diff --git a/flake.nix b/flake.nix index 8e4de83..5b4d475 100644 --- a/flake.nix +++ b/flake.nix @@ -23,6 +23,8 @@ with pkgs.ocamlPackages; [ ocaml-lsp pkgs.ocamlformat_0_26_2 + csv + pkgs.tabview ]; makePackages = pkgs: rec { default = re;