More consistent use of call.=FALSE in warnings and errors.

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: metafor
-Version: 4.5-1
+Version: 4.5-2
 Date: 2023-10-22
 Title: Meta-Analysis Package for R
 Authors@R: person(given = "Wolfgang", family = "Viechtbauer", role = c("aut","cre"), email = "wvb@metafor-project.org", comment = c(ORCID = "0000-0003-3463-4063"))

NEWS.md

@@ -1,4 +1,4 @@
-# metafor 4.5-1 (2023-10-22)
+# metafor 4.5-2 (2023-10-22)
 
 - a few minor fixes to the dynamic theming of plots based on the foreground and background colors of the plotting device
 

R/addpoly.default.r

@@ -151,7 +151,7 @@ transf, atransf, targs, efac, col, border, lty, fonts, cex, constarea=FALSE, ...
    yi <- x
 
    if (!missing(vi) && is.function(vi)) # if vi is utils::vi()
-      stop(mstyle$stop("Cannot find variable specified for 'vi' argument."), call.=FALSE)
+      stop(mstyle$stop("Cannot find variable specified for 'vi' argument."))
 
    if (hasArg(ci.lb) && hasArg(ci.ub)) {
 

R/forest.default.r

@@ -222,7 +222,7 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
    ### extract data, study labels, and other arguments
 
    if (!missing(vi) && is.function(vi)) # if vi is utils::vi()
-      stop(mstyle$stop("Cannot find variable specified for 'vi' argument."), call.=FALSE)
+      stop(mstyle$stop("Cannot find variable specified for 'vi' argument."))
 
    if (hasArg(ci.lb) && hasArg(ci.ub)) {     # CI bounds are specified by user
       if (length(ci.lb) != length(ci.ub))

R/fsn.r

@@ -358,7 +358,7 @@ fsn <- function(x, vi, sei, subset, data, type, alpha=.05, target,
       tmp <- try(rma(yi, vi, method=method, tau2=tau2fix, test=test, weighted=weighted, verbose=verbose), silent=!verbose)
 
       if (inherits(tmp, "try-error"))
-         stop(mstyle$stop("Could not fit random-effects model (use verbose=TRUE for more info)."), call.=FALSE)
+         stop(mstyle$stop("Could not fit random-effects model (use verbose=TRUE for more info)."))
 
       vt   <- 1 / mean(1/vi)
       est  <- tmp$beta[1]

R/funnel.default.r

@@ -70,7 +70,7 @@ label=FALSE, offset=0.4, legend=FALSE, ...) {
       vi <- NULL
 
    if (is.function(vi)) # if vi is utils::vi()
-      stop(mstyle$stop("Cannot find variable specified for 'vi' argument."), call.=FALSE)
+      stop(mstyle$stop("Cannot find variable specified for 'vi' argument."))
 
    if (missing(sei))
       sei <- NULL

R/predict.rma.ls.r

@@ -85,10 +85,10 @@ level, digits, transf, targs, vcov=FALSE, ...) {
             pos <- sapply(colnames(X.new), function(colname) {
                      d <- c(adist(colname, colnames.mod, costs=c(ins=1, sub=Inf, del=Inf))) # compute edit distances with Inf costs for substitutions/deletions
                      if (all(is.infinite(d))) # if there is no match, then all elements are Inf
-                        stop(mstyle$stop(paste0("Could not find variable '", colname, "' in the model.")), call. = FALSE)
+                        stop(mstyle$stop(paste0("Could not find variable '", colname, "' in the model.")))
                      d <- which(d == min(d)) # don't use which.min() since that only finds the first minimum
                      if (length(d) > 1L) # if there is no unique match, then there is more than one minimum
-                        stop(mstyle$stop(paste0("Could not match up variable '", colname, "' uniquely to a variable in the model.")), call. = FALSE)
+                        stop(mstyle$stop(paste0("Could not match up variable '", colname, "' uniquely to a variable in the model.")))
                      return(d)
                      })
             if (anyDuplicated(pos)) { # if the same name is used more than once, then there will be duplicated pos values
@@ -153,10 +153,10 @@ level, digits, transf, targs, vcov=FALSE, ...) {
             pos <- sapply(colnames(Z.new), function(colname) {
                      d <- c(adist(colname, colnames.mod, costs=c(ins=1, sub=Inf, del=Inf))) # compute edit distances with Inf costs for substitutions/deletions
                      if (all(is.infinite(d))) # if there is no match, then all elements are Inf
-                        stop(mstyle$stop(paste0("Could not find variable '", colname, "' from 'newscale' in the model.")), call. = FALSE)
+                        stop(mstyle$stop(paste0("Could not find variable '", colname, "' from 'newscale' in the model.")))
                      d <- which(d == min(d)) # don't use which.min() since that only finds the first minimum
                      if (length(d) > 1L) # if there is no unique match, then there is more than one minimum
-                        stop(mstyle$stop(paste0("Could not match up variable '", colname, "' from 'newscale' uniquely to a variable in the model.")), call. = FALSE)
+                        stop(mstyle$stop(paste0("Could not match up variable '", colname, "' from 'newscale' uniquely to a variable in the model.")))
                      return(d)
                      })
             if (anyDuplicated(pos)) { # if the same name is used more than once, then there will be duplicated pos values

R/predict.rma.r

@@ -163,10 +163,10 @@ level, digits, transf, targs, vcov=FALSE, ...) {
             pos <- sapply(colnames(X.new), function(colname) {
                      d <- c(adist(colname, colnames.mod, costs=c(ins=1, sub=Inf, del=Inf))) # compute edit distances with Inf costs for substitutions/deletions
                      if (all(is.infinite(d))) # if there is no match, then all elements are Inf
-                        stop(mstyle$stop(paste0("Could not find variable '", colname, "' in the model.")), call. = FALSE)
+                        stop(mstyle$stop(paste0("Could not find variable '", colname, "' in the model.")))
                      d <- which(d == min(d)) # don't use which.min() since that only finds the first minimum
                      if (length(d) > 1L) # if there is no unique match, then there is more than one minimum
-                        stop(mstyle$stop(paste0("Could not match up variable '", colname, "' uniquely to a variable in the model.")), call. = FALSE)
+                        stop(mstyle$stop(paste0("Could not match up variable '", colname, "' uniquely to a variable in the model.")))
                      return(d)
                      })
             if (anyDuplicated(pos)) { # if the same name is used more than once, then there will be duplicated pos values

R/profile.rma.mv.r

@@ -49,7 +49,7 @@ profile.rma.mv <- function(fitted, sigma2, tau2, rho, gamma2, phi,
       time.start <- proc.time()
 
    if (!is.null(ddd$startmethod))
-      warning(mstyle$warning("Argument 'startmethod' has been deprecated."))
+      warning(mstyle$warning("Argument 'startmethod' has been deprecated."), call.=FALSE)
 
    #########################################################################
 

R/regplot.rma.r

@@ -404,7 +404,7 @@ lcol, lwd, lty, legend=FALSE, xvals, ...) {
       pred <- pred$pred
 
       if (!is.null(label) && is.character(label) && label %in% c("ciout", "piout")) {
-         warning(mstyle$stop("Cannot label points based on the confidence/prediction interval when passing an object to 'pred'."))
+         warning(mstyle$stop("Cannot label points based on the confidence/prediction interval when passing an object to 'pred'."), call.=FALSE)
          label <- NULL
       }
 

R/rma.mv.r

@@ -1034,7 +1034,7 @@ cvvc=FALSE, sparse=FALSE, verbose=FALSE, digits, control, ...) {
                ### check if there are levels in R which are not in s.levels (if yes, issue a warning)
 
                if (any(!is.element(colnames(R[[j]]), s.levels[[j]])))
-                  warning(mstyle$warning(paste0("There are rows/columns in the 'R' matrix for '", s.names[j], "' for which there are no data.")))
+                  warning(mstyle$warning(paste0("There are rows/columns in the 'R' matrix for '", s.names[j], "' for which there are no data.")), call.=FALSE)
 
             }
 
@@ -1413,7 +1413,7 @@ cvvc=FALSE, sparse=FALSE, verbose=FALSE, digits, control, ...) {
       if (Rscale=="cor" || Rscale=="cor0") {
          R[Rfix] <- lapply(R[Rfix], function(x) {
             if (any(diag(x) <= 0))
-               stop(mstyle$stop("Cannot use Rscale=\"cor\" or Rscale=\"cor0\" with non-positive values on the diagonal of an 'R' matrix."), call.=FALSE)
+               stop(mstyle$stop("Cannot use Rscale=\"cor\" or Rscale=\"cor0\" with non-positive values on the diagonal of an 'R' matrix."))
             tmp <- cov2cor(x)
             if (any(abs(tmp) > 1))
                warning(mstyle$warning("Some values are larger than +-1 in an 'R' matrix after cov2cor() (see 'Rscale' argument)."), call.=FALSE)

R/rma.uni.r

@@ -1315,7 +1315,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                   stop(mstyle$stop("Iterative DL estimator did not converge."))
                } else {
                   if (verbose)
-                     warning(mstyle$warning("Iterative DL estimator did not converge."))
+                     warning(mstyle$warning("Iterative DL estimator did not converge."), call.=FALSE)
                }
             }
 
@@ -1379,7 +1379,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                         stop(mstyle$stop("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'."))
                      } else {
                         if (verbose)
-                           warning(mstyle$warning("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'."))
+                           warning(mstyle$warning("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'."), call.=FALSE)
                      }
 
                   } else {
@@ -1389,10 +1389,10 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                      if (inherits(tau2, "try-error")) {
                         conv <- FALSE
                         if (length(method) == 1L) {
-                           stop(mstyle$stop("Error in iterative search for tau2 using uniroot()."))
+                           stop(mstyle$stop("Error in iterative search for tau^2 using uniroot()."))
                         } else {
                            if (verbose)
-                              warning(mstyle$warning("Error in iterative search for tau2 using uniroot()."))
+                              warning(mstyle$warning("Error in iterative search for tau^2 using uniroot()."), call.=FALSE)
                         }
                      }
 
@@ -1471,7 +1471,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                   stop(mstyle$stop("Iterative SJ estimator did not converge."))
                } else {
                   if (verbose)
-                     warning(mstyle$warning("Iterative SJ estimator did not converge."))
+                     warning(mstyle$warning("Iterative SJ estimator did not converge."), call.=FALSE)
                }
             }
 
@@ -1506,7 +1506,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                         stop(mstyle$stop("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'."))
                      } else {
                         if (verbose)
-                           warning(mstyle$warning("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'."))
+                           warning(mstyle$warning("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'."), call.=FALSE)
                      }
 
                   } else {
@@ -1516,10 +1516,10 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                      if (inherits(tau2, "try-error")) {
                         conv <- FALSE
                         if (length(method) == 1L) {
-                           stop(mstyle$stop("Error in iterative search for tau2 using uniroot()."))
+                           stop(mstyle$stop("Error in iterative search for tau^2 using uniroot()."))
                         } else {
                            if (verbose)
-                              warning(mstyle$warning("Error in iterative search for tau2 using uniroot()."))
+                              warning(mstyle$warning("Error in iterative search for tau^2 using uniroot()."), call.=FALSE)
                         }
                      }
 
@@ -1600,7 +1600,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                   stop(mstyle$stop("Fisher scoring algorithm did not converge. See 'help(rma)' for possible remedies."))
                } else {
                   if (verbose)
-                     warning(mstyle$warning("Fisher scoring algorithm did not converge. See 'help(rma)' for possible remedies."))
+                     warning(mstyle$warning("Fisher scoring algorithm did not converge. See 'help(rma)' for possible remedies."), call.=FALSE)
                }
             }
 

R/robust.rma.mv.r

@@ -120,7 +120,7 @@ robust.rma.mv <- function(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits, .
          cs.wald <- try(clubSandwich::Wald_test(x, cluster=cluster, vcov=vb, test=ddd$wald_test, constraints=clubSandwich::constrain_zero(x$btt)), silent=!isTRUE(ddd$verbose))
 
          if (inherits(cs.wald, "try-error")) {
-            warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test (use verbose=TRUE for more details)."))
+            warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test (use verbose=TRUE for more details)."), call.=FALSE)
             cs.wald <- list(Fstat=NA_real_, df_num=NA_integer_, df_denom=NA_real_)
          }
 
@@ -255,7 +255,7 @@ robust.rma.mv <- function(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits, .
       QM <- try(as.vector(t(beta)[x$btt] %*% chol2inv(chol(vb[x$btt,x$btt])) %*% beta[x$btt]), silent=TRUE)
 
       if (inherits(QM, "try-error") || is.na(QM)) {
-         warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test."))
+         warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test."), call.=FALSE)
          QM <- NA_real_
       }
 

R/robust.rma.uni.r

@@ -120,7 +120,7 @@ robust.rma.uni <- function(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits,
          cs.wald <- try(clubSandwich::Wald_test(x, cluster=cluster, vcov=vb, test=ddd$wald_test, constraints=clubSandwich::constrain_zero(x$btt)), silent=!isTRUE(ddd$verbose))
 
          if (inherits(cs.wald, "try-error")) {
-            warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test (use verbose=TRUE for more details)."))
+            warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test (use verbose=TRUE for more details)."), call.=FALSE)
             cs.wald <- list(Fstat=NA_real_, df_num=NA_integer_, df_denom=NA_real_)
          }
 
@@ -256,7 +256,7 @@ robust.rma.uni <- function(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits,
       QM <- try(as.vector(t(beta)[x$btt] %*% chol2inv(chol(vb[x$btt,x$btt])) %*% beta[x$btt]), silent=TRUE)
 
       if (inherits(QM, "try-error") || is.na(QM)) {
-         warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test."))
+         warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test."), call.=FALSE)
          QM <- NA_real_
       }
 

R/vif.rma.r

@@ -220,7 +220,7 @@ vif.rma <- function(x, btt, att, table=FALSE, reestimate=FALSE, sim=FALSE, progb
          sim.loc <- 0
 
       if (sim >= 2 && any(x$coef.na)) {
-         warning(mstyle$warning("Cannot use 'sim' when some redundant predictors were dropped from the model."))
+         warning(mstyle$warning("Cannot use 'sim' when some redundant predictors were dropped from the model."), call.=FALSE)
          sim.loc <- 0
       }
 
@@ -341,7 +341,7 @@ vif.rma <- function(x, btt, att, table=FALSE, reestimate=FALSE, sim=FALSE, progb
          sim.scale <- 0
 
       if (sim >= 2 && any(x$coef.na.Z)) {
-         warning(mstyle$warning("Cannot use 'sim' when some redundant predictors were dropped from the model."))
+         warning(mstyle$warning("Cannot use 'sim' when some redundant predictors were dropped from the model."), call.=FALSE)
          sim.scale <- 0
       }
 

R/zzz.r

@@ -1,6 +1,6 @@
 .onAttach <- function(libname, pkgname) {
 
-   ver <- "4.5-1"
+   ver <- "4.5-2"
 
    loadmsg <- paste0("\nLoading the 'metafor' package (version ", ver, "). For an\nintroduction to the package please type: help(metafor)\n")
 

README.md

@@ -5,7 +5,7 @@ metafor: A Meta-Analysis Package for R
 [![R build status](https://github.com/wviechtb/metafor/workflows/R-CMD-check/badge.svg)](https://github.com/wviechtb/metafor/actions)
 [![Code Coverage](https://codecov.io/gh/wviechtb/metafor/branch/master/graph/badge.svg)](https://app.codecov.io/gh/wviechtb/metafor)
 [![CRAN Version](https://www.r-pkg.org/badges/version/metafor)](https://cran.r-project.org/package=metafor)
-[![devel Version](https://img.shields.io/badge/devel-4.5--1-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
+[![devel Version](https://img.shields.io/badge/devel-4.5--2-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
 [![Monthly Downloads](https://cranlogs.r-pkg.org/badges/metafor)](https://cranlogs.r-pkg.org/badges/metafor)
 [![Total Downloads](https://cranlogs.r-pkg.org/badges/grand-total/metafor)](https://cranlogs.r-pkg.org/badges/grand-total/metafor)