#' 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 }