R/utils_checks.R

In jsdtools: Jensen-Shannon Divergence Estimation, Confidence Intervals, and Distribution Plots

#' Validate paired inputs
#'
#' @param x First input vector.
#' @param y Second input vector.
#' @param min_n Minimum required sample size after filtering.
#' @param na_rm Logical; remove missing values?
#' @param finite_only Logical; keep only finite values?
#'
#' @return A list with cleaned x and y.
#' @keywords internal
validate_xy <- function(x, y, min_n = 1, na_rm = TRUE, finite_only = FALSE) {
  if (missing(x) || missing(y)) {
    stop("Both x and y must be supplied.")
  }

  if (!is.atomic(x) || !is.atomic(y)) {
    stop("x and y must be atomic vectors.")
  }

  x <- unclass(x)
  y <- unclass(y)

  if (na_rm) {
    x <- x[!is.na(x)]
    y <- y[!is.na(y)]
  }

  if (finite_only) {
    if (!is.numeric(x) || !is.numeric(y)) {
      stop("finite_only = TRUE requires numeric x and y.")
    }
    x <- x[is.finite(x)]
    y <- y[is.finite(y)]
  }

  if (length(x) < min_n || length(y) < min_n) {
    stop(sprintf("x and y must each contain at least %s valid observations.", min_n))
  }

  list(x = x, y = y)
}


#' Validate logarithm base
#'
#' @param base Logarithm base.
#'
#' @return Invisibly TRUE.
#' @keywords internal
check_base <- function(base) {
  if (!is.numeric(base) || length(base) != 1 || !is.finite(base)) {
    stop("base must be a single finite numeric value.")
  }

  if (!isTRUE(all.equal(base, 2)) && !isTRUE(all.equal(base, exp(1)))) {
    stop("base must be either 2 or exp(1).")
  }

  invisible(TRUE)
}


#' Validate confidence level
#'
#' @param conf_level Confidence level.
#'
#' @return Invisibly TRUE.
#' @keywords internal
check_conf_level <- function(conf_level) {
  if (!is.numeric(conf_level) || length(conf_level) != 1 ||
      !is.finite(conf_level) || conf_level <= 0 || conf_level >= 1) {
    stop("conf_level must be a single number in (0, 1).")
  }
  invisible(TRUE)
}