Source file display.ml

open Core
open Poly
module R = Analysis_result.Regression
module C = Analysis_result.Coefficient
module Magnitude = Display_units.Magnitude

module Warnings = struct
  let long_running_benchmark_time_limit_nanos = 1E8
  let has_long_running_benchmarks = ref false

  let check_for_long_running_benchmarks ~(resp : Variable.t) ~(pred : Variable.t) est =
    match resp, pred with
    | `Nanos, `Runs ->
      if est >= long_running_benchmark_time_limit_nanos
      then has_long_running_benchmarks := true
    | _, _ -> ()
  ;;

  let display () =
    if !has_long_running_benchmarks
    then
      printf
        "Benchmarks that take 1ns to %s can be estimated precisely. For more reliable \n\
         estimates, redesign your benchmark to have a shorter execution time.\n\
         %!"
        (Time_float.Span.to_string
           (Time_float.Span.of_ns long_running_benchmark_time_limit_nanos))
  ;;
end

module Regr = struct
  module Coeff = struct
    type t =
      { predictor : Variable.t
      ; mutable units : Display_units.t
      ; mutable magnitude : Magnitude.t
      ; mutable has_ci : bool
      ; mutable smallest : float option
      ; mutable largest : float option
      }

    let create units predictor =
      { predictor
      ; units
      ; has_ci = false
      ; smallest = None
      ; largest = None
      ; magnitude = Magnitude.max
      }
    ;;

    let update t coeff =
      let select cmp n n_opt =
        match n, n_opt with
        | n, None -> Some n
        | n, Some m -> Some (cmp n m)
      in
      t.has_ci <- t.has_ci || C.has_ci95 coeff;
      let est = C.estimate coeff in
      t.smallest <- select min est t.smallest;
      t.largest <- select max est t.largest;
      t.magnitude <- Magnitude.smaller t.magnitude (Magnitude.magnitude t.units est)
    ;;
  end

  type t =
    { responder : Variable.t
    ; coeffs : Coeff.t array
    ; key : int
    ; regression_name : string option
    ; mutable has_r_square : bool
    }

  let create regr =
    let responder = R.responder regr in
    let units = Variable.get_units responder in
    { responder
    ; coeffs = Array.map (R.predictors regr) ~f:(Coeff.create units)
    ; key = R.key regr
    ; regression_name = R.regression_name regr
    ; has_r_square = false
    }
  ;;

  let update t ~regr =
    t.has_r_square <- t.has_r_square || R.has_r_square regr;
    Array.iteri (R.coefficients regr) ~f:(fun i coeff -> Coeff.update t.coeffs.(i) coeff)
  ;;

  let create_col t str ~f =
    Ascii_table_kernel.Column.create_attr ~align:Right ~show:`If_not_empty str (fun res ->
      match Analysis_result.find_key res t.key with
      | None -> [], "?"
      | Some regr -> f regr)
  ;;

  let make_columns ~show_absolute_ci ~show_all_values ~show_overheads t =
    let append_name ~est col =
      match t.regression_name, est && Array.length t.coeffs = 1 with
      | Some name, true -> name
      | Some name, false -> col ^ name
      | None, _ -> col
    in
    let unit = Variable.get_units t.responder in
    let name = Variable.to_short_string t.responder in
    let cols = [] in
    let cols =
      (* Display R^2 is required *)
      if t.has_r_square
      then (
        let r_square =
          create_col
            t
            (append_name (name ^ " R^2") ~est:false)
            ~f:(fun regr ->
              let non_triv =
                Array.fold ~init:false (R.coefficients regr) ~f:(fun acc coeff ->
                  acc
                  || C.has_non_trivial_estimate
                       coeff
                       ~show_all_values:false
                       ~responder:t.responder)
              in
              if non_triv
              then [], To_string.float_opt_to_string (R.r_square regr)
              else if show_all_values
              then [ `Dim ], To_string.float_opt_to_string (R.r_square regr)
              else [], "")
        in
        r_square :: cols)
      else cols
    in
    List.rev
      (Array.foldi t.coeffs ~init:cols ~f:(fun i acc coeff ->
         if coeff.Coeff.predictor = `One && not show_overheads
         then acc
         else (
           let mag = coeff.Coeff.magnitude in
           (* Display Estimates *)
           let est_col =
             create_col
               t
               (append_name
                  (Variable.make_col_name t.responder coeff.Coeff.predictor)
                  ~est:false)
               ~f:(fun regr ->
                 let est = (R.coefficients regr).(i) in
                 Warnings.check_for_long_running_benchmarks
                   ~resp:t.responder
                   ~pred:coeff.Coeff.predictor
                   (C.estimate est);
                 Display_units.to_string ~show_all_values unit mag (C.estimate est))
           in
           (* Display confidence intervals *)
           if coeff.Coeff.has_ci
           then (
             let est_ci_col =
               create_col t (append_name "95ci" ~est:false) ~f:(fun regr ->
                 let est = (R.coefficients regr).(i) in
                 match C.ci95 est with
                 | None -> [], ""
                 | Some ci ->
                   (* Suppress the ci if the estimate has been suppressed. *)
                   let non_triv =
                     C.has_non_trivial_estimate
                       est
                       ~show_all_values:false
                       ~responder:t.responder
                   in
                   if non_triv || show_all_values
                   then (
                     let attr, str =
                       if show_absolute_ci
                       then
                         Display_units.to_ci_string
                           ~show_all_values
                           unit
                           mag
                           (Analysis_result.Ci95.ci95_abs_err
                              ci
                              ~estimate:(C.estimate est))
                       else
                         Display_units.to_ci_string
                           ~show_all_values
                           Display_units.Percentage
                           mag
                           (Analysis_result.Ci95.ci95_rel_err
                              ci
                              ~estimate:(C.estimate est))
                     in
                     let attr = if show_all_values then `Dim :: attr else attr in
                     attr, str)
                   else [], "")
             in
             est_ci_col :: est_col :: acc)
           else est_col :: acc)))
  ;;
end

let make_speed_and_percentage_columns (display_config : Display_config.Table.t) tbl =
  let show_percentage = display_config.show_percentage in
  let show_speedup = display_config.show_speedup in
  let show_all_values = Display_config.Table.show_all_values display_config in
  if show_percentage || show_speedup
  then (
    (* To computer speedup and percentage, we need the Nanos-vs-Rubs regression as to be
       present in the results. *)
    let timing_key = Analysis_config.make_key Analysis_config.nanos_vs_runs in
    match Hashtbl.find tbl timing_key with
    | None ->
      printf "Error: Estimating speedup/percentage requires Nanos-vs-Runs analysis.\n%!";
      []
    | Some regr ->
      let smallest =
        Option.value_exn
          regr.Regr.coeffs.(0).Regr.Coeff.smallest
          ~message:"Reading smallest Nanos-vs-Runs value"
      in
      let largest =
        Option.value_exn
          regr.Regr.coeffs.(0).Regr.Coeff.largest
          ~message:"Reading largest Nanos-vs-Runs value"
      in
      let get_coeff regr = C.estimate (R.coefficients regr).(0) in
      let cols = [] in
      let cols =
        if show_speedup
        then (
          let col =
            Ascii_table_kernel.Column.create ~align:Right "Speedup" (fun res ->
              match Analysis_result.find_key res timing_key with
              | None -> "?"
              | Some regr -> To_string.float_to_string (get_coeff regr /. smallest))
          in
          col :: cols)
        else cols
      in
      let cols =
        if show_percentage
        then (
          let col =
            Ascii_table_kernel.Column.create_attr ~align:Right "Percentage" (fun res ->
              match Analysis_result.find_key res timing_key with
              | None -> [], "?"
              | Some regr ->
                let dummy = Display_units.Magnitude.One in
                Display_units.to_string
                  ~show_all_values
                  Display_units.Percentage
                  dummy
                  (get_coeff regr /. largest))
          in
          col :: cols)
        else cols
      in
      cols)
  else []
;;

let make_columns_for_regressions (display_config : Display_config.Table.t) results =
  let tbl = Int.Table.create () in
  let add_to_table regr =
    Regr.update
      ~regr
      (Hashtbl.find_or_add tbl (R.key regr) ~default:(fun () -> Regr.create regr))
  in
  List.iter results ~f:(fun result ->
    Array.iter (Analysis_result.regressions result) ~f:(fun regr -> add_to_table regr));
  let regressions =
    List.sort (Hashtbl.to_alist tbl) ~compare:(fun (a, _) (b, _) -> compare a b)
  in
  let show_absolute_ci = display_config.show_absolute_ci in
  let show_all_values = Display_config.Table.show_all_values display_config in
  let show_overheads = display_config.show_overheads in
  let cols =
    List.fold ~init:[] regressions ~f:(fun acc (_key, data) ->
      acc @ Regr.make_columns ~show_absolute_ci ~show_all_values ~show_overheads data)
  in
  cols @ make_speed_and_percentage_columns display_config tbl
;;

let make_columns (display_config : Display_config.Table.t) results =
  let cols = make_columns_for_regressions display_config results in
  let cols =
    if display_config.show_samples
    then (
      let samples =
        Ascii_table_kernel.Column.create ~align:Right "Runs @ Samples" (fun res ->
          sprintf
            "%d @ %d"
            (Analysis_result.largest_run res)
            (Analysis_result.sample_count res))
      in
      samples :: cols)
    else cols
  in
  let cols =
    let name =
      Ascii_table_kernel.Column.create
        ~max_width:display_config.max_name_length
        ~align:Left
        "Name"
        (fun res -> Analysis_result.name res)
    in
    name :: cols
  in
  cols
;;

let make_csv_columns display_config results =
  make_columns display_config results
  |> List.map ~f:(fun col ->
       Delimited_kernel.Write.column
         ~header:(Ascii_table_kernel.Column.header col)
         (fun result ->
         Ascii_table_kernel.Column.to_data col result
         |> List.map ~f:(fun (_cli_attributes, table_entry) -> table_entry)
         |> String.concat ~sep:" "))
  |> Delimited_kernel.Write.of_list
;;