Avoid transparent legend in funnel().

wviechtb · Aug 28, 2023 · cad690b · cad690b
1 parent d60d4dd
commit cad690b
Show file tree

Hide file tree

Showing 13 changed files with 44 additions and 28 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: metafor
 Version: 4.3-12
-Date: 2023-08-18
+Date: 2023-08-28
 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"))
 Depends: R (>= 4.0.0), methods, Matrix, metadat, numDeriv

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# metafor 4.3-12 (2023-08-18)
+# metafor 4.3-12 (2023-08-28)
 
 - added `getmfopt()` and `setmfopt()` functions for getting and setting package options and made some of the options more flexible
 

diff --git a/R/funnel.default.r b/R/funnel.default.r
@@ -204,15 +204,15 @@ label=FALSE, offset=0.4, legend=FALSE, ...) {
    if (!is.null(ddd$transf))
       warning("Function does not have a 'transf' argument (use 'atransf' instead).", call.=FALSE, immediate.=TRUE)
 
-   lplot     <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) plot(...)
-   labline   <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) abline(...)
-   lsegments <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) segments(...)
-   laxis     <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) axis(...)
-   lpolygon  <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) polygon(...)
-   llines    <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) lines(...)
-   lpoints   <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) points(...)
-   lrect     <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) rect(...)
-   ltext     <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) text(...)
+   lplot     <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) plot(...)
+   labline   <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) abline(...)
+   lsegments <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) segments(...)
+   laxis     <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) axis(...)
+   lpolygon  <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) polygon(...)
+   llines    <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) lines(...)
+   lpoints   <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) points(...)
+   lrect     <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) rect(...)
+   ltext     <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) text(...)
 
    ### refline2, level2, and lty2 for adding a second reference line / funnel
 
@@ -262,6 +262,13 @@ label=FALSE, offset=0.4, legend=FALSE, ...) {
       colbox <- .coladj(par("bg","fg"), dark=0.6, light=-0.6)
    }
 
+   if (!is.null(ddd$lgndbg)) {
+      lgndbg <- ddd$lgndbg
+   } else {
+      #lgndbg <- par("bg")
+      lgndbg <- .coladj(par("bg","fg"), dark=0.01, light=-0.01) # need to adjust slightly to avoid a transparent background
+   }
+
    #########################################################################
 
    ### if a subset of studies is specified
@@ -702,7 +709,7 @@ label=FALSE, offset=0.4, legend=FALSE, ...) {
          pt.bg  <- c(pt.bg, bg[1])
       }
 
-      legend(lpos, inset=.01, bg=par("bg"), pch=pch.l, col=col.l, pt.cex=pt.cex, pt.bg=pt.bg, legend=ltxt)
+      legend(lpos, inset=.01, bg=lgndbg, pch=pch.l, col=col.l, pt.cex=pt.cex, pt.bg=pt.bg, legend=ltxt)
       #legend(lpos, inset=.01, bg=.coladj(par("bg","fg"), dark=0.05, light=-0.05), pch=pch.l, col=col.l, pt.cex=pt.cex, pt.bg=pt.bg, legend=ltxt)
 
    }

diff --git a/R/funnel.rma.r b/R/funnel.rma.r
@@ -34,6 +34,8 @@ label=FALSE, offset=0.4, legend=FALSE, ...) {
    if (missing(hlines))
       hlines <- par("bg")
 
+   #print(c(back=back, shade=shade, hlines=hlines))
+
    if (missing(pch)) {
       pch <- 19
    } else {
@@ -203,15 +205,15 @@ label=FALSE, offset=0.4, legend=FALSE, ...) {
    if (!is.null(ddd$transf))
       warning("Function does not have a 'transf' argument (use 'atransf' instead).", call.=FALSE, immediate.=TRUE)
 
-   lplot     <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) plot(...)
-   labline   <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) abline(...)
-   lsegments <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) segments(...)
-   laxis     <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) axis(...)
-   lpolygon  <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) polygon(...)
-   llines    <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) lines(...)
-   lpoints   <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) points(...)
-   lrect     <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) rect(...)
-   ltext     <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) text(...)
+   lplot     <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) plot(...)
+   labline   <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) abline(...)
+   lsegments <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) segments(...)
+   laxis     <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) axis(...)
+   lpolygon  <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) polygon(...)
+   llines    <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) lines(...)
+   lpoints   <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) points(...)
+   lrect     <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) rect(...)
+   ltext     <- function(..., refline2, level2, lty2, colci, colref, colbox, lgndbg, transf, ci.res) text(...)
 
    ### refline2, level2, and lty2 for adding a second reference line / funnel
 
@@ -261,6 +263,13 @@ label=FALSE, offset=0.4, legend=FALSE, ...) {
       colbox <- .coladj(par("bg","fg"), dark=0.6, light=-0.6)
    }
 
+   if (!is.null(ddd$lgndbg)) {
+      lgndbg <- ddd$lgndbg
+   } else {
+      #lgndbg <- par("bg")
+      lgndbg <- .coladj(par("bg","fg"), dark=0.01, light=-0.01) # need to adjust slightly to avoid a transparent background
+   }
+
    #########################################################################
 
    ### get values for the x-axis (and corresponding vi, sei, and ni values)
@@ -755,7 +764,7 @@ label=FALSE, offset=0.4, legend=FALSE, ...) {
          pt.bg  <- c(pt.bg, bg[2])
       }
 
-      legend(lpos, inset=.01, bg=par("bg"), pch=pch.l, col=col.l, pt.cex=pt.cex, pt.bg=pt.bg, legend=ltxt)
+      legend(lpos, inset=.01, bg=lgndbg, pch=pch.l, col=col.l, pt.cex=pt.cex, pt.bg=pt.bg, legend=ltxt)
       #legend(lpos, inset=.01, bg=.coladj(par("bg","fg"), dark=0.05, light=-0.05), pch=pch.l, col=col.l, pt.cex=pt.cex, pt.bg=pt.bg, legend=ltxt)
 
    }

diff --git a/R/plot.profile.rma.r b/R/plot.profile.rma.r
@@ -22,7 +22,7 @@ plot.profile.rma <- function(x, xlim, ylim, pch=19, xlab, ylab, main, refline=TR
    ### filter out some arguments for the plot() function
 
    lplot   <- function(..., time, LB, startmethod, sub1) plot(...)
-   lpoints <- function(..., time, LB, startmethod, sub1, log) points(...)
+   lpoints <- function(..., time, LB, startmethod, sub1, log) points(...) # need 'log' here so profile(res, log="x") doesn't throw a warning
 
    #########################################################################
 

diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -3,7 +3,7 @@ pkgdown: 2.0.7
 pkgdown_sha: ~
 articles:
   diagram: pkgdown/diagram.html
-last_built: 2023-08-18T14:42Z
+last_built: 2023-08-28T13:11Z
 urls:
   reference: https://wviechtb.github.io/metafor/reference
   article: https://wviechtb.github.io/metafor/articles

diff --git a/docs/reference/Rplot002.png b/docs/reference/Rplot002.png
diff --git a/docs/reference/formula.rma.html b/docs/reference/formula.rma.html
diff --git a/docs/reference/funnel-5.png b/docs/reference/funnel-5.png
diff --git a/docs/reference/funnel-6.png b/docs/reference/funnel-6.png
diff --git a/docs/reference/reporter.html b/docs/reference/reporter.html
diff --git a/docs/reference/trimfill-1.png b/docs/reference/trimfill-1.png
diff --git a/docs/reference/trimfill-2.png b/docs/reference/trimfill-2.png