R/check-names.R

In chk: Check User-Supplied Function Arguments

#' Check Names
#'
#' @description
#' Checks the names of an object.
#'
#' @inheritParams params
#' @param names A character vector of the required names.
#' @param exclusive A flag specifying whether x must only contain the required names.
#' @param order A flag specifying whether the order of the required names in x must match the order in names.
#' @return An informative error if the test fails or an invisible copy of x.
#'
#' @family check
#'
#' @examples
#' x <- c(x = 1, y = 2)
#' check_names(x, c("y", "x"))
#' try(check_names(x, c("y", "x"), order = TRUE))
#' try(check_names(x, "x", exclusive = TRUE))
#' @export
check_names <- function(
  x,
  names = character(0),
  exclusive = FALSE,
  order = FALSE,
  x_name = NULL
) {
  chk_s3_class(names, "character")
  chk_unique(names)
  chk_not_any_na(names)
  chk_flag(exclusive)
  chk_flag(order)
  if (is.null(x_name)) {
    x_name <- deparse_backtick_chk((substitute(x)))
  }
  chk_string(x_name)
  chk_named(x, x_name = x_name)

  x_names <- names(x)

  if (!length(names)) {
    if (exclusive && length(x_names)) {
      abort_chk(x_name, " must not have any elements")
    }
    return(invisible(x))
  }

  x_name <- backtick_chk(p0("names(", unbacktick_chk(x_name), ")"))

  if (length(setdiff(names, x_names))) {
    abort_chk(
      x_name,
      " must include ",
      cc(setdiff(names, x_names), conj = " and ")
    )
  }

  if (exclusive && length(setdiff(x_names, names))) {
    abort_chk(
      x_name,
      " must not include ",
      cc(setdiff(x_names, names), conj = " or ")
    )
  }

  if (
    order && !identical(intersect(names, x_names), intersect(x_names, names))
  ) {
    abort_chk(
      x_name,
      " must include ",
      cc(names, conj = " and "),
      " in that order"
    )
  }
  invisible(x)
}