Make integral transformation functions vectorized again.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: metafor
-Version: 4.7-49
-Date: 2024-11-11
+Version: 4.7-50
+Date: 2024-11-19
 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

NEWS.md

@@ -1,4 +1,4 @@
-# metafor 4.7-49 (2024-11-11)
+# metafor 4.7-50 (2024-11-19)
 
 - 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
 

R/transf.r

@@ -38,9 +38,6 @@ transf.ztor <- function(xi)
 
 transf.ztor.int <- function(xi, targs=NULL) {
 
-   if (is.na(xi))
-      return(NA_real_)
-
    targs <- .chktargsint(targs)
 
    if (is.null(targs$lower))
@@ -51,8 +48,14 @@ transf.ztor.int <- function(xi, targs=NULL) {
    toint <- function(zval, xi, tau2)
       tanh(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
+   cfunc <- function(xi, tau2, lower, upper) {
+      out <- try(integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2), silent=TRUE)
+      if (inherits(out, "try-error")) {
+         return(NA_real_)
+      } else {
+         return(out$value)
+      }
+   }
 
    if (targs$tau2 == 0) {
       zi <- transf.ztor(xi)
@@ -77,9 +80,6 @@ transf.ztor2 <- function(xi)
 
 transf.exp.int <- function(xi, targs=NULL) {
 
-   if (is.na(xi))
-      return(NA_real_)
-
    targs <- .chktargsint(targs)
 
    if (is.null(targs$lower))
@@ -90,8 +90,14 @@ transf.exp.int <- function(xi, targs=NULL) {
    toint <- function(zval, xi, tau2)
       exp(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
+   cfunc <- function(xi, tau2, lower, upper) {
+      out <- try(integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2), silent=TRUE)
+      if (inherits(out, "try-error")) {
+         return(NA_real_)
+      } else {
+         return(out$value)
+      }
+   }
 
    if (targs$tau2 == 0) {
       zi <- exp(xi)
@@ -113,9 +119,6 @@ transf.ilogit <- function(xi)
 
 transf.ilogit.int <- function(xi, targs=NULL) {
 
-   if (is.na(xi))
-      return(NA_real_)
-
    targs <- .chktargsint(targs)
 
    if (is.null(targs$lower))
@@ -126,8 +129,14 @@ transf.ilogit.int <- function(xi, targs=NULL) {
    toint <- function(zval, xi, tau2)
       plogis(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
+   cfunc <- function(xi, tau2, lower, upper) {
+      out <- try(integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2), silent=TRUE)
+      if (inherits(out, "try-error")) {
+         return(NA_real_)
+      } else {
+         return(out$value)
+      }
+   }
 
    if (targs$tau2 == 0) {
       zi <- transf.ilogit(xi)
@@ -153,9 +162,6 @@ transf.iarcsin <- function(xi) {
 
 # transf.iarcsin.int <- function(xi, targs=NULL) {
 #
-#   if (is.na(xi))
-#      return(NA_real_)
-#
 #   targs <- .chktargsint(targs)
 #
 #   if (is.null(targs$lower))
@@ -166,8 +172,14 @@ transf.iarcsin <- function(xi) {
 #   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
+#   cfunc <- function(xi, tau2, lower, upper) {
+#      out <- try(integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2), silent=TRUE)
+#      if (inherits(out, "try-error")) {
+#         return(NA_real_)
+#      } else {
+#         return(out$value)
+#      }
+#   }
 #
 #   if (targs$tau2 == 0) {
 #      zi <- transf.iarcsin(xi)

R/zzz.r

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