Added measures 'CLES/AUC' and 'CLESN/AUCN'.

wviechtb · Oct 15, 2024 · 5a17b06 · 5a17b06
1 parent 4c8d18a
commit 5a17b06
Show file tree

Hide file tree

Showing 127 changed files with 643 additions and 219 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: metafor
-Version: 4.7-34
-Date: 2024-09-30
+Version: 4.7-35
+Date: 2024-10-15
 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/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# metafor 4.7-34 (2024-09-30)
+# metafor 4.7-35 (2024-10-15)
 
 - some general changes to the various `forest()` functions: argument `header` is now `TRUE` by default, the y-axis is now created with `yaxs="i"`, and the y-axis limits have been tweaked slightly in accordance
 
@@ -36,7 +36,7 @@
 
 - `nobs()` now just returns the number of estimates, not the effective number of observations
 
-- added measure `"PRZ"` to `escalc()`
+- added measures `"PRZ"`, `"CLES"`, `"AUC"`, `"CLESN"`, and `"AUCN"`  to `escalc()`
 
 - `escalc()` gains a `flip` argument
 
@@ -46,6 +46,8 @@
 
 - added transformation function `transf.dtoovl()` (for transforming standardized mean differences to overlapping coefficient values) and ``transf.dtocliffd()` (for transforming standardized mean differences to Cliff's delta values)
 
+- `escalc()` gains a `correct` argument (to specify whether a bias correction should be applied)
+
 - better handling of `outlist="minimal"`
 
 - added more tests

diff --git a/R/escalc.r b/R/escalc.r
diff --git a/R/misc.func.hidden.r b/R/misc.func.hidden.r
@@ -1192,7 +1192,15 @@
          }
       }
       ######################################################################
-      if (measure == "AUC") {
+      if (is.element(measure, c("CLES","CLESN"))) {
+         if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) {
+            lab <- ifelse(short, "CLES", "Common Language Effect Size")
+         } else {
+            lab <- ifelse(short, lab, "Transformed Common Language Effect Size")
+         }
+      }
+      ######################################################################
+      if (is.element(measure, c("AUC","AUCN"))) {
          if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) {
             lab <- ifelse(short, "AUC", "Area under the Curve")
          } else {

diff --git a/R/rma.glmm.r b/R/rma.glmm.r
@@ -184,7 +184,7 @@ test="z", level=95, btt, nAGQ=7, verbose=FALSE, digits, control, ...) {
          di <- .getsubset(di, subset)
       }
 
-      args <- list(measure=measure, ai=ai, bi=bi, ci=ci, di=di, add=add, to=to, drop00=drop00, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
+      args <- list(ai=ai, bi=bi, ci=ci, di=di, add=add, to=to, drop00=drop00, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
 
    }
 
@@ -206,7 +206,7 @@ test="z", level=95, btt, nAGQ=7, verbose=FALSE, digits, control, ...) {
          t2i <- .getsubset(t2i, subset)
       }
 
-      args <- list(measure=measure, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, add=add, to=to, drop00=drop00, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
+      args <- list(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, add=add, to=to, drop00=drop00, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
 
    }
 
@@ -227,7 +227,7 @@ test="z", level=95, btt, nAGQ=7, verbose=FALSE, digits, control, ...) {
          mi <- .getsubset(mi, subset)
       }
 
-      args <- list(measure=measure, xi=xi, mi=mi, add=add, to=to, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
+      args <- list(xi=xi, mi=mi, add=add, to=to, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
 
    }
 
@@ -245,10 +245,12 @@ test="z", level=95, btt, nAGQ=7, verbose=FALSE, digits, control, ...) {
          ti <- .getsubset(ti, subset)
       }
 
-      args <- list(measure=measure, xi=xi, ti=ti, add=add, to=to, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
+      args <- list(xi=xi, ti=ti, add=add, to=to, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
 
    }
 
+   args <- c(args, list(measure=measure, vtype=vtype))
+
    dat <- .do.call(escalc, args)
 
    yi <- dat$yi         # one or more yi/vi pairs may be NA/NA (note: yi/vi pairs that are NA/NA may still have 'valid' table data)

diff --git a/R/rma.uni.r b/R/rma.uni.r
@@ -29,7 +29,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                               "MN","SMN","MNLN","CVLN","SDLN",                                   # mean, single-group standardized mean, log(mean), log(CV), log(SD),
                               "MC","SMCC","SMCR","SMCRH","SMCRP","SMCRPH","ROMC","CVRC","VRC",   # raw/standardized mean change, log(ROM), CVR, and VR for dependent samples
                               "ARAW","AHW","ABT",                                                # alpha (and transformations thereof)
-                              "REH",#"AUC",                                                       # relative excess heterozygosity, area under the curve
+                              "REH","CLES","CLESN","AUC","AUCN",                                 # relative excess heterozygosity, common language effect size / area under the curve
                               "HR","HD",                                                         # hazard (rate) ratios and differences
                               "GEN")))
       stop(mstyle$stop("Unknown 'measure' specified."))
@@ -63,7 +63,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
 
    ddd <- list(...)
 
-   .chkdots(ddd, c("knha", "onlyo1", "addyi", "addvi", "i2def", "r2def", "skipr2", "abbrev", "dfs", "time", "outlist", "link", "optbeta", "alpha", "beta", "skiphes", "retopt", "pleasedonotreportI2thankyouverymuch"))
+   .chkdots(ddd, c("knha", "onlyo1", "addyi", "addvi", "correct", "i2def", "r2def", "skipr2", "abbrev", "dfs", "time", "outlist", "link", "optbeta", "alpha", "beta", "skiphes", "retopt", "pleasedonotreportI2thankyouverymuch"))
 
    ### handle 'knha' argument from ... (note: overrides test argument)
 
@@ -86,11 +86,12 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
       model <- "rma.ls"
    }
 
-   ### set defaults or get onlyo1, addyi, and addvi arguments
+   ### set defaults or get onlyo1, addyi, addvi, and correct arguments
 
-   onlyo1 <- .chkddd(ddd$onlyo1, FALSE)
-   addyi  <- .chkddd(ddd$addyi,  TRUE)
-   addvi  <- .chkddd(ddd$addvi,  TRUE)
+   onlyo1  <- .chkddd(ddd$onlyo1,  FALSE)
+   addyi   <- .chkddd(ddd$addyi,   TRUE)
+   addvi   <- .chkddd(ddd$addvi,   TRUE)
+   correct <- .chkddd(ddd$correct, TRUE)
 
    ### set defaults for i2def and r2def
 
@@ -420,7 +421,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             pi <- .getsubset(pi, subset)
          }
 
-         args <- list(measure=measure, ai=ai, bi=bi, ci=ci, di=di, ri=ri, pi=pi, add=add, to=to, drop00=drop00, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
+         args <- list(ai=ai, bi=bi, ci=ci, di=di, ri=ri, pi=pi, add=add, to=to, drop00=drop00, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
 
       }
 
@@ -442,7 +443,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             t2i <- .getsubset(t2i, subset)
          }
 
-         args <- list(measure=measure, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, add=add, to=to, drop00=drop00, vtype=vtype, addyi=addyi, addvi=addvi)
+         args <- list(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, add=add, to=to, drop00=drop00, addyi=addyi, addvi=addvi)
 
       }
 
@@ -486,7 +487,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             n2i  <- .getsubset(n2i,  subset)
          }
 
-         args <- list(measure=measure, m1i=m1i, m2i=m2i, sd1i=sd1i, sd2i=sd2i, n1i=n1i, n2i=n2i, vtype=vtype)
+         args <- list(m1i=m1i, m2i=m2i, sd1i=sd1i, sd2i=sd2i, n1i=n1i, n2i=n2i)
 
       }
 
@@ -512,7 +513,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             ni <- .getsubset(ni, subset)
          }
 
-         args <- list(measure=measure, ri=ri, ni=ni, vtype=vtype)
+         args <- list(ri=ri, ni=ni)
 
       }
 
@@ -547,7 +548,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             r2i <- .getsubset(r2i, subset)
          }
 
-         args <- list(measure=measure, ri=ri, mi=mi, ni=ni, r2i=r2i, vtype=vtype)
+         args <- list(ri=ri, mi=mi, ni=ni, r2i=r2i)
 
       }
 
@@ -575,7 +576,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             ni  <- .getsubset(ni,  subset)
          }
 
-         args <- list(measure=measure, r2i=r2i, mi=mi, ni=ni, vtype=vtype)
+         args <- list(r2i=r2i, mi=mi, ni=ni)
 
       }
 
@@ -596,7 +597,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             mi <- .getsubset(mi, subset)
          }
 
-         args <- list(measure=measure, xi=xi, mi=mi, add=add, to=to, vtype=vtype, addyi=addyi, addvi=addvi)
+         args <- list(xi=xi, mi=mi, add=add, to=to, addyi=addyi, addvi=addvi)
 
       }
 
@@ -614,7 +615,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             ti <- .getsubset(ti, subset)
          }
 
-         args <- list(measure=measure, xi=xi, ti=ti, add=add, to=to, vtype=vtype, addyi=addyi, addvi=addvi)
+         args <- list(xi=xi, ti=ti, add=add, to=to, addyi=addyi, addvi=addvi)
 
       }
 
@@ -634,7 +635,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             ni  <- .getsubset(ni,  subset)
          }
 
-         args <- list(measure=measure, mi=mi, sdi=sdi, ni=ni, vtype=vtype)
+         args <- list(mi=mi, sdi=sdi, ni=ni)
 
       }
 
@@ -681,7 +682,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             ri   <- .getsubset(ri,   subset)
          }
 
-         args <- list(measure=measure, m1i=m1i, m2i=m2i, sd1i=sd1i, sd2i=sd2i, ri=ri, ni=ni, vtype=vtype)
+         args <- list(m1i=m1i, m2i=m2i, sd1i=sd1i, sd2i=sd2i, ri=ri, ni=ni)
 
       }
 
@@ -701,7 +702,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             ni <- .getsubset(ni, subset)
          }
 
-         args <- list(measure=measure, ai=ai, mi=mi, ni=ni, vtype=vtype)
+         args <- list(ai=ai, mi=mi, ni=ni)
 
       }
 
@@ -721,15 +722,21 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             ci <- .getsubset(ci, subset)
          }
 
-         args <- list(measure=measure, ai=ai, bi=bi, ci=ci, vtype=vtype)
+         args <- list(ai=ai, bi=bi, ci=ci)
 
       }
 
-      if (measure == "AUC") {
+      if (is.element(measure, c("CLES","AUC"))) {
 
          ai  <- .getx("ai",  mf=mf, data=data, checknumeric=TRUE)
          n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE)
          n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE)
+         mi  <- .getx("mi",  mf=mf, data=data, checknumeric=TRUE)
+
+         if (is.null(mi))
+            mi <- rep(0, length(ai))
+
+         mi[is.na(mi)] <- 0
 
          k <- length(ai) # number of outcomes before subsetting
          k.all <- k
@@ -739,12 +746,79 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
             ai  <- .getsubset(ai,  subset)
             n1i <- .getsubset(n1i, subset)
             n2i <- .getsubset(n2i, subset)
+            mi  <- .getsubset(mi,  subset)
          }
 
-         args <- list(measure=measure, ai=ai, n1i=n1i, n2i=n2i, vtype=vtype)
+         args <- list(ai=ai, n1i=n1i, n2i=n2i, mi=mi)
 
       }
 
+      if (is.element(measure, c("CLESN","AUCN"))) {
+
+         m1i  <- .getx("m1i",  mf=mf, data=data, checknumeric=TRUE)
+         m2i  <- .getx("m2i",  mf=mf, data=data, checknumeric=TRUE)
+         sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE)
+         sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE)
+         n1i  <- .getx("n1i",  mf=mf, data=data, checknumeric=TRUE)
+         n2i  <- .getx("n2i",  mf=mf, data=data, checknumeric=TRUE)
+         di   <- .getx("di",   mf=mf, data=data, checknumeric=TRUE)
+         ti   <- .getx("ti",   mf=mf, data=data, checknumeric=TRUE)
+         pi   <- .getx("pi",   mf=mf, data=data, checknumeric=TRUE)
+         ai   <- .getx("ai",   mf=mf, data=data, checknumeric=TRUE)
+
+         if (!.equal.length(m1i, m2i, sd1i, sd2i, n1i, n2i, di, ti, pi, ai))
+            stop(mstyle$stop("Supplied data vectors are not all of the same length."))
+
+         if (!.all.specified(n1i, n2i))
+            stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n  via the appropriate arguments."))
+
+         k.all <- max(sapply(list(m1i, m2i, sd1i, sd2i, n1i, n2i, di, ti, pi, ai), length))
+
+         vtype <- .expand1(vtype, k.all)
+
+         if (is.null(sd1i) || is.null(sd2i)) {
+            sd1i <- .expand1(NA_real_, k.all)
+            sd2i <- .expand1(NA_real_, k.all)
+         }
+
+         ti <- replmiss(ti, .convp2t(pi, df=n1i+n2i-2))
+         di <- replmiss(di, ti * sqrt(1/n1i + 1/n2i))
+
+         if (!is.null(di))
+            vtype[!is.na(di)] <- "HO"
+
+         sdpi <- ifelse(vtype=="HO", sqrt(((n1i-1)*sd1i^2 + (n2i-1)*sd2i^2)/(n1i+n2i-2)), sqrt((sd1i^2 + sd2i^2)/2))
+         di   <- replmiss(di, (m1i - m2i) / sdpi)
+
+         ai <- replmiss(ai, pnorm(di/sqrt(2)))
+         di <- replmiss(di, qnorm(ai)*sqrt(2))
+
+         k.all <- length(ai)
+
+         sdsmiss <- is.na(sd1i) | is.na(sd2i)
+         sd1i <- ifelse(sdsmiss, 1, sd1i)
+         sd2i <- ifelse(sdsmiss, 1, sd2i)
+         vtype[sdsmiss] <- "HO"
+
+         k <- length(ai) # number of outcomes before subsetting
+         k.all <- k
+
+         if (!is.null(subset)) {
+            subset <- .chksubset(subset, k)
+            vtype  <- .getsubset(vtype,  subset)
+            ai   <- .getsubset(ai,   subset)
+            sd1i <- .getsubset(sd1i, subset)
+            sd2i <- .getsubset(sd2i, subset)
+            n1i  <- .getsubset(n1i,  subset)
+            n2i  <- .getsubset(n2i,  subset)
+         }
+
+         args <- list(ai=ai, sd1i=sd1i, sd2i=sd2i, n1i=n1i, n2i=n2i)
+
+      }
+
+      args <- c(args, list(measure=measure, vtype=vtype, correct=correct))
+
       dat <- .do.call(escalc, args)
 
       if (is.element(measure, "GEN"))

diff --git a/R/transf.r b/R/transf.r
@@ -339,7 +339,7 @@ transf.dtorbis <- function(xi, n1i, n2i) {
    }
    rpbi <- xi / sqrt(xi^2 + hi)
    pi <- n1i / (n1i + n2i)
-   return(sqrt(pi*(1-pi)) / dnorm(pnorm(pi)) * rpbi)
+   return(sqrt(pi*(1-pi)) / dnorm(qnorm(pi)) * rpbi)
 }
 
 transf.rpbtorbis <- function(xi, pi) {

diff --git a/R/zzz.r b/R/zzz.r
@@ -1,6 +1,6 @@
 .onAttach <- function(libname, pkgname) {
 
-   ver <- "4.7-34"
+   ver <- "4.7-35"
 
    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--34-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
+[![devel Version](https://img.shields.io/badge/devel-4.7--35-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