R/inputs.R

Defines functions list_inputs raw_inputs array_inputs matrix_inputs data.frame_inputs date_inputs factor_inputs character_inputs logical_inputs integer_inputs numeric_inputs scalar_inputs namify test_inputs

Documented in namify test_inputs

#' 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()
  )
}

Try the CBTF package in your browser

Any scripts or data that you put into this service are public.

CBTF documentation built on Aug. 21, 2025, 6:03 p.m.