/
check-names.R
54 lines (48 loc) · 1.67 KB
/
check-names.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
#' 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)
}