Updated version to 4.6-0 for CRAN release.

R/anova.rma.r

@@ -215,8 +215,8 @@ anova.rma <- function(object, object2, btt, X, att, Z, rhs, digits, refit=FALSE,
 
             ### omnibus test of all hypotheses (only possible if 'Z' is of full rank)
 
-            QS  <- NA_real_ ### need this in case QS cannot be calculated below
-            QSp <- NA_real_ ### need this in case QSp cannot be calculated below
+            QS  <- NA_real_ # need this in case QS cannot be calculated below
+            QSp <- NA_real_ # need this in case QSp cannot be calculated below
 
             if (rankMatrix(Z) == m) {
 
@@ -240,24 +240,24 @@ anova.rma <- function(object, object2, btt, X, att, Z, rhs, digits, refit=FALSE,
 
             hyp <- rep("", m)
             for (j in seq_len(m)) {
-               Zj <- round(Z[j,], digits[["est"]]) ### coefficients for the jth contrast
-               sel <- Zj != 0 ### TRUE if coefficient is != 0
-               hyp[j] <- paste(paste(Zj[sel], rownames(x$alpha)[sel], sep="*"), collapse=" + ") ### coefficient*variable + coefficient*variable ...
-               hyp[j] <- gsub("1*", "", hyp[j], fixed=TRUE) ### turn '+1' into '+' and '-1' into '-'
-               hyp[j] <- gsub("+ -", "- ", hyp[j], fixed=TRUE) ### turn '+ -' into '-'
+               Zj <- round(Z[j,], digits[["est"]]) # coefficients for the jth contrast
+               sel <- Zj != 0 # TRUE if coefficient is != 0
+               hyp[j] <- paste(paste(Zj[sel], rownames(x$alpha)[sel], sep="*"), collapse=" + ") # coefficient*variable + coefficient*variable ...
+               hyp[j] <- gsub("1*", "", hyp[j], fixed=TRUE) # turn '+1' into '+' and '-1' into '-'
+               hyp[j] <- gsub("+ -", "- ", hyp[j], fixed=TRUE) # turn '+ -' into '-'
             }
             if (identical(rhs, rep(0,m))) {
-               hyp <- paste0(hyp, " = 0") ### add '= 0' at the right
+               hyp <- paste0(hyp, " = 0") # add '= 0' at the right
             } else {
                if (length(unique(rhs)) == 1L) {
-                  hyp <- paste0(hyp, " = ", round(rhs, digits=digits[["est"]])) ### add '= rhs' at the right
+                  hyp <- paste0(hyp, " = ", round(rhs, digits=digits[["est"]])) # add '= rhs' at the right
                } else {
-                  hyp <- paste0(hyp, " = ", fmtx(rhs, digits=digits[["est"]])) ### add '= rhs' at the right
+                  hyp <- paste0(hyp, " = ", fmtx(rhs, digits=digits[["est"]])) # add '= rhs' at the right
                }
             }
             hyp <- data.frame(hyp, stringsAsFactors=FALSE)
             colnames(hyp) <- ""
-            rownames(hyp) <- paste0(seq_len(m), ":") ### add '1:', '2:', ... as row names
+            rownames(hyp) <- paste0(seq_len(m), ":") # add '1:', '2:', ... as row names
 
             res <- list(QS=QS, QSdf=QSdf, QSp=QSp, hyp=hyp, Za=Za, se=se, zval=zval, pval=pval, k=x$k, q=x$q, m=m, test=x$test, ddf=x$ddf.alpha, digits=digits, type="Wald.Za")
 
@@ -400,24 +400,24 @@ anova.rma <- function(object, object2, btt, X, att, Z, rhs, digits, refit=FALSE,
 
             hyp <- rep("", m)
             for (j in seq_len(m)) {
-               Xj <- round(X[j,], digits[["est"]]) ### coefficients for the jth contrast
-               sel <- Xj != 0 ### TRUE if coefficient is != 0
-               hyp[j] <- paste(paste(Xj[sel], rownames(x$beta)[sel], sep="*"), collapse=" + ") ### coefficient*variable + coefficient*variable ...
-               hyp[j] <- gsub("1*", "", hyp[j], fixed=TRUE) ### turn '+1' into '+' and '-1' into '-'
-               hyp[j] <- gsub("+ -", "- ", hyp[j], fixed=TRUE) ### turn '+ -' into '-'
+               Xj <- round(X[j,], digits[["est"]]) # coefficients for the jth contrast
+               sel <- Xj != 0 # TRUE if coefficient is != 0
+               hyp[j] <- paste(paste(Xj[sel], rownames(x$beta)[sel], sep="*"), collapse=" + ") # coefficient*variable + coefficient*variable ...
+               hyp[j] <- gsub("1*", "", hyp[j], fixed=TRUE) # turn '+1' into '+' and '-1' into '-'
+               hyp[j] <- gsub("+ -", "- ", hyp[j], fixed=TRUE) # turn '+ -' into '-'
             }
             if (identical(rhs, rep(0,m))) {
-               hyp <- paste0(hyp, " = 0") ### add '= 0' at the right
+               hyp <- paste0(hyp, " = 0") # add '= 0' at the right
             } else {
                if (length(unique(rhs)) == 1L) {
-                  hyp <- paste0(hyp, " = ", round(rhs, digits=digits[["est"]])) ### add '= rhs' at the right
+                  hyp <- paste0(hyp, " = ", round(rhs, digits=digits[["est"]])) # add '= rhs' at the right
                } else {
-                  hyp <- paste0(hyp, " = ", fmtx(rhs,  digits=digits[["est"]])) ### add '= rhs' at the right
+                  hyp <- paste0(hyp, " = ", fmtx(rhs,  digits=digits[["est"]])) # add '= rhs' at the right
                }
             }
             hyp <- data.frame(hyp, stringsAsFactors=FALSE)
             colnames(hyp) <- ""
-            rownames(hyp) <- paste0(seq_len(m), ":") ### add '1:', '2:', ... as row names
+            rownames(hyp) <- paste0(seq_len(m), ":") # add '1:', '2:', ... as row names
 
             res <- list(QM=QM, QMdf=QMdf, QMp=QMp, hyp=hyp, Xb=Xb, se=se, zval=zval, pval=pval, k=x$k, p=x$p, m=m, test=x$test, ddf=ddf, digits=digits, type="Wald.Xb")
 

R/bldiag.r

@@ -22,7 +22,7 @@ bldiag <- function(..., order) {
    if (any(is00))
       mlist <- mlist[!is00]
 
-   csdim <- rbind(c(0,0), apply(sapply(mlist,dim), 1, cumsum)) ### consider using rowCumsums() from matrixStats package
+   csdim <- rbind(c(0,0), apply(sapply(mlist,dim), 1, cumsum)) # consider using rowCumsums() from matrixStats package
 
    out  <- array(0, dim=csdim[length(mlist) + 1,])
    add1 <- matrix(rep(1:0, 2L), ncol=2)
@@ -31,9 +31,9 @@ bldiag <- function(..., order) {
 
       indx <- apply(csdim[i:(i+1),] + add1, 2, function(x) x[1]:x[2])
 
-      if (is.null(dim(indx))) {                 ### non-square matrix
+      if (is.null(dim(indx))) {                 # non-square matrix
          out[indx[[1]],indx[[2]]] <- mlist[[i]]
-      } else {                                  ### square matrix
+      } else {                                  # square matrix
          out[indx[,1],indx[,2]] <- mlist[[i]]
       }
 

R/cooks.distance.rma.mv.r

@@ -4,7 +4,7 @@ cooks.distance.rma.mv <- function(model, progbar=FALSE, cluster, reestimate=TRUE
 
    .chkclass(class(model), must="rma.mv")
 
-   #if (inherits(model, "robust.rma")) ### can compute Cook's distance also for 'robust.rma' objects
+   #if (inherits(model, "robust.rma")) # can compute Cook's distance also for 'robust.rma' objects
    #   stop(mstyle$stop("Method not available for objects of class \"robust.rma\"."))
 
    na.act <- getOption("na.action")

R/cumul.rma.mh.r

@@ -133,7 +133,7 @@ cumul.rma.mh <- function(x, order, digits, transf, targs, progbar=FALSE, ...) {
 
    ### if requested, apply transformation function
 
-   if (.isTRUE(transf) && is.element(x$measure, c("OR","RR","IRR"))) ### if transf=TRUE, apply exp transformation to ORs, RRs, and IRRs
+   if (.isTRUE(transf) && is.element(x$measure, c("OR","RR","IRR"))) # if transf=TRUE, apply exp transformation to ORs, RRs, and IRRs
       transf <- exp
 
    if (is.function(transf)) {

R/cumul.rma.peto.r

@@ -123,7 +123,7 @@ cumul.rma.peto <- function(x, order, digits, transf, targs, progbar=FALSE, ...)
 
    ### if requested, apply transformation function
 
-   if (.isTRUE(transf)) ### if transf=TRUE, apply exp transformation to ORs
+   if (.isTRUE(transf)) # if transf=TRUE, apply exp transformation to ORs
       transf <- exp
 
    if (is.function(transf)) {

R/forest.rma.r

@@ -920,7 +920,7 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
             if (length(addpred) == 1L)
                addpred <- c(addpred, addpred)
             temp <- predict(x, level=level, tau2.levels=addpred[1], gamma2.levels=addpred[2], pi.type=pi.type)
-            addpred <- TRUE ### set addpred to TRUE, so if (!is.element(x$method, c("FE","EE","CE")) && addpred) further below works
+            addpred <- TRUE # set addpred to TRUE, so if (!is.element(x$method, c("FE","EE","CE")) && addpred) further below works
          } else {
             if (addpred) {
                ### here addpred=TRUE, but user has not specified the level, so throw an error

R/hatvalues.rma.mv.r

@@ -19,7 +19,7 @@ hatvalues.rma.mv <- function(model, type="diagonal", ...) {
       W     <- chol2inv(chol(x$M))
       stXWX <- chol2inv(chol(as.matrix(t(x$X) %*% W %*% x$X)))
       H     <- as.matrix(x$X %*% stXWX %*% crossprod(x$X,W))
-      #H <- as.matrix(x$X %*% x$vb %*% crossprod(x$X,W)) ### x$vb may have been changed through robust()
+      #H <- as.matrix(x$X %*% x$vb %*% crossprod(x$X,W)) # x$vb may have been changed through robust()
    } else {
       A     <- x$W
       stXAX <- chol2inv(chol(as.matrix(t(x$X) %*% A %*% x$X)))
@@ -33,7 +33,7 @@ hatvalues.rma.mv <- function(model, type="diagonal", ...) {
 
       hii <- rep(NA_real_, x$k.f)
       hii[x$not.na] <- as.vector(diag(H))
-      hii[hii > 1 - 10 * .Machine$double.eps] <- 1 ### as in lm.influence()
+      hii[hii > 1 - 10 * .Machine$double.eps] <- 1 # as in lm.influence()
       names(hii) <- x$slab
 
       if (na.act == "na.omit")

R/hatvalues.rma.uni.r

@@ -20,7 +20,7 @@ hatvalues.rma.uni <- function(model, type="diagonal", ...) {
          W     <- diag(1/(x$vi + x$tau2), nrow=x$k, ncol=x$k)
          stXWX <- .invcalc(X=x$X, W=W, k=x$k)
          H     <- x$X %*% stXWX %*% crossprod(x$X,W)
-         #H <- x$X %*% (x$vb / x$s2w) %*% crossprod(x$X,W) ### x$vb may be changed through robust() (and when test="knha")
+         #H <- x$X %*% (x$vb / x$s2w) %*% crossprod(x$X,W) # x$vb may be changed through robust() (and when test="knha")
       } else {
          A     <- diag(x$weights, nrow=x$k, ncol=x$k)
          stXAX <- .invcalc(X=x$X, W=A, k=x$k)
@@ -37,7 +37,7 @@ hatvalues.rma.uni <- function(model, type="diagonal", ...) {
 
       hii <- rep(NA_real_, x$k.f)
       hii[x$not.na] <- diag(H)
-      hii[hii > 1 - 10 * .Machine$double.eps] <- 1 ### as in lm.influence()
+      hii[hii > 1 - 10 * .Machine$double.eps] <- 1 # as in lm.influence()
       names(hii) <- x$slab
 
       if (na.act == "na.omit")

R/hc.rma.uni.r

@@ -48,7 +48,7 @@ hc.rma.uni <- function(object, digits, transf, targs, control, ...) {
    ### original code by Henmi & Copas (2012), modified by Michael Dewey, small adjustments
    ### for consistency with other functions in the metafor package by Wolfgang Viechtbauer
 
-   wi <- 1/vi ### fixed effects weights
+   wi <- 1/vi # fixed effects weights
 
    W1 <- sum(wi)
    W2 <- sum(wi^2) / W1

R/labbe.rma.r

@@ -137,7 +137,7 @@ add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid
    t1i[yi.is.na] <- NA_real_
    t2i[yi.is.na] <- NA_real_
 
-   options(na.action = "na.pass") ### to make sure dat.t and dat.c are of the same length
+   options(na.action = "na.pass") # to make sure dat.t and dat.c are of the same length
 
    measure <- switch(x$measure, "RR"="PLN", "OR"="PLO", "RD"="PR", "AS"="PAS", "IRR"="IRLN", "IRD"="IR", "IRSD"="IRS")
 

R/leave1out.rma.mh.r

@@ -100,7 +100,7 @@ leave1out.rma.mh <- function(x, digits, transf, targs, progbar=FALSE, ...) {
 
    ### if requested, apply transformation function
 
-   if (.isTRUE(transf) && is.element(x$measure, c("OR","RR","IRR"))) ### if transf=TRUE, apply exp transformation to ORs, RRs, and IRRs
+   if (.isTRUE(transf) && is.element(x$measure, c("OR","RR","IRR"))) # if transf=TRUE, apply exp transformation to ORs, RRs, and IRRs
       transf <- exp
 
    if (is.function(transf)) {

R/leave1out.rma.peto.r

@@ -92,7 +92,7 @@ leave1out.rma.peto <- function(x, digits, transf, targs, progbar=FALSE, ...) {
 
    ### if requested, apply transformation function
 
-   if (.isTRUE(transf)) ### if transf=TRUE, apply exp transformation to ORs
+   if (.isTRUE(transf)) # if transf=TRUE, apply exp transformation to ORs
       transf <- exp
 
    if (is.function(transf)) {

R/llplot.r

@@ -96,7 +96,7 @@ lty, lwd, col, level=99.99, refline=0, ...) {
       if (!.equal.length(yi, vi))
          stop(mstyle$stop("Supplied data vectors are not all of the same length."))
 
-      k <- length(yi) ### number of outcomes before subsetting
+      k <- length(yi) # number of outcomes before subsetting
 
       ### subsetting
 
@@ -146,7 +146,7 @@ lty, lwd, col, level=99.99, refline=0, ...) {
       if (any(c(n1i < 0, n2i < 0), na.rm=TRUE))
          stop(mstyle$stop("One or more group sizes are negative."))
 
-      k <- length(ai) ### number of outcomes before subsetting
+      k <- length(ai) # number of outcomes before subsetting
 
       ### note studies that have at least one zero cell
 
@@ -179,8 +179,8 @@ lty, lwd, col, level=99.99, refline=0, ...) {
 
       dat <- .do.call(escalc, measure="OR", ai=ai, bi=bi, ci=ci, di=di, drop00=drop00, onlyo1=onlyo1, addyi=addyi, addvi=addvi)
 
-      yi <- dat$yi ### one or more yi/vi pairs may be NA/NA
-      vi <- dat$vi ### one or more yi/vi pairs may be NA/NA
+      yi <- dat$yi # one or more yi/vi pairs may be NA/NA
+      vi <- dat$vi # one or more yi/vi pairs may be NA/NA
 
    }
 

R/methods.list.rma.r

@@ -19,7 +19,7 @@
    if (length(out[[1]]) == 0L)
       return(NULL)
 
-   #out <- out[j] ### this causes all kinds of problems, so left out for now (TODO: check if this is really a problem)
+   #out <- out[j] # this causes all kinds of problems, so left out for now (TODO: check if this is really a problem)
 
    out$slab <- x$slab[i]
 

R/misc.func.hidden.escalc.r

@@ -256,8 +256,8 @@
 }
 
 #integrate(function(x) .dcor(x, n=5, rho=.8), lower=-1, upper=1)
-#integrate(function(x) x*.dcor(x, n=5, rho=.8), lower=-1, upper=1) ### should not be rho due to bias!
-#integrate(function(x) x*.Fcalc(1/2, 1/2, (5-2)/2, 1-x^2)*.dcor(x, n=5, rho=.8), lower=-1, upper=1) ### should be ~rho
+#integrate(function(x) x*.dcor(x, n=5, rho=.8), lower=-1, upper=1) # should not be rho due to bias!
+#integrate(function(x) x*.Fcalc(1/2, 1/2, (5-2)/2, 1-x^2)*.dcor(x, n=5, rho=.8), lower=-1, upper=1) # should be ~rho
 
 ### pdf of ZCOR
 

R/misc.func.hidden.glmm.r

@@ -4,7 +4,7 @@
 ### Liao, J. G. & Rosen, O. (2001). Fast and stable algorithms for computing and sampling from the
 ### noncentral hypergeometric distribution. The American Statistician, 55, 366-369.
 
-.dnoncenhypergeom <- function (x=NA_real_, n1, n2, m1, psi) { ### x=ai, n1=ai+bi, n2=ci+di, m1=ai+ci, psi=ORi
+.dnoncenhypergeom <- function (x=NA_real_, n1, n2, m1, psi) { # x=ai, n1=ai+bi, n2=ci+di, m1=ai+ci, psi=ORi
 
    mstyle <- .get.mstyle()
 
@@ -114,8 +114,8 @@
 
    p    <- ncol(X.fit)
    k    <- length(ai)
-   beta <- parms[seq_len(p)]                  ### first p elemenets in parms are the model coefficients
-   tau2 <- ifelse(random, exp(parms[p+1]), 0) ### next value is tau^2 -- optimize over exp(tau^2) value or hold at 0 if random=FALSE
+   beta <- parms[seq_len(p)]                  # first p elemenets in parms are the model coefficients
+   tau2 <- ifelse(random, exp(parms[p+1]), 0) # next value is tau^2 -- optimize over exp(tau^2) value or hold at 0 if random=FALSE
    mu.i <- X.fit %*% cbind(beta)
 
    lli  <- rep(NA_real_, k)

R/misc.func.hidden.mv.r

@@ -74,7 +74,7 @@
 
    ### get variables names in mf.g
 
-   g.names <- names(mf.g) ### names for inner and outer factors/variables
+   g.names <- names(mf.g) # names for inner and outer factors/variables
 
    ### check that inner variable is a factor (or character variable) for structures that require this (no longer required)
 
@@ -107,7 +107,7 @@
 
    ### get number of levels of each variable in mf.g (vector with two values, for the inner and outer factor)
 
-   #g.nlevels <- c(nlevels(mf.g[[1]]), nlevels(mf.g[[2]])) ### works only for factors
+   #g.nlevels <- c(nlevels(mf.g[[1]]), nlevels(mf.g[[2]])) # works only for factors
    if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) {
       g.nlevels <- c(length(unique(apply(mf.g[-nvars], 1, paste, collapse=" + "))), length(unique(mf.g[[nvars]])))
    } else {
@@ -116,7 +116,7 @@
 
    ### get levels of each variable in mf.g
 
-   #g.levels <- list(levels(mf.g[[1]]), levels(mf.g[[2]])) ### works only for factors
+   #g.levels <- list(levels(mf.g[[1]]), levels(mf.g[[2]])) # works only for factors
    if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) {
       g.levels <- list(sort(unique(apply(mf.g[-nvars], 1, paste, collapse=" + "))), sort(unique((mf.g[[nvars]]))))
    } else {
@@ -279,7 +279,7 @@
 
    ### redo: get number of levels of each variable in mf.g (vector with two values, for the inner and outer factor)
 
-   #g.nlevels <- c(nlevels(mf.g[[1]]), nlevels(mf.g[[2]])) ### works only for factors
+   #g.nlevels <- c(nlevels(mf.g[[1]]), nlevels(mf.g[[2]])) # works only for factors
    if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) {
       g.nlevels <- c(length(unique(apply(mf.g[-nvars], 1, paste, collapse=" + "))), length(unique(mf.g[[nvars]])))
    } else {
@@ -288,7 +288,7 @@
 
    ### redo: get levels of each variable in mf.g
 
-   #g.levels <- list(levels(mf.g[[1]]), levels(mf.g[[2]])) ### works only for factors
+   #g.levels <- list(levels(mf.g[[1]]), levels(mf.g[[2]])) # works only for factors
    if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) {
       g.levels <- list(sort(unique(apply(mf.g[-nvars], 1, paste, collapse=" + "))), sort(unique((mf.g[[nvars]]))))
    } else {
@@ -613,7 +613,7 @@
    if (any(g.levels.r) && struct == "UNR") {
       G[g.levels.r,] <- 0
       G[,g.levels.r] <- 0
-      diag(G) <- tau2 ### don't really need this
+      diag(G) <- tau2 # don't really need this
       rho <- G[lower.tri(G)]
       warning(mstyle$warning(paste0("Fixed ", ifelse(isG, 'rho', 'phi'), " value(s) to 0 for removed level(s).")), call.=FALSE)
    }

R/misc.func.hidden.r

@@ -8,14 +8,14 @@
 
    if (missing(btt) || is.null(btt)) {
 
-      if (p > 1L) {                       ### if the model matrix has more than one column
+      if (p > 1L) {                       # if the model matrix has more than one column
          if (int.incl) {
-            btt <- seq.int(from=2, to=p)     ### and the model has an intercept term, test all coefficients except the intercept
+            btt <- seq.int(from=2, to=p)     # and the model has an intercept term, test all coefficients except the intercept
          } else {
-            btt <- seq_len(p)                ### and the model does not have an intercept term, test all coefficients
+            btt <- seq_len(p)                # and the model does not have an intercept term, test all coefficients
          }
       } else {
-         btt <- 1L                        ### if the model matrix has a single column, test that single coefficient
+         btt <- 1L                        # if the model matrix has a single column, test that single coefficient
       }
 
    } else {

R/print.list.rma.r

@@ -56,7 +56,7 @@ print.list.rma <- function(x, digits=x$digits, ...) {
    sav <- out[,seq_len(min.pos-1)]
 
    for (i in seq_len(min.pos-1)) {
-      if (inherits(out[,i], c("integer","logical","factor","character"))) { ### do not apply formating to these classes
+      if (inherits(out[,i], c("integer","logical","factor","character"))) { # do not apply formating to these classes
          out[,i] <- out[,i]
       } else {
          if (names(out)[i] %in% c("pred", "resid"))