Added 'var.names' argument to aggregate.escalc().

wviechtb · Aug 18, 2023 · d60d4dd · d60d4dd
1 parent 063bdad
commit d60d4dd
Show file tree

Hide file tree

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

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# metafor 4.3-11 (2023-08-16)
+# metafor 4.3-12 (2023-08-18)
 
 - added `getmfopt()` and `setmfopt()` functions for getting and setting package options and made some of the options more flexible
 
@@ -22,6 +22,8 @@
 
 - `vcalc()` gains a `sparse` argument
 
+- `aggregate.escalc` gains `var.names` argument
+
 - added a few more transformation functions
 
 - small bug fixes

diff --git a/R/aggregate.escalc.r b/R/aggregate.escalc.r
@@ -1,6 +1,6 @@
 aggregate.escalc <- function(x, cluster, time, obs, V, struct="CS", rho, phi,
                              weighted=TRUE, checkpd=TRUE, fun, na.rm=TRUE,
-                             addk=FALSE, subset, select, digits, ...) {
+                             addk=FALSE, subset, select, digits, var.names, ...) {
 
    mstyle <- .get.mstyle("crayon" %in% .packages())
 
@@ -44,27 +44,54 @@ aggregate.escalc <- function(x, cluster, time, obs, V, struct="CS", rho, phi,
 
    #########################################################################
 
-   ### get vi variable
+   if (missing(var.names)) {
+
+      if (!is.null(attr(x, "yi.names"))) { # if yi.names attributes is available
+         yi.name <- attr(x, "yi.names")[1] # take the first entry to be the yi variable
+      } else {                             # if not, see if 'yi' is in the object and assume that is the yi variable
+         if (!is.element("yi", names(x)))
+            stop(mstyle$stop("Cannot determine name of the 'yi' variable."))
+         yi.name <- "yi"
+      }
+
+      if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available
+         vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable
+      } else {                             # if not, see if 'vi' is in the object and assume that is the vi variable
+         if (!is.element("vi", names(x)))
+            stop(mstyle$stop("Cannot determine name of the 'vi' variable."))
+         vi.name <- "vi"
+      }
+
+   } else {
+
+      if (length(var.names) != 2L)
+         stop(mstyle$stop("Argument 'var.names' must be of length 2."))
+
+      yi.name <- var.names[1]
+      vi.name <- var.names[2]
 
-   if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available
-      vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable
-   } else {                             # if not, see if 'vi' is in the object and assume that is the vi variable
-      if (!is.element("vi", names(x)))
-         stop(mstyle$stop("Cannot determine name of the 'vi' variable."))
-      vi.name <- "vi"
    }
 
-   if (is.null(x[[vi.name]]))
+   yi <- as.vector(x[[yi.name]]) # as.vector() to strip attributes
+   vi <- x[[vi.name]]
+
+   if (is.null(yi))
+      stop(mstyle$stop(paste0("Cannot find variable '", yi.name, "' in the data frame.")))
+   if (is.null(vi))
       stop(mstyle$stop(paste0("Cannot find variable '", vi.name, "' in the data frame.")))
 
+   if (!is.numeric(yi))
+      stop(mstyle$stop(paste0("Variable '", yi.name, "' is not numeric.")))
+
+   if (!is.numeric(vi))
+      stop(mstyle$stop(paste0("Variable '", vi.name, "' is not numeric.")))
+
    #########################################################################
 
    if (is.null(V)) {
 
       ### if V is not specified
 
-      vi <- x[[vi.name]]
-
       ### construct V matrix based on the specified structure
 
       if (struct=="ID")
@@ -203,21 +230,6 @@ aggregate.escalc <- function(x, cluster, time, obs, V, struct="CS", rho, phi,
 
    }
 
-   if (!is.null(attr(x, "yi.names"))) { # if yi.names attributes is available
-      yi.name <- attr(x, "yi.names")[1] # take the first entry to be the yi variable
-   } else {                             # if not, see if 'yi' is in the object and assume that is the yi variable
-      if (!is.element("yi", names(x)))
-         stop(mstyle$stop("Cannot determine name of the 'yi' variable."))
-      yi.name <- "yi"
-   }
-
-   if (is.null(x[[yi.name]]))
-      stop(mstyle$stop(paste0("Cannot find variable '", yi.name, "' in the data frame.")))
-
-   ### note: there may be multiple yi/vi pairs; only first will be used
-
-   yi <- as.vector(x[[yi.name]])
-
    ### if 'subset' is not null, apply subset
 
    if (!is.null(subset)) {

diff --git a/R/conv.delta.r b/R/conv.delta.r
@@ -47,6 +47,7 @@ conv.delta <- function(yi, vi, ni, data, include, transf, var.names, append=TRUE
                stop(mstyle$stop("Cannot determine name of the 'yi' variable."))
             yi.name <- "yi"
          }
+
          if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available
             vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable
          } else {                             # if not, see if 'vi' is in the object and assume that is the vi variable

diff --git a/R/conv.wald.r b/R/conv.wald.r
@@ -55,6 +55,7 @@ conv.wald <- function(out, ci.lb, ci.ub, zval, pval, n, data, include,
                stop(mstyle$stop("Cannot determine name of the 'yi' variable."))
             yi.name <- "yi"
          }
+
          if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available
             vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable
          } else {                             # if not, see if 'vi' is in the object and assume that is the vi variable

diff --git a/R/methods.escalc.r b/R/methods.escalc.r
@@ -175,3 +175,38 @@ rbind.escalc <- function (..., deparse.level=1) {
 }
 
 ############################################################################
+
+#as.data.frame.escalc <- function(x, row.names=NULL, optional=FALSE, ...) {
+#
+#   ### strip measure, ni, and slab attributes from any yi elements
+#
+#   yi.names <- attr(x, "yi.names")
+#   yi.names <- yi.names[is.element(yi.names, names(x))]
+#
+#   for (l in seq_along(yi.names)) {
+#
+#      attr(x[[yi.names[l]]], "measure") <- NULL
+#      attr(x[[yi.names[l]]], "ni")      <- NULL
+#      attr(x[[yi.names[l]]], "slab")    <- NULL
+#
+#   }
+#
+#   ### strip other attributes that may be part of an 'escalc' object
+#
+#   attr(x, "digits")      <- NULL
+#
+#   attr(x, "yi.names")    <- NULL
+#   attr(x, "vi.names")    <- NULL
+#   attr(x, "sei.names")   <- NULL
+#   attr(x, "zi.names")    <- NULL
+#   attr(x, "pval.names")  <- NULL
+#   attr(x, "ci.lb.names") <- NULL
+#   attr(x, "ci.ub.names") <- NULL
+#
+#   class(x) <- "data.frame"
+#
+#   return(x)
+#
+#}
+
+############################################################################
diff --git a/R/rma.uni.r b/R/rma.uni.r
@@ -224,6 +224,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                stop(mstyle$stop("Cannot determine name of the 'yi' variable."))
             yi.name <- "yi"
          }
+
          if (!is.null(attr(yi, "vi.names"))) { # if vi.names attributes is available
             vi.name <- attr(yi, "vi.names")[1] # take the first entry to be the vi variable
          } else {                              # if not, see if 'vi' is in the object and assume that is the vi variable

diff --git a/R/summary.escalc.r b/R/summary.escalc.r
@@ -35,6 +35,7 @@ H0=0, append=TRUE, replace=TRUE, level=95, olim, digits, transf, ...) {
             stop(mstyle$stop("Cannot determine name of the 'yi' variable."))
          yi.name <- "yi"
       }
+
       if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available
          vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable
       } else {                             # if not, see if 'vi' is in the object and assume that is the vi variable

diff --git a/R/zzz.r b/R/zzz.r
@@ -1,6 +1,6 @@
 .onAttach <- function(libname, pkgname) {
 
-   ver <- "4.3-11"
+   ver <- "4.3-12"
 
    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.3--11-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
+[![devel Version](https://img.shields.io/badge/devel-4.3--12-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-08-16T15:07Z
+last_built: 2023-08-18T14:42Z
 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