Apply 'olim' consistently.

NEWS.md

@@ -12,7 +12,9 @@
 
 - in `plot.gosh.rma()`, can also set `het="tau"` (to plot the square root of tau^2 as the measure of heterogeneity)
 
-- in the various `forest()` functions, argument `ylim` can also now only be a single value to specify the lower bound (while the upper bound is still set automatically)
+- in the various `forest()` functions, argument `ylim` can now only be a single value to specify the lower bound (while the upper bound is still set automatically)
+
+- in `forest()` and `regplot()`, observation limits set via `olim` are now properly applied to all elements
 
 - some internal refactoring of the code
 

R/forest.cumul.rma.r

@@ -385,10 +385,9 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
       if (length(olim) != 2L)
          stop(mstyle$stop("Argument 'olim' must be of length 2."))
       olim <- sort(olim)
-      yi[yi < olim[1]] <- olim[1]
-      yi[yi > olim[2]] <- olim[2]
-      ci.lb[ci.lb < olim[1]] <- olim[1]
-      ci.ub[ci.ub > olim[2]] <- olim[2]
+      yi    <- .applyolim(yi, olim)
+      ci.lb <- .applyolim(ci.lb, olim)
+      ci.ub <- .applyolim(ci.ub, olim)
    }
 
    #########################################################################

R/forest.default.r

@@ -481,10 +481,9 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
       if (length(olim) != 2L)
          stop(mstyle$stop("Argument 'olim' must be of length 2."))
       olim <- sort(olim)
-      yi[yi < olim[1]] <- olim[1]
-      yi[yi > olim[2]] <- olim[2]
-      ci.lb[ci.lb < olim[1]] <- olim[1]
-      ci.ub[ci.ub > olim[2]] <- olim[2]
+      yi    <- .applyolim(yi, olim)
+      ci.lb <- .applyolim(ci.lb, olim)
+      ci.ub <- .applyolim(ci.ub, olim)
    }
 
    if (showweights) {                           # inverse variance weights after ordering/subsetting and

R/forest.rma.r

@@ -588,12 +588,12 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
       if (length(olim) != 2L)
          stop(mstyle$stop("Argument 'olim' must be of length 2."))
       olim <- sort(olim)
-      yi[yi < olim[1]] <- olim[1]
-      yi[yi > olim[2]] <- olim[2]
-      ci.lb[ci.lb < olim[1]] <- olim[1]
-      ci.ub[ci.ub > olim[2]] <- olim[2]
-      pred.ci.lb[pred.ci.lb < olim[1]] <- olim[1]
-      pred.ci.ub[pred.ci.ub > olim[2]] <- olim[2]
+      yi         <- .applyolim(yi, olim)
+      ci.lb      <- .applyolim(ci.lb, olim)
+      ci.ub      <- .applyolim(ci.ub, olim)
+      pred       <- .applyolim(pred, olim)
+      pred.ci.lb <- .applyolim(pred.ci.lb, olim)
+      pred.ci.ub <- .applyolim(pred.ci.ub, olim)
    }
 
    ### set default point sizes (if not specified by user)
@@ -972,12 +972,11 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
       ### apply observation/outcome limits if specified
 
       if (!missing(olim)) {
-         pred[pred < olim[1]] <- olim[1]
-         pred[pred > olim[2]] <- olim[2]
-         beta.ci.lb[beta.ci.lb < olim[1]] <- olim[1]
-         beta.ci.ub[beta.ci.ub > olim[2]] <- olim[2]
-         beta.pi.lb[beta.pi.lb < olim[1]] <- olim[1]
-         beta.pi.ub[beta.pi.ub > olim[2]] <- olim[2]
+         beta       <- .applyolim(beta, olim)
+         beta.ci.lb <- .applyolim(beta.ci.lb, olim)
+         beta.ci.ub <- .applyolim(beta.ci.ub, olim)
+         beta.pi.lb <- .applyolim(beta.pi.lb, olim)
+         beta.pi.ub <- .applyolim(beta.pi.ub, olim)
       }
 
       ### add prediction interval

R/misc.func.hidden.r

@@ -167,6 +167,16 @@
 
 ############################################################################
 
+### function for applying observation limits
+
+.applyolim <- function(x, olim) {
+   x[x < olim[1]] <- olim[1]
+   x[x > olim[2]] <- olim[2]
+   return(x)
+}
+
+############################################################################
+
 ### function to take the square root of a vector of numbers, giving NA for negative numbers (without a warning)
 
 .sqrt <- function(x)

R/regplot.rma.r

@@ -522,14 +522,12 @@ lcol, lwd, lty, legend=FALSE, xvals, ...) {
       if (length(olim) != 2L)
          stop(mstyle$stop("Argument 'olim' must be of length 2."))
       olim <- sort(olim)
-      yi[yi < olim[1]] <- olim[1]
-      yi[yi > olim[2]] <- olim[2]
-      pred[pred < olim[1]] <- olim[1]
-      pred[pred > olim[2]] <- olim[2]
-      ci.lb[ci.lb < olim[1]] <- olim[1]
-      ci.ub[ci.ub > olim[2]] <- olim[2]
-      pi.lb[pi.lb < olim[1]] <- olim[1]
-      pi.ub[pi.ub > olim[2]] <- olim[2]
+      yi     <- .applyolim(yi, olim)
+      ci.lb  <- .applyolim(ci.lb, olim)
+      ci.ub  <- .applyolim(ci.ub, olim)
+      pred   <- .applyolim(pred, olim)
+      pi.lb  <- .applyolim(pi.lb, olim)
+      pi.ub  <- .applyolim(pi.ub, olim)
    }
 
    ### set default point sizes (if not specified by user)

R/simulate.rma.r

@@ -48,8 +48,7 @@ simulate.rma <- function(object, nsim=1, seed=NULL, olim, ...) {
       if (length(olim) != 2L)
          stop(mstyle$stop("Argument 'olim' must be of length 2."))
       olim <- sort(olim)
-      val[val < olim[1]] <- olim[1]
-      val[val > olim[2]] <- olim[2]
+      val <- .applyolim(val, olim)
    }
 
    #########################################################################

R/summary.escalc.r

@@ -106,10 +106,9 @@ H0=0, append=TRUE, replace=TRUE, level=95, olim, digits, transf, ...) {
       if (length(olim) != 2L)
          stop(mstyle$stop("Argument 'olim' must be of length 2."))
       olim <- sort(olim)
-      yi[yi < olim[1]] <- olim[1] # note: zi and pval are based on unconstrained yi
-      yi[yi > olim[2]] <- olim[2]
-      ci.lb[ci.lb < olim[1]] <- olim[1]
-      ci.ub[ci.ub > olim[2]] <- olim[2]
+      yi    <- .applyolim(yi, olim) # note: zi and pval are based on unconstrained yi
+      ci.lb <- .applyolim(ci.lb, olim)
+      ci.ub <- .applyolim(ci.ub, olim)
    }
 
    x[[yi.name]] <- yi

docs/pkgdown.yml

@@ -3,7 +3,7 @@ pkgdown: 2.0.7
 pkgdown_sha: ~
 articles:
   diagram: pkgdown/diagram.html
-last_built: 2024-03-07T08:44Z
+last_built: 2024-03-07T09:57Z
 urls:
   reference: https://wviechtb.github.io/metafor/reference
   article: https://wviechtb.github.io/metafor/articles