R/validation_functions.R

Defines functions validate_initial_values validate_rankings validate_preferences check_larger validate_logical validate_positive_vector validate_positive validate_integer validate_class

validate_class <- function(argument, class) {
  if (!inherits(argument, class)) {
    stop(paste0(
      deparse(substitute(argument)), " must be an object of class ",
      class, "."
    ))
  }
}

validate_integer <- function(argument) {
  if (!is.numeric(argument) || argument < 0 || (round(argument) != argument)) {
    stop(paste(deparse(substitute(argument)), "must be a positive integer"))
  }
}

validate_positive <- function(argument) {
  if (length(argument) > 1 || argument <= 0 || !is.numeric(argument)) {
    stop(paste(
      deparse(substitute(argument)),
      "must be a strictly positive number of length one"
    ))
  }
}

validate_positive_vector <- function(argument) {
  if (any(argument <= 0) || !is.numeric(argument)) {
    stop(paste(
      deparse(substitute(argument)),
      "must be a vector of strictly positive numbers"
    ))
  }
}


validate_logical <- function(argument) {
  if (!is.logical(argument) || length(argument) != 1) {
    stop(paste(
      deparse(substitute(argument)),
      "must be a logical value of length one"
    ))
  }
}

check_larger <- function(larger, smaller) {
  if (larger <= smaller) {
    stop(paste(
      deparse(substitute(larger)), "must be strictly larger than",
      deparse(substitute(smaller))
    ))
  }
}

validate_preferences <- function(data, model) {
  if (inherits(data$preferences, "BayesMallowsIntransitive") &&
    model$error_model == "none") {
    stop("Intransitive pairwise comparisons. Please specify an error model.")
  }
}

validate_rankings <- function(data) {
  if (nrow(data$rankings) <= 0) stop("Data must have at least one row.")
}

validate_initial_values <- function(initial_values, data) {
  if (!is.null(initial_values$rho)) {
    if (length(unique(initial_values$rho)) != length(initial_values$rho)) {
      stop("initial value rho must be a ranking")
    }
    if (length(initial_values$rho) != data$n_items) {
      stop("initial value for rho must have one value per item")
    }
  }
}

Try the BayesMallows package in your browser

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

BayesMallows documentation built on Sept. 11, 2024, 5:31 p.m.