Nothing
#' 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))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.