Added 'pi' and 'legend' argument to labbe().

wviechtb · Apr 18, 2024 · b19e147 · b19e147
1 parent 2aed042
commit b19e147
Show file tree

Hide file tree

Showing 131 changed files with 273 additions and 166 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: metafor
-Version: 4.7-7
+Version: 4.7-8
 Date: 2024-04-18
 Title: Meta-Analysis Package for R
 Authors@R: person(given = "Wolfgang", family = "Viechtbauer", role = c("aut","cre"), email = "[email protected]", comment = c(ORCID = "0000-0003-3463-4063"))

diff --git a/NEWS.md b/NEWS.md
@@ -1,12 +1,12 @@
-# metafor 4.7-7 (2024-04-18)
+# metafor 4.7-8 (2024-04-18)
 
 - made optimizers `Rcgmin` and `Rvmmin` available again via the `optimx` package
 
 - argument `shade` in `funnel()` now automatically uses a color gradient for the regions when multiple `level` values are specified
 
 - added extractor for function `se()` for extracting standard errors from model objects
 
-- added `lim` and `ci` arguments to `labbe()`
+- added `lim`, `ci`, `pi`, and `legend` arguments to `labbe()`
 
 - added more tests
 

diff --git a/R/labbe.rma.r b/R/labbe.rma.r
@@ -1,4 +1,4 @@
-labbe.rma <- function(x, xlim, ylim, lim, xlab, ylab, ci=FALSE,
+labbe.rma <- function(x, xlim, ylim, lim, xlab, ylab, ci=FALSE, pi=FALSE, legend=FALSE,
 add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid=FALSE, lty, ...) {
 
    mstyle <- .get.mstyle()
@@ -40,12 +40,10 @@ add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid
       psize <- NULL
 
    if (missing(lty)) {
-      lty <- c("solid", "dashed", "dotted") # 1 = diagonal line, 2 = estimated effect line, 3 = ci lines
+      lty <- c("solid", "dashed") # 1 = diagonal line, 2 = estimated effect line
    } else {
       if (length(lty) == 1L)
-         lty <- c(lty, lty, lty)
-      if (length(lty) == 2L)
-         lty <- c(lty, lty, "dotted")
+         lty <- c(lty, lty)
    }
 
    if (is.logical(ci))
@@ -56,6 +54,14 @@ add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid
       ci <- TRUE
    }
 
+   if (is.logical(pi))
+      picol <- .coladj(par("bg","fg"), dark=0.05, light=-0.05)
+
+   if (is.character(pi)) {
+      picol <- pi
+      pi <- TRUE
+   }
+
    ### get ... argument
 
    ddd <- list(...)
@@ -273,6 +279,8 @@ add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid
 
    t.vals.ci.lb <- tmp$ci.lb + 1*c.vals
    t.vals.ci.ub <- tmp$ci.ub + 1*c.vals
+   t.vals.pi.lb <- tmp$pi.lb + 1*c.vals
+   t.vals.pi.ub <- tmp$pi.ub + 1*c.vals
 
    if (is.function(transf)) {
       if (is.null(targs)) {
@@ -282,18 +290,20 @@ add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid
          t.vals       <- sapply(t.vals, transf)
          t.vals.ci.lb <- sapply(t.vals.ci.lb, transf)
          t.vals.ci.ub <- sapply(t.vals.ci.ub, transf)
+         t.vals.pi.lb <- sapply(t.vals.pi.lb, transf)
+         t.vals.pi.ub <- sapply(t.vals.pi.ub, transf)
       } else {
          dat.t$yi     <- sapply(dat.t$yi, transf, targs)
          dat.c$yi     <- sapply(dat.c$yi, transf, targs)
          c.vals       <- sapply(c.vals, transf, targs)
          t.vals       <- sapply(t.vals, transf, targs)
          t.vals.ci.lb <- sapply(t.vals.ci.lb, transf, targs)
          t.vals.ci.ub <- sapply(t.vals.ci.ub, transf, targs)
+         t.vals.pi.lb <- sapply(t.vals.pi.lb, transf, targs)
+         t.vals.pi.ub <- sapply(t.vals.pi.ub, transf, targs)
       }
    }
 
-   #print(round(cbind(c.vals, t.vals), 3))
-
    min.yi <- min(c(dat.t$yi, dat.c$yi))
    max.yi <- max(c(dat.t$yi, dat.c$yi))
 
@@ -339,13 +349,15 @@ add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid
 
    lplot(NA, NA, xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, ...)
 
+   ### add PI bounds
+
+   if (pi)
+      lpolygon(c(c.vals,rev(c.vals)), c(t.vals.pi.lb,rev(t.vals.pi.ub)), col=picol, border=NA, ...)
+
    ### add CI bounds
 
-   if (ci) {
+   if (ci)
       lpolygon(c(c.vals,rev(c.vals)), c(t.vals.ci.lb,rev(t.vals.ci.ub)), col=cicol, border=NA, ...)
-      llines(c.vals, t.vals.ci.lb, lty=lty[3], ...)
-      llines(c.vals, t.vals.ci.ub, lty=lty[3], ...)
-   }
 
    ### add grid (and redraw box)
 
@@ -367,6 +379,38 @@ add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid
 
    lpoints(x=dat.c$yi.o, y=dat.t$yi.o, cex=psize.o, pch=pch.o, col=col.o, bg=bg.o, ...)
 
+   ### add legend
+
+   if (is.logical(legend) && isTRUE(legend))
+      lpos <- ifelse(intrcpt > 0, "bottomright", "topleft")
+
+   if (is.character(legend)) {
+      lpos <- legend
+      legend <- TRUE
+   }
+
+   if (legend) {
+
+      lvl <- round(100*(1-x$level), x$digits[["ci"]])
+      ltxt <- c("Reference Line of No Effect", "Line for the Estimated Effect",
+                paste0(lvl, "% Confidence Interval"), paste0(lvl, "% Prediction Interval"))
+      lpch <- c(NA,NA,22,22)
+      if (is.numeric(lty)) {
+         llty <- c(lty[1],lty[2],0,0)
+      } else {
+         llty <- c(lty[1],lty[2],"blank","blank")
+      }
+      lpt.bg <- c(NA,NA,cicol,picol)
+
+      sel <- c(lty != "blank" & lty != 0, ci, pi)
+
+      if (any(sel)) {
+         legend(lpos, inset=0.01, bg=.coladj(par("bg"), dark=0, light=0), pch=lpch[sel],
+                pt.cex=2.5, pt.lwd=0, pt.bg=lpt.bg[sel], lty=llty[sel], legend=ltxt[sel])
+      }
+
+   }
+
    #########################################################################
 
    ### prepare data frame to return

diff --git a/R/zzz.r b/R/zzz.r
@@ -1,6 +1,6 @@
 .onAttach <- function(libname, pkgname) {
 
-   ver <- "4.7-7"
+   ver <- "4.7-8"
 
    loadmsg <- paste0("\nLoading the 'metafor' package (version ", ver, "). For an\nintroduction to the package please type: help(metafor)\n")
 

diff --git a/README.md b/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.7--7-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
+[![devel Version](https://img.shields.io/badge/devel-4.7--8-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)
 

diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/ISSUE_TEMPLATE.html b/docs/ISSUE_TEMPLATE.html
diff --git a/docs/articles/index.html b/docs/articles/index.html
diff --git a/docs/articles/pkgdown/diagram.html b/docs/articles/pkgdown/diagram.html
diff --git a/docs/authors.html b/docs/authors.html
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/news/index.html b/docs/news/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -3,7 +3,7 @@ pkgdown: 2.0.8
 pkgdown_sha: ~
 articles:
   diagram: pkgdown/diagram.html
-last_built: 2024-04-17T21:56Z
+last_built: 2024-04-18T10:40Z
 urls:
   reference: https://wviechtb.github.io/metafor/reference
   article: https://wviechtb.github.io/metafor/articles

diff --git a/docs/reference/addpoly.default.html b/docs/reference/addpoly.default.html
diff --git a/docs/reference/addpoly.html b/docs/reference/addpoly.html
diff --git a/docs/reference/addpoly.predict.rma.html b/docs/reference/addpoly.predict.rma.html
diff --git a/docs/reference/addpoly.rma.html b/docs/reference/addpoly.rma.html
diff --git a/docs/reference/aggregate.escalc.html b/docs/reference/aggregate.escalc.html
diff --git a/docs/reference/anova.rma.html b/docs/reference/anova.rma.html
diff --git a/docs/reference/baujat.html b/docs/reference/baujat.html
diff --git a/docs/reference/bldiag.html b/docs/reference/bldiag.html
diff --git a/docs/reference/blsplit.html b/docs/reference/blsplit.html
diff --git a/docs/reference/blup.html b/docs/reference/blup.html
diff --git a/docs/reference/coef.permutest.rma.uni.html b/docs/reference/coef.permutest.rma.uni.html
diff --git a/docs/reference/coef.rma.html b/docs/reference/coef.rma.html
diff --git a/docs/reference/confint.rma.html b/docs/reference/confint.rma.html
diff --git a/docs/reference/contrmat.html b/docs/reference/contrmat.html
diff --git a/docs/reference/conv.2x2.html b/docs/reference/conv.2x2.html