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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
#' @title Quick recursive arguments checks on lists and data frames
#'
#' @description
#' These functions are the tuned counterparts of \code{\link{qtest}},
#' \code{\link{qassert}} and \code{\link{qexpect}} tailored for recursive
#' checks of list elements or data frame columns.
#'
#' @param x [\code{list} or \code{data.frame}]\cr
#' List or data frame to check for compliance with at least one of \code{rules}.
#' See details of \code{\link{qtest}} for rule explanation.
#' @param rules [\code{character}]\cr
#' Set of rules. See \code{\link{qtest}}
#' @template var.name
#' @return See \code{\link{qassert}}.
#' @seealso \code{\link{qtest}}, \code{\link{qassert}}
#' @useDynLib checkmate c_qassert
#' @export
#' @examples
#' # All list elements are integers with length >= 1?
#' qtestr(as.list(1:10), "i+")
#'
#' # All list elements (i.e. data frame columns) are numeric?
#' qtestr(iris, "n")
#'
#' # All list elements are numeric, w/o NAs?
#' qtestr(list(a = 1:3, b = rnorm(1), c = letters), "N+")
#'
#' # All list elements are numeric OR character
#' qtestr(list(a = 1:3, b = rnorm(1), c = letters), c("N+", "S+"))
qassertr = function(x, rules, .var.name = vname(x)) {
res = .Call(c_qassert, x, rules, TRUE)
if (!isTRUE(res))
mstop(qrmsg(x, res, .var.name), call. = sys.call(-1L))
invisible(x)
}
#' @rdname qassertr
#' @param depth [\code{integer(1)}]\cr
#' Maximum recursion depth. Defaults to \dQuote{1} to directly check list elements or
#' data frame columns. Set to a higher value to check lists of lists of elements.
#' @useDynLib checkmate c_qtest
#' @export
qtestr = function(x, rules, depth = 1L) {
.Call(c_qtest, x, rules, TRUE, depth)
}
#' @rdname qassertr
#' @template expect
#' @include makeExpectation.R
#' @useDynLib checkmate c_qassert
#' @export
qexpectr = function(x, rules, info = NULL, label = vname(x)) {
res = .Call(c_qassert, x, rules, TRUE)
if (!isTRUE(res))
res = qrmsg(x, res, label)
makeExpectation(x, res, info = info, label = label)
}
qrmsg = function(x, msg, var.name) {
pos = attr(msg, "pos")
if (testNamed(x)) {
item = sprintf(", element '%s' (%i),", names(x)[pos], pos)
} else {
item = sprintf(", element %i,", pos)
}
if (length(msg) > 1L)
msg = paste0(c("One of the following must apply:", strwrap(msg, prefix = " * ")), collapse = "\n")
sprintf("Assertion on '%s'%s failed. %s.", var.name, item, msg)
}
|
