R/benchmark-dataframe.R

In ursa-labs/arrowbench: Tools for Continuous and Interactive Benchmarking

#' A classed dataframe of benchmarks for running
#'
#' @param benchmarks A list with elements of class `Benchmark`
#' @param parameters Optional. A list of dataframes of parameter combinations to
#' run as generated by [get_default_parameters()]. If null, defaults will be generated
#' when [run()] is called.
#'
#' @return A classed dataframe with `name` (benchmark attribute, not object name),
#' `benchmark`, and `params` columns
#'
#' @export
BenchmarkDataFrame <- function(benchmarks, parameters) {
  lapply(benchmarks, function(bm) stopifnot(
    "All elements of `benchmarks` are not of class `Benchmark`!" = inherits(bm, "Benchmark")
  ))

  bm_names <- vapply(benchmarks, function(bm) bm$name, character(1))
  if (missing(parameters)) {
    parameters <- rep(list(NULL), length = length(benchmarks))
  }

  structure(
    tibble::tibble(
      name = bm_names,
      benchmark = benchmarks,
      parameters = parameters
    ),
    class = c("BenchmarkDataFrame", "tbl_df", "tbl", "data.frame")
  )
}


#' @export
format.BenchmarkDataFrame <- function(x, ...) {
  c("# <BenchmarkDataFrame>", NextMethod())
}


#' Get a list of benchmarks in a package
#'
#' @param package String of package name in which to find benchmarks
#'
#' @return An instance of [BenchmarkDataFrame] with all the benchmarks contained
#' by a package
#'
#' @export
get_package_benchmarks <- function(package = "arrowbench") {
  nms <- getNamespaceExports(package)
  objs <- mget(nms, envir = getNamespace(package))
  bms <- Filter(function(x) inherits(x, "Benchmark"), objs)
  BenchmarkDataFrame(benchmarks = bms)
}