R/utils-check.R

In eFCM: Exponential Factor Copula Model

#' Internal Assertion Helpers
#' @noRd

# Assert that x is a finite numeric scalar
assert_numeric_scalar <- function(x, name) {
  if (!is.numeric(x) || length(x) != 1 || !is.finite(x)) {
    stop(sprintf("`%s` must be a single finite numeric value.", name), call. = FALSE)
  }
}
#' @noRd
# Assert that x inherits from a specific class
assert_class <- function(x, class, name) {
  if (!inherits(x, class)) {
    stop(sprintf("`%s` must be an object of class \"%s\".", name, class), call. = FALSE)
  }
}
#' @noRd
# Assert that x is a probability in (0,1)
assert_probability <- function(x, name) {
  assert_numeric_scalar(x, name)
  if (x <= 0 || x >= 1) {
    stop(sprintf("`%s` must be strictly between 0 and 1.", name), call. = FALSE)
  }
}
#' @noRd
# Assert that all values in x are non-negative
assert_non_negative <- function(x, name) {
  if (!is.numeric(x) || any(x < 0) || any(!is.finite(x))) {
    stop(sprintf("`%s` must be a numeric vector of non-negative, finite values.", name), call. = FALSE)
  }
}
#' @noRd
# Assert that x has specified length
assert_length <- function(x, len, name) {
  if (length(x) != len) {
    stop(sprintf("`%s` must have length %d.", name, len), call. = FALSE)
  }
}
#' @noRd
# Assert that x contains no missing values
assert_no_missing <- function(x, name) {
  if (anyNA(x)) {
    stop(sprintf("`%s` contains missing values; please remove or impute NAs first.", name), call. = FALSE)
  }
}
#' @noRd
# Assert that x is a matrix or data.frame2
assert_tabular <- function(x, name) {
  if (!is.matrix(x) && !is.data.frame(x)) {
    stop(sprintf("`%s` must be a matrix or data.frame.", name), call. = FALSE)
  }
}