/
chk-all.R
53 lines (48 loc) · 1.04 KB
/
chk-all.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
#' Check All
#'
#' @description
#' Checks all elements using
#'
#' `all(vapply(x, chk_fun, TRUE, ...))`
#'
#' @inheritParams params
#' @inherit params return
#'
#' @family chk_alls
#'
#' @examples
#' # chk_all
#' chk_all(TRUE, chk_lgl)
#' # FIXME try(chk_all(1, chk_lgl))
#' chk_all(c(TRUE, NA), chk_lgl)
#' @export
chk_all <- function(x, chk_fun, ..., x_name = NULL) {
if (is.null(x)) {
if (is.null(x_name)) x_name <- deparse_backtick_chk(substitute(x))
return(chk_fun(x, ..., x_name = x_name))
}
if (is.null(x_name)) x_name <- deparse_backtick_chk(substitute(x))
x_name <- paste0("all elements of ", x_name)
args <- list(...)
args$X <- x
args$FUN <- chk_fun
args$x_name <- x_name
do.call("lapply", args)
invisible(x)
}
#' @describeIn chk_all Validate All
#'
#' @examples
#' # vld_all
#' vld_all(c(TRUE, NA), vld_lgl)
#' @export
vld_all <- function(x, vld_fun, ...) {
if (is.null(x)) {
return(vld_fun(x, ...))
}
args <- list(...)
args$X <- x
args$FUN <- vld_fun
args$FUN.VALUE <- TRUE
all(do.call("vapply", args))
}