Added '$<-.escalc' method.

wviechtb · May 8, 2023 · 151efa2 · 151efa2
1 parent e06231f
commit 151efa2
Show file tree

Hide file tree

Showing 120 changed files with 204 additions and 195 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: metafor
-Version: 4.1-15
-Date: 2023-05-06
+Version: 4.1-16
+Date: 2023-05-08
 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"))
 Depends: R (>= 4.0.0), methods, Matrix, metadat, numDeriv

diff --git a/NAMESPACE b/NAMESPACE
@@ -15,7 +15,7 @@ import(numDeriv)
 S3method("[", list.rma)
 S3method("$<-", list.rma)
 S3method("[", escalc)
-#S3method("$<-", escalc)
+S3method("$<-", escalc)
 S3method(addpoly, default)
 S3method(addpoly, predict.rma)
 S3method(addpoly, rma)

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# metafor 4.1-15 (2023-05-06)
+# metafor 4.1-16 (2023-05-08)
 
 - improved the various plotting functions so they respect `par("fg")`; as a result, one can now create plots with a dark background and light plotting colors
 

diff --git a/R/escalc.r b/R/escalc.r
diff --git a/R/methods.escalc.r b/R/methods.escalc.r
@@ -16,23 +16,24 @@
 
    dat <- NextMethod("[")
 
-   ### add measure attribute back to each yi variable (if that variable is still part of dat)
+   ### find all 'yi' variables that are still part of the dataset
 
    yi.names <- attr(x, "yi.names")
    yi.names <- yi.names[is.element(yi.names, names(dat))]
 
    for (l in seq_along(yi.names)) {
 
-      #eval(str2lang(paste0("attr(dat$", yi.names[l], ", 'measure') <- attr(x$", yi.names[l], ", 'measure')")))
-      attr(dat[[yi.names[l]]], "measure") <- attr(x[[yi.names[l]]], "measure")
-
-      ### if selecting rows, also subset ni and slab attributes and add them back to each yi variable
+      ### if selecting rows, subset ni and slab attributes accordingly and add them back to each yi variable
 
       if (!missing(i) && nargs()-has.drop > 2L) {
          attr(dat[[yi.names[l]]], "ni")   <- attr(x[[yi.names[l]]], "ni")[i]
          attr(dat[[yi.names[l]]], "slab") <- attr(x[[yi.names[l]]], "slab")[i]
       }
 
+      ### add measure attribute back to each yi variable
+
+      attr(dat[[yi.names[l]]], "measure") <- attr(x[[yi.names[l]]], "measure")
+
    }
 
    ### add var.names and out.names attributes back to object (but only if they exist and only keep variables still in the dataset)
@@ -53,23 +54,26 @@
 
 }
 
-#"$<-.escalc" <- function(x, name, value) {
-#
-#   dat <- NextMethod("$<-")
-#
-#   all.names <- c("yi.names", "vi.names", "sei.names", "zi.names", "pval.names", "ci.lb.names", "ci.ub.names")
-#
-#   for (l in seq_along(all.names)) {
-#      if (!is.null(attr(dat, all.names[l]))) {
-#         attr(dat, all.names[l]) <- attr(dat, all.names[l])[is.element(attr(dat, all.names[l]), names(dat))]
-#         if (length(attr(dat, all.names[l])) == 0L)
-#            attr(dat, all.names[l]) <- NULL
-#      }
-#   }
-#
-#   return(dat)
-#
-#}
+"$<-.escalc" <- function(x, name, value) {
+
+   dat <- NextMethod("$<-")
+
+   ### for each attribute, only keep elements that are still part of the data frame (and remove empty attributes)
+   ### (this is relevant when 'value' is NULL, so when a particular variable is getting removed)
+
+   all.names <- c("yi.names", "vi.names", "sei.names", "zi.names", "pval.names", "ci.lb.names", "ci.ub.names")
+
+   for (l in seq_along(all.names)) {
+      if (!is.null(attr(dat, all.names[l]))) {
+         attr(dat, all.names[l]) <- attr(dat, all.names[l])[is.element(attr(dat, all.names[l]), names(dat))]
+         if (length(attr(dat, all.names[l])) == 0L)
+            attr(dat, all.names[l]) <- NULL
+      }
+   }
+
+   return(dat)
+
+}
 
 ############################################################################
 
@@ -110,6 +114,7 @@ cbind.escalc <- function (..., deparse.level=1) {
    attr(dat, "ci.ub.names") <- unique(ci.ub.names)
 
    ### add 'digits' attribute back (use the values from first element)
+
    attr(dat, "digits") <- attr(arg[1], "digits")
 
    class(dat) <- c("escalc", "data.frame")

diff --git a/R/zzz.r b/R/zzz.r
@@ -1,6 +1,6 @@
 .onAttach <- function(libname, pkgname) {
 
-   ver <- "4.1-15"
+   ver <- "4.1-16"
 
    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.1--15-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
+[![devel Version](https://img.shields.io/badge/devel-4.1--16-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.7
 pkgdown_sha: ~
 articles:
   diagram: pkgdown/diagram.html
-last_built: 2023-05-06T11:28Z
+last_built: 2023-05-08T06:44Z
 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
diff --git a/docs/reference/conv.delta.html b/docs/reference/conv.delta.html
diff --git a/docs/reference/conv.fivenum.html b/docs/reference/conv.fivenum.html
diff --git a/docs/reference/conv.wald.html b/docs/reference/conv.wald.html
diff --git a/docs/reference/cumul.html b/docs/reference/cumul.html
diff --git a/docs/reference/dfround.html b/docs/reference/dfround.html