#' @title Run a function safely
#' @description This is a wrapper function designed to run a function safely
#' when it is not completely clear what arguments could be passed to the
#' function.
#'
#' All named arguments in `...` that are not accepted by `fun` are removed.
#' All unnamed arguments are passed on to the function. In case `fun` errors,
#' the error will be converted to a warning and `run_safely` returns `NULL`.
#'
#' `run_safely` can be useful when constructing functions to be used as
#' metrics in [score()].
#'
#' @param ... Arguments to pass to `fun`
#' @param fun A function to execute
#' @importFrom cli cli_warn
#' @return The result of `fun` or `NULL` if `fun` errors
#' @export
#' @keywords scoring
#' @examples
#' f <- function(x) {x}
#' run_safely(2, fun = f)
#' run_safely(2, y = 3, fun = f)
#' run_safely(fun = f)
#' run_safely(y = 3, fun = f)
run_safely <- function(..., fun) {
args <- list(...)
# Check if the function accepts ... as an argument
if ("..." %in% names(formals(fun))) {
valid_args <- args
} else if (is.null(names(args))) {
# if no arguments are named, just pass all arguments on
valid_args <- args
} else {
# Identify the arguments that fun() accepts
possible_args <- names(formals(fun))
# keep valid arguments as well as unnamed arguments
valid_args <- args[names(args) == "" | names(args) %in% possible_args]
}
result <- try(do.call(fun, valid_args), silent = TRUE)
if (inherits(result, "try-error")) {
#nolint start: object_usage_linter
msg <- conditionMessage(attr(result, "condition"))
cli_warn(
c(
"!" = "Function execution failed, returning NULL.
Error: {msg}."
)
)
#nolint end
return(NULL)
}
return(result)
}
#' Ensure That an Object is a Data Table
#' @description This function ensures that an object is a data table.
#' If the object is not a data table, it is converted to one. If the object
#' is a data table, a copy of the object is returned.
#' @param data An object to ensure is a data table
#' @return A data.table/a copy of an exising data.table
#' @keywords internal
#' @importFrom data.table copy is.data.table as.data.table
ensure_data.table <- function(data) {
if (is.data.table(data)) {
data <- copy(data)
} else {
data <- as.data.table(data)
}
return(data)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.