Nothing
#' Default input tests
#'
#' This function provides a selection of potentially problematic inputs by
#' class. List inputs are very limited by design, as they can be automatically
#' generated by setting `listify_what = TRUE` in [fuzz].
#'
#' @param use Names of input classes to use. Valid names are "all" (default),
#' "scalar", "numeric", "integer", "logical", "character", "factor",
#' "data.frame", "matrix", "array", "date", "raw" and "list". A vector
#' of valid classes can be retrieved programmatically by setting this
#' argument to "help".
#' @param skip Names of input classes to skip.
#'
#' @return
#' A named list of inputs corresponding to the input classes selected, or
#' a character vector of valid input classes if `use = "help"`.
#'
#' @examples
#' ## only the scalar and numeric tests
#' inputs1 <- test_inputs(use = c("scalar", "numeric"))
#'
#' ## everything but the data, raw and list tests
#' inputs2 <- test_inputs(skip = c("date", "raw", "list"))
#'
#' ## print the valid input classes
#' test_inputs("help")
#'
#' @seealso [fuzz]
#'
#' @export
test_inputs <- function(use = "all", skip = "") {
validate_class(use, "character", remove_empty = TRUE)
validate_class(skip, "character")
inputs <- c("scalar_inputs",
"numeric_inputs",
"integer_inputs",
"logical_inputs",
"character_inputs",
"factor_inputs",
"data.frame_inputs",
"matrix_inputs",
"array_inputs",
"date_inputs",
"raw_inputs",
"list_inputs")
valid <- names(inputs) <- gsub("_inputs", "", inputs)
if ("help" %in% use)
return(c("all", valid))
if ("all" %in% use)
use <- valid
use <- setdiff(use[use %in% valid], skip)
if (length(use) == 0)
fuzz_error("No valid tests selected, valid names are: ",
paste(c("all", valid), collapse = ", "),
from = "test_inputs")
unlist(lapply(use, function(x) eval(call(inputs[x]))), recursive = FALSE)
}
#' Add names to a list of inputs
#'
#' This function can be used to generate automatically pretty names in a
#' list of custom input object. This can improve the output, especially when
#' structures such as data frames, matrices, and more complex objects are
#' involved.
#'
#' @param ... Objects, possibly named.
#'
#' @return
#' A named list containing the evaluated arguments. For unnamed arguments,
#' names are generated by deparsing the unevaluated inputs.
#'
#' @examples
#' namify(data.frame(a = 1, b = 2))
#'
#' @seealso [fuzz]
#'
#' @export
namify <- function(...) {
what <- substitute(list(...))
## use deparsed names for unnamed objects
idx.empty <- if (is.null(names(what))) seq_along(what) else names(what) == ""
names(what)[idx.empty] <- sapply(what, function(x) deparse(x))[idx.empty]
## evaluate the arguments and remove the list() element added by substitute()
lapply(what, eval)[-1]
}
scalar_inputs <- function() {
namify(
NA,
0L,
1.2,
"a test",
NaN,
Inf,
NULL
)
}
numeric_inputs <- function() {
namify(
c(1.309605, 0.585381, -0.461072),
c(-1, 0, NaN, 1e4),
c(Inf, -0.5, 1234),
c(0, NA),
numeric()
)
}
integer_inputs <- function() {
namify(
-1:3,
c(0L, NA),
integer()
)
}
logical_inputs <- function() {
namify(
TRUE,
c(TRUE, NA, FALSE),
logical()
)
}
character_inputs <- function() {
namify(
"",
c("A", NA, "7", "+"),
character()
)
}
factor_inputs <- function() {
namify(
factor(""),
factor(c("A", NA, "7", "+")),
factor()
)
}
date_inputs <- function() {
namify(
as.Date(NA),
as.Date(NULL),
as.Date(0),
as.Date(c("2025-01-01", NA, "930-12-31")),
Sys.Date()
)
}
data.frame_inputs <- function() {
namify(
data.frame(a = NA),
data.frame(a = letters),
data.frame(a = 1:10, b = NA),
datasets::iris[0, ],
datasets::iris[, 0],
datasets::iris[1, , drop = FALSE],
datasets::iris[, 1, drop = FALSE],
data.frame()
)
}
matrix_inputs <- function() {
namify(
matrix(0, 0, 0),
matrix(1, 1, 0),
matrix(1, 0, 1),
matrix(c(1.995874, 1.225707, -0.565287, -2.120309, 0.236326), 1, 5),
matrix(c(-1.005770, 0.589365, 0.955131, -0.972982, 1.058721), 5, 1),
matrix(c(1:7, NA, -1:-4), 3, 4),
matrix(letters, 13, 2),
matrix()
)
}
array_inputs <- function() {
namify(
array(0, c(0, 0, 0)),
array(1, c(1, 1, 0)),
array(1, c(0, 1, 0)),
array(c(0.72350, -0.19754, 1.67188, -0.62163, -0.84149), c(1, 1, 5)),
array(c(-0.16868, 0.86973, -0.46976, 0.32157, -0.43558), c(1, 5, 1)),
array(c(-0.57441, -1.9585, -0.24757, -0.2467, -2.04617), c(5, 1, 1)),
array(c(1:7, NA), c(2, 4, 1)),
array(c(1:5, NA, NA), c(2, 4, 2)),
array()
)
}
raw_inputs <- function() {
namify(
charToRaw("0"),
charToRaw("abc"),
raw()
)
}
list_inputs <- function() {
namify(
list(3),
list(a = c(1, 2, 3), b = letters),
list()
)
}
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.