Added 'btt' (and 'att') argument to permutest().

wviechtb · Jun 18, 2024 · acc05b7 · acc05b7
1 parent d1efe41
commit acc05b7
Show file tree

Hide file tree

Showing 133 changed files with 210 additions and 171 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: metafor
-Version: 4.7-17
-Date: 2024-06-12
+Version: 4.7-18
+Date: 2024-06-18
 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-17 (2024-06-12)
+# metafor 4.7-18 (2024-06-18)
 
 - the `predict.rma()` and `predict.rma.ls()` functions now also accept a matrix as input that includes a column for the intercept term (in which case the `intercept` argument is ignored)
 
@@ -22,6 +22,8 @@
 
 - `fsn(..., type="General")` now computes the final estimates after rounding the fail-safe N value (not before)
 
+- `permutest.rma.uni()` gains a `btt` argument and `permutest.rma.ls()` gains `btt` and `att` arguments
+
 - added more tests
 
 # metafor 4.6-0 (2024-03-28)

diff --git a/R/misc.func.hidden.r b/R/misc.func.hidden.r
@@ -44,7 +44,7 @@
 
          ### make sure that at least one valid value is left
          if (length(btt) == 0L)
-            stop(mstyle$stop("Non-existent coefficients specified via 'btt'."), call.=FALSE)
+            stop(mstyle$stop("Non-existent coefficient(s) specified via 'btt'."), call.=FALSE)
 
       }
 

diff --git a/R/permutest.rma.ls.r b/R/permutest.rma.ls.r
@@ -1,4 +1,4 @@
-permutest.rma.ls <- function(x, exact=FALSE, iter=1000, progbar=TRUE, digits, control, ...) {
+permutest.rma.ls <- function(x, exact=FALSE, iter=1000, btt=x$btt, att=x$att, progbar=TRUE, digits, control, ...) {
 
    mstyle <- .get.mstyle()
 
@@ -12,11 +12,13 @@ permutest.rma.ls <- function(x, exact=FALSE, iter=1000, progbar=TRUE, digits, co
 
    ddd <- list(...)
 
-   .chkdots(ddd, c("tol", "time", "seed", "verbose", "permci", "skip.beta", "skip.alpha"))
+   .chkdots(ddd, c("tol", "time", "seed", "verbose", "permci", "skip.beta", "skip.alpha", "fixed"))
 
    if (!is.null(ddd$tol)) # in case user specifies comptol in the old manner
       comptol <- ddd$tol
 
+   fixed <- .chkddd(ddd$fixed, FALSE, .isTRUE(ddd$fixed))
+
    if (.isTRUE(ddd$permci))
       warning(mstyle$warning("Permutation-based CIs for location-scale models not currently available."), call.=FALSE)
 
@@ -71,6 +73,18 @@ permutest.rma.ls <- function(x, exact=FALSE, iter=1000, progbar=TRUE, digits, co
       skip.alpha <- TRUE
    }
 
+   if (!missing(btt) || !missing(att)) {
+
+      btt <- .set.btt(btt, x$p, x$int.incl, colnames(x$X), fixed=fixed)
+      att <- .set.btt(att, x$q, x$Z.int.incl, colnames(x$Z), fixed=fixed)
+
+      args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=X, intercept=FALSE, scale=x$Z, link=x$link, method=x$method,
+                   weighted=x$weighted, test=x$test, level=x$level, btt=btt, att=att, alpha=ifelse(x$alpha.fix, x$alpha, NA),
+                   optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control)
+      x <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose))
+
+   }
+
    #########################################################################
    #########################################################################
    #########################################################################

diff --git a/R/permutest.rma.uni.r b/R/permutest.rma.uni.r
@@ -1,4 +1,4 @@
-permutest.rma.uni <- function(x, exact=FALSE, iter=1000, permci=FALSE, progbar=TRUE, digits, control, ...) {
+permutest.rma.uni <- function(x, exact=FALSE, iter=1000, btt=x$btt, permci=FALSE, progbar=TRUE, digits, control, ...) {
 
    mstyle <- .get.mstyle()
 
@@ -12,11 +12,13 @@ permutest.rma.uni <- function(x, exact=FALSE, iter=1000, permci=FALSE, progbar=T
 
    ddd <- list(...)
 
-   .chkdots(ddd, c("tol", "time", "seed", "verbose"))
+   .chkdots(ddd, c("tol", "time", "seed", "verbose", "fixed"))
 
    if (!is.null(ddd$tol)) # in case user specifies comptol in the old manner
       comptol <- ddd$tol
 
+   fixed <- .chkddd(ddd$fixed, FALSE, .isTRUE(ddd$fixed))
+
    iter <- round(iter)
 
    if (iter <= 1)
@@ -25,6 +27,16 @@ permutest.rma.uni <- function(x, exact=FALSE, iter=1000, permci=FALSE, progbar=T
    if (.isTRUE(ddd$time))
       time.start <- proc.time()
 
+   if (!missing(btt)) {
+
+      btt <- .set.btt(btt, x$p, x$int.incl, colnames(x$X), fixed=fixed)
+
+      args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=x$X, intercept=FALSE, method=x$method, weighted=x$weighted,
+                   test=x$test, level=x$level, btt=btt, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE)
+      x <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose))
+
+   }
+
    #########################################################################
    #########################################################################
    #########################################################################

diff --git a/R/predict.rma.ls.r b/R/predict.rma.ls.r
@@ -134,7 +134,7 @@ level, digits, transf, targs, vcov=FALSE, ...) {
       ### but user can also decide to remove the intercept from the predictions with intercept=FALSE
       ### one special case: when the location model is an intercept-only model, one can set newmods=1 to obtain the predicted intercept
 
-      if (inherits(newmods, "matrix") && ncol(newmods) == x$p) {
+      if (!singlemod && ncol(X.new) == x$p) {
 
          if (int.spec)
             warning(mstyle$warning("Arguments 'intercept' ignored when 'newmods' includes 'p' columns."), call.=FALSE)
@@ -227,7 +227,7 @@ level, digits, transf, targs, vcov=FALSE, ...) {
       ### one special case: when the scale model is an intercept-only model, one can set newscale=1 to obtain the predicted intercept
       ### (which can be converted to tau^2 with transf=exp when using a log link)
 
-      if (inherits(newscale, "matrix") && ncol(newscale) == x$q) {
+      if (!singlescale && ncol(Z.new) == x$q) {
 
          if (int.spec)
             warning(mstyle$warning("Arguments 'intercept' ignored when 'newscale' includes 'q' columns."), call.=FALSE)

diff --git a/R/predict.rma.r b/R/predict.rma.r
@@ -212,7 +212,7 @@ level, digits, transf, targs, vcov=FALSE, ...) {
       ### but user can also decide to remove the intercept from the predictions with intercept=FALSE (but only do this when
       ### newmods was not a matrix with p columns)
 
-      if (inherits(newmods, "matrix") && ncol(newmods) == x$p) {
+      if (!singlemod && ncol(X.new) == x$p) {
 
          if (int.spec)
             warning(mstyle$warning("Arguments 'intercept' ignored when 'newmods' includes 'p' columns."), call.=FALSE)

diff --git a/R/zzz.r b/R/zzz.r
@@ -1,6 +1,6 @@
 .onAttach <- function(libname, pkgname) {
 
-   ver <- "4.7-17"
+   ver <- "4.7-18"
 
    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--17-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
+[![devel Version](https://img.shields.io/badge/devel-4.7--18-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.9
 pkgdown_sha: ~
 articles:
   diagram: pkgdown/diagram.html
-last_built: 2024-06-11T20:02Z
+last_built: 2024-06-18T20:03Z
 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