Added measure PRZ.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: metafor
-Version: 4.7-26
-Date: 2024-08-25
+Version: 4.7-27
+Date: 2024-08-29
 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

NEWS.md

@@ -1,4 +1,4 @@
-# metafor 4.7-26 (2024-08-25)
+# metafor 4.7-27 (2024-08-29)
 
 - 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,6 +36,8 @@
 
 - `nobs()` now just returns the number of estimates, not the effective number of observations
 
+- added measures `"PRZ"` to `escalc()`
+
 - `escalc()` gains a `flip` argument
 
 - fixed `predict()` ignoring the `level` argument for `robust.rma` objects obtained with `clubSandwich=TRUE`

R/emmprep.r

@@ -125,6 +125,11 @@ emmprep <- function(x, verbose=FALSE, ...) {
          if (verbose) cat("Transformation:     logit\n")
       }
 
+      if (is.element(x$measure, c("PRZ"))) {
+         out@misc$tran <- "probit"
+         if (verbose) cat("Transformation:     probit\n")
+      }
+
       if (is.element(x$measure, c("PAS"))) {
          out <- update(out, emmeans::make.tran("asin.sqrt", 1))
          if (verbose) cat("Transformation:     asin.sqrt\n")

R/escalc.r

@@ -24,7 +24,7 @@ data, slab, flip, subset, include, add=1/2, to="only0", drop00=FALSE, vtype="LS"
                               "COR","UCOR","ZCOR",                                               # correlations (raw and r-to-z transformed)
                               "PCOR","ZPCOR","SPCOR","ZSPCOR",                                   # partial and semi-partial correlations
                               "R2","ZR2",                                                        # coefficient of determination / R^2 (raw and r-to-z transformed)
-                              "PR","PLN","PLO","PAS","PFT",                                      # single proportions (and transformations thereof)
+                              "PR","PLN","PLO","PAS","PFT","PRZ",                                # single proportions (and transformations thereof)
                               "IR","IRLN","IRS","IRFT",                                          # single-group person-time (incidence) data (and transformations thereof)
                               "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
@@ -1445,7 +1445,7 @@ data, slab, flip, subset, include, add=1/2, to="only0", drop00=FALSE, vtype="LS"
 
       ######################################################################
 
-      if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) {
+      if (is.element(measure, c("PR","PLN","PLO","PRZ","PAS","PFT"))) {
 
          xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE)
          mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE)
@@ -1695,6 +1695,13 @@ data, slab, flip, subset, include, add=1/2, to="only0", drop00=FALSE, vtype="LS"
 
          ### note: addyi and addvi only implemented for measures above
 
+         ### proportion with probit transformation
+
+         if (measure == "PRZ") {
+            yi <- qnorm(pri)
+            vi <- 2*base::pi*pri*(1-pri)*exp(yi^2)/ni
+         }
+
          ### proportion with arcsine square root (angular) transformation
 
          if (measure == "PAS") {

R/misc.func.hidden.r

@@ -966,6 +966,18 @@
                lab <- ifelse(short, "Odds", "Odds")
          }
       }
+      if (measure == "PRZ") {
+         if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) {
+            lab <- ifelse(short, expression(Phi^{-1}*(p)), "Probit Transformed Proportion") # expression(z[p])
+         } else {
+            lab <- ifelse(short, lab, "Transformed Probit Transformed Proportion")
+            funlist <- lapply(list(pnorm), deparse)
+            if (any(sapply(funlist, identical, atransf.char)))
+               lab <- ifelse(short, "Proportion", "Proportion (probit scale)")
+            if (any(sapply(funlist, identical, transf.char)))
+               lab <- ifelse(short, "Proportion", "Proportion")
+         }
+      }
       if (measure == "PAS") {
          if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) {
             lab <- ifelse(short, expression(arcsin(sqrt(p))), "Arcsine Transformed Proportion")

R/rma.uni.r

@@ -24,7 +24,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
                               "COR","UCOR","ZCOR",                                               # correlations (raw and r-to-z transformed)
                               "PCOR","ZPCOR","SPCOR","ZSPCOR",                                   # partial and semi-partial correlations
                               "R2","ZR2",                                                        # coefficient of determination / R^2 (raw and r-to-z transformed)
-                              "PR","PLN","PLO","PAS","PFT",                                      # single proportions (and transformations thereof)
+                              "PR","PLN","PLO","PRZ","PAS","PFT",                                # single proportions (and transformations thereof)
                               "IR","IRLN","IRS","IRFT",                                          # single-group person-time (incidence) data (and transformations thereof)
                               "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
@@ -579,7 +579,7 @@ test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) {
 
       }
 
-      if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) {
+      if (is.element(measure, c("PR","PLN","PLO","PRZ","PAS","PFT"))) {
 
          xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE)
          mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE)

R/to.long.r

@@ -21,7 +21,7 @@ data, slab, subset, add=1/2, to="none", drop00=FALSE, vlong=FALSE, append=TRUE,
                               "COR","UCOR","ZCOR",                                 # correlations (raw and r-to-z transformed)
                               "PCOR","ZPCOR","SPCOR",                              # partial and semi-partial correlations
                               "R2","ZR2",                                          # coefficient of determination (raw and r-to-z transformed)
-                              "PR","PLN","PLO","PAS","PFT",                        # single proportions (and transformations thereof)
+                              "PR","PLN","PLO","PRZ","PAS","PFT",                  # single proportions (and transformations thereof)
                               "IR","IRLN","IRS","IRFT",                            # single-group person-time data (and transformations thereof)
                               "MN","SMN","MNLN","CVLN","SDLN",                     # mean, single-group standardized mean, log(mean), log(CV), log(SD),
                               "MC","SMCC","SMCR","SMCRH","ROMC","CVRC","VRC",      # raw/standardized mean change, log(ROM), CVR, and VR for dependent samples
@@ -352,7 +352,7 @@ data, slab, subset, add=1/2, to="none", drop00=FALSE, vlong=FALSE, append=TRUE,
 
    #########################################################################
 
-   if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) {
+   if (is.element(measure, c("PR","PLN","PLO","PRZ","PAS","PFT"))) {
 
       xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE)
       mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE)
@@ -1113,7 +1113,7 @@ data, slab, subset, add=1/2, to="none", drop00=FALSE, vlong=FALSE, append=TRUE,
 
    #########################################################################
 
-   if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) {
+   if (is.element(measure, c("PR","PLN","PLO","PRZ","PAS","PFT"))) {
 
       ### check for NAs in table data and act accordingly
 

R/to.table.r

@@ -21,7 +21,7 @@ data, slab, subset, add=1/2, to="none", drop00=FALSE, rows, cols) {
                               "COR","UCOR","ZCOR",                                 # correlations (raw and r-to-z transformed)
                               "PCOR","ZPCOR","SPCOR",                              # partial and semi-partial correlations
                               "R2","ZR2",                                          # coefficient of determination (raw and r-to-z transformed)
-                              "PR","PLN","PLO","PAS","PFT",                        # single proportions (and transformations thereof)
+                              "PR","PLN","PLO","PRZ","PAS","PFT",                  # single proportions (and transformations thereof)
                               "IR","IRLN","IRS","IRFT",                            # single-group person-time data (and transformations thereof)
                               "MN","SMN","MNLN","CVLN","SDLN",                     # mean, single-group standardized mean, log(mean), log(CV), log(SD),
                               "MC","SMCC","SMCR","SMCRH","ROMC","CVRC","VRC",      # raw/standardized mean change, log(ROM), CVR, and VR for dependent samples
@@ -324,7 +324,7 @@ data, slab, subset, add=1/2, to="none", drop00=FALSE, rows, cols) {
 
    #########################################################################
 
-   if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) {
+   if (is.element(measure, c("PR","PLN","PLO","PRZ","PAS","PFT"))) {
 
       xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE)
       mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE)
@@ -984,7 +984,7 @@ data, slab, subset, add=1/2, to="none", drop00=FALSE, rows, cols) {
 
    #########################################################################
 
-   if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) {
+   if (is.element(measure, c("PR","PLN","PLO","PRZ","PAS","PFT"))) {
 
       ### check for NAs in table data and act accordingly
 

R/transf.r

@@ -151,33 +151,33 @@ transf.iarcsin <- function(xi) {
    return(c(zi))
 }
 
-# transf.iarcsin.int <- function(xi, targs=NULL) {
-#
-#   if (is.na(xi))
-#      return(NA_real_)
-#
-#   targs <- .chktargsint(targs)
-#
-#   if (is.null(targs$lower))
-#      targs$lower <- 0
-#   if (is.null(targs$upper))
-#      targs$upper <- asin(1)
-#
-#   toint <- function(zval, xi, tau2)
-#      transf.iarcsin(zval) * dnorm(zval, mean=xi, sd=sqrt(tau2))
-#
-#   cfunc <- function(xi, tau2, lower, upper)
-#      integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2)$value
-#
-#   if (targs$tau2 == 0) {
-#      zi <- transf.iarcsin(xi)
-#   } else {
-#      zi <- mapply(xi, FUN=cfunc, tau2=targs$tau2, lower=targs$lower, upper=targs$upper)
-#   }
-#
-#   return(c(zi))
-#
-# }
+ transf.iarcsin.int <- function(xi, targs=NULL) {
+
+   if (is.na(xi))
+      return(NA_real_)
+
+   targs <- .chktargsint(targs)
+
+   if (is.null(targs$lower))
+      targs$lower <- 0
+   if (is.null(targs$upper))
+      targs$upper <- asin(1)
+
+   toint <- function(zval, xi, tau2)
+      transf.iarcsin(zval) * dnorm(zval, mean=xi, sd=sqrt(tau2))
+
+   cfunc <- function(xi, tau2, lower, upper)
+      integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2)$value
+
+   if (targs$tau2 == 0) {
+      zi <- transf.iarcsin(xi)
+   } else {
+      zi <- mapply(xi, FUN=cfunc, tau2=targs$tau2, lower=targs$lower, upper=targs$upper)
+   }
+
+   return(c(zi))
+
+ }
 
 ############################################################################
 

R/zzz.r

@@ -1,6 +1,6 @@
 .onAttach <- function(libname, pkgname) {
 
-   ver <- "4.7-26"
+   ver <- "4.7-27"
 
    loadmsg <- paste0("\nLoading the 'metafor' package (version ", ver, "). For an\nintroduction to the package please type: help(metafor)\n")
 

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