R/main_benchmark.R

In prcbench: Testing Workbench for Precision-Recall Curves

#' Run microbenchmark with specified tools and test sets
#'
#' The \code{run_benchmark} function runs
#'     \code{\link[microbenchmark]{microbenchmark}} for specified tools
#'     and test datasets
#'
#' @param testset A character vector to specify a test set generated by
#'   \code{\link{create_testset}}.
#'
#' @param toolset A character vector to specify a tool set generated by
#'   \code{\link{create_toolset}}.
#'
#' @param times The number of iteration used in
#'     \code{\link[microbenchmark]{microbenchmark}}.
#'
#' @param unit A single string to specify the unit used in
#'     \code{\link[microbenchmark]{summary.microbenchmark}}.
#'
#' @param use_sys_time A Boolean value to specify
#'     \code{\link[base]{system.time}} is used instead of
#'     \code{\link[microbenchmark]{summary.microbenchmark}}.
#'
#' @return A data frame of microbenchmark results with additional columns.
#'
#' @seealso \code{\link{create_testset}} to generate a test dataset.
#'    \code{\link{create_toolset}} to generate a tool set.
#'    \code{\link[microbenchmark]{microbenchmark}} for benchmarking
#'    details.
#'
#' @examples
#' \dontrun{
#' ## Benchmarking for b10 and i10 test sets and crv5, auc5, and def5 tool sets
#' testset <- create_testset("bench", c("b10", "i10"))
#' toolset <- create_toolset(set_names = "def5")
#' res1 <- run_benchmark(testset, toolset)
#' res1
#' }
#'
#' @export
run_benchmark <- function(testset, toolset, times = 5, unit = "ms",
                          use_sys_time = FALSE) {
  if (!use_sys_time && !requireNamespace("microbenchmark", quietly = TRUE)) {
    print("microbenchmark is not available. system.time will be used instead.")
    use_sys_time <- TRUE
  }

  # Validate arguments
  new_args <- .validate_run_benchmark_args(testset, toolset, times, unit)

  # Prepare tool sets and test data sets
  new_testset <- rep(new_args$testset, length(new_args$toolset))
  new_toolset <- rep(new_args$toolset, each = length(new_args$testset))

  # Call microbenchmark
  bmfunc <- function(i) {
    tool <- new_toolset[[i]]
    tset <- new_testset[[i]]
    if (use_sys_time) {
      sumdf <- .time_tool(tset, tool, new_args$times)
    } else {
      res <- microbenchmark::microbenchmark(tool$call(tset),
        times = new_args$times
      )
      sumdf <- summary(res, unit = new_args$unit)
      sumdf$expr <- NULL
    }

    dfbase <- data.frame(
      testset = tset$get_tsname(),
      toolset = tool$get_setname(),
      toolname = tool$get_toolname()
    )
    cbind(dfbase, sumdf)
  }
  res_df <- do.call(rbind, lapply(seq_along(new_testset), bmfunc))
  sorted_df <- res_df[order(res_df$testset, res_df$toolset, res_df$toolname), ]
  rownames(sorted_df) <- seq_len(nrow(sorted_df))

  # Create an S3 object
  structure(list(tab = sorted_df), class = "benchmark")
}

#
# Validate arguments and return updated arguments
#
.validate_run_benchmark_args <- function(testset, toolset, times, unit) {
  assertthat::assert_that(is.list(testset))
  assertthat::assert_that(length(testset) > 0)
  for (tset in testset) {
    if (!methods::is(tset, "TestDataB")) {
      stop("Invalid testset", call. = FALSE)
    }
  }

  assertthat::assert_that(is.list(toolset))
  assertthat::assert_that(length(toolset) > 0)
  for (tset in toolset) {
    if (!methods::is(tset, "ToolIFBase")) {
      stop("Invalid toolset", call. = FALSE)
    }
  }

  assertthat::assert_that(assertthat::is.number(times))
  assertthat::assert_that(times > 0)
  assertthat::assert_that(assertthat::is.string(unit))
  assertthat::assert_that(unit %in% c("ns", "us", "ms", "s", "eps", "relative"))

  list(testset = testset, toolset = toolset, times = times, unit = unit)
}

#
# Check runnning time of the tool
#
.time_tool <- function(tset, tool, times, time_type = "elapsed", multi = 1000) {
  tres <- replicate(times, system.time(tool$call(tset))) * multi
  if (time_type == "user") {
    if (any(is.na(tres["user.child", ]))) {
      tsum <- c(summary(tres["user.self", ]), times)
    } else {
      tsum <- c(summary(tres["user.self", ] + tres["user.child", ]), times)
    }
  } else if (time_type == "elapsed") {
    tsum <- c(summary(tres["elapsed", ]), times)
  }
  names(tsum) <- c("min", "lq", "mean", "median", "uq", "max", "neval")
  t(as.data.frame(tsum))
}