65 lines
1.9 KiB
R
65 lines
1.9 KiB
R
|
|
#' Test if multiple expressions are (nearly) equal
|
|
#'
|
|
#' Convenience wrapper to [base::all.equal()] which is applied to each pairing
|
|
#' of an expression to the first expresstion.
|
|
#'
|
|
#' @param exprs an unevaluated expression of the form
|
|
#' ```
|
|
#' {
|
|
#' expr1
|
|
#' expr2
|
|
#' ...
|
|
#' }
|
|
#' ```
|
|
#' @param ... passed to [base::all.equal()]
|
|
#' @param stopifnot boolean, if `TRUE` an error is thrown if [base::all.equal()]
|
|
#' does not evaluate to `TRUE` for any pairing.
|
|
#'
|
|
#' @returns `TRUE` or an error message.
|
|
#'
|
|
#' @examples
|
|
#' exprs.all.equal({
|
|
#' matrix(rep(1, 6), 2, 3)
|
|
#' matrix(1, 2, 3)
|
|
#' array(rep(1, 6), dim = c(2, 3))
|
|
#' })
|
|
#' # is identical to
|
|
#' stopifnot(exprs = {
|
|
#' all.equal(matrix(rep(1, 6), 2, 3), matrix(1, 2, 3))
|
|
#' all.equal(matrix(rep(1, 6), 2, 3), array(rep(1, 6), dim = c(2, 3)))
|
|
#' })
|
|
#'
|
|
#' @seealso [base::all.equal()]
|
|
#'
|
|
#' @export
|
|
exprs.all.equal <- function(exprs, ..., stopifnot = TRUE) {
|
|
envir <- parent.frame()
|
|
exprs <- substitute(exprs)
|
|
|
|
# validate if there are at least 2 expressions to compare
|
|
if (!is.symbol(exprs[[1]]) || exprs[[1]] != quote(`{`) || length(exprs) < 3) {
|
|
stop("Only one 'exprs' or not a collection of expressions")
|
|
}
|
|
|
|
# reference value to compare all other expressions against
|
|
ref <- eval(exprs[[2]], envir = envir)
|
|
|
|
# compare reference against all the other expressions
|
|
for (i in seq.int(3, length(exprs), by = 1)) {
|
|
comp <- all.equal(ref, eval(exprs[[i]], envir = envir), ...)
|
|
# check `all.equal` for reference against current expression
|
|
if (!(is.logical(comp) && comp)) {
|
|
msg <- c(sprintf("Expr 1 `%s` and Expr %d `%s` are not equal:",
|
|
deparse(exprs[[2]]), i - 1, deparse(exprs[[i]])), comp)
|
|
if (stopifnot) {
|
|
stop(paste(msg, collapse = "\n"))
|
|
} else {
|
|
return(msg)
|
|
}
|
|
}
|
|
}
|
|
|
|
TRUE
|
|
}
|