├── DESCRIPTION ├── MD5 ├── NAMESPACE ├── NEWS.md ├── R ├── AIC.rma.r ├── BIC.rma.r ├── addpoly.default.r ├── addpoly.predict.rma.r ├── addpoly.r ├── addpoly.rma.r ├── aggregate.escalc.r ├── anova.rma.r ├── baujat.r ├── baujat.rma.r ├── bldiag.r ├── blsplit.r ├── blup.r ├── blup.rma.uni.r ├── coef.deltamethod.r ├── coef.matreg.r ├── coef.permutest.rma.uni.r ├── coef.rma.r ├── coef.summary.rma.r ├── confint.rma.glmm.r ├── confint.rma.ls.r ├── confint.rma.mh.r ├── confint.rma.mv.r ├── confint.rma.peto.r ├── confint.rma.uni.r ├── confint.rma.uni.selmodel.r ├── contrmat.r ├── conv.2x2.r ├── conv.delta.r ├── conv.fivenum.r ├── conv.wald.r ├── cooks.distance.rma.mv.r ├── cooks.distance.rma.uni.r ├── cumul.r ├── cumul.rma.mh.r ├── cumul.rma.peto.r ├── cumul.rma.uni.r ├── deltamethod.r ├── deviance.rma.r ├── df.residual.rma.r ├── dfbetas.rma.mv.r ├── dfbetas.rma.uni.r ├── dfround.r ├── emmprep.r ├── escalc.r ├── fitstats.r ├── fitstats.rma.r ├── fitted.rma.r ├── forest.cumul.rma.r ├── forest.default.r ├── forest.r ├── forest.rma.r ├── formatters.r ├── formula.rma.r ├── fsn.r ├── funnel.default.r ├── funnel.r ├── funnel.rma.r ├── gosh.r ├── gosh.rma.r ├── hatvalues.rma.mv.r ├── hatvalues.rma.uni.r ├── hc.r ├── hc.rma.uni.r ├── influence.rma.uni.r ├── labbe.r ├── labbe.rma.r ├── leave1out.r ├── leave1out.rma.mh.r ├── leave1out.rma.peto.r ├── leave1out.rma.uni.r ├── llplot.r ├── logLik.rma.r ├── matreg.r ├── metafor.news.r ├── methods.anova.rma.r ├── methods.confint.rma.r ├── methods.escalc.r ├── methods.list.rma.r ├── methods.vif.rma.r ├── mfopt.r ├── misc.func.hidden.escalc.r ├── misc.func.hidden.evals.r ├── misc.func.hidden.fsn.r ├── misc.func.hidden.funnel.r ├── misc.func.hidden.glmm.r ├── misc.func.hidden.mv.r ├── misc.func.hidden.profile.r ├── misc.func.hidden.r ├── misc.func.hidden.selmodel.r ├── misc.func.hidden.tes.r ├── misc.func.hidden.uni.r ├── misc.func.hidden.vif.r ├── model.matrix.rma.r ├── nobs.rma.r ├── pairmat.r ├── permutest.r ├── permutest.rma.ls.r ├── permutest.rma.uni.r ├── plot.cumul.rma.r ├── plot.gosh.rma.r ├── plot.infl.rma.uni.r ├── plot.permutest.rma.uni.r ├── plot.profile.rma.r ├── plot.rma.glmm.r ├── plot.rma.mh.r ├── plot.rma.mv.r ├── plot.rma.peto.r ├── plot.rma.uni.r ├── plot.rma.uni.selmodel.r ├── plot.vif.rma.r ├── points.regplot.r ├── predict.rma.ls.r ├── predict.rma.r ├── print.anova.rma.r ├── print.confint.rma.r ├── print.deltamethod.r ├── print.escalc.r ├── print.fsn.r ├── print.gosh.rma.r ├── print.hc.rma.uni.r ├── print.infl.rma.uni.r ├── print.list.anova.rma.r ├── print.list.confint.rma.r ├── print.list.rma.r ├── print.matreg.r ├── print.permutest.rma.uni.r ├── print.profile.rma.r ├── print.ranktest.r ├── print.regtest.r ├── print.rma.glmm.r ├── print.rma.mh.r ├── print.rma.mv.r ├── print.rma.peto.r ├── print.rma.uni.r ├── print.summary.matreg.r ├── print.summary.rma.r ├── print.tes.r ├── print.vif.rma.r ├── profile.rma.ls.r ├── profile.rma.mv.r ├── profile.rma.uni.r ├── profile.rma.uni.selmodel.r ├── qqnorm.rma.glmm.r ├── qqnorm.rma.mh.r ├── qqnorm.rma.mv.r ├── qqnorm.rma.peto.r ├── qqnorm.rma.uni.r ├── radial.r ├── radial.rma.r ├── ranef.rma.mv.r ├── ranef.rma.uni.r ├── ranktest.r ├── rcalc.r ├── regplot.r ├── regplot.rma.r ├── regtest.r ├── replmiss.r ├── reporter.r ├── reporter.rma.uni.r ├── residuals.rma.r ├── rma.glmm.r ├── rma.mh.r ├── rma.mv.r ├── rma.peto.r ├── rma.uni.r ├── robust.r ├── robust.rma.mv.r ├── robust.rma.uni.r ├── rstandard.rma.mh.r ├── rstandard.rma.mv.r ├── rstandard.rma.peto.r ├── rstandard.rma.uni.r ├── rstudent.rma.mh.r ├── rstudent.rma.mv.r ├── rstudent.rma.peto.r ├── rstudent.rma.uni.r ├── se.r ├── selmodel.r ├── selmodel.rma.uni.r ├── simulate.rma.r ├── summary.escalc.r ├── summary.matreg.r ├── summary.rma.r ├── tes.r ├── to.long.r ├── to.table.r ├── to.wide.r ├── transf.r ├── trimfill.r ├── trimfill.rma.uni.r ├── update.rma.r ├── vcalc.r ├── vcov.deltamethod.r ├── vcov.matreg.r ├── vcov.rma.r ├── vec2mat.r ├── vif.r ├── vif.rma.r ├── weights.rma.glmm.r ├── weights.rma.mh.r ├── weights.rma.mv.r ├── weights.rma.peto.r ├── weights.rma.uni.r └── zzz.r ├── README.md ├── build ├── metafor.pdf ├── stage23.rdb └── vignette.rds ├── inst ├── CITATION ├── doc │ ├── diagram.pdf │ ├── diagram.pdf.asis │ ├── metafor.pdf │ └── metafor.pdf.asis └── reporter │ ├── apa.csl │ └── references.bib ├── man ├── addpoly.Rd ├── addpoly.default.Rd ├── addpoly.predict.rma.Rd ├── addpoly.rma.Rd ├── aggregate.escalc.Rd ├── anova.rma.Rd ├── baujat.Rd ├── bldiag.Rd ├── blsplit.Rd ├── blup.Rd ├── coef.permutest.rma.uni.Rd ├── coef.rma.Rd ├── confint.rma.Rd ├── contrmat.Rd ├── conv.2x2.Rd ├── conv.delta.Rd ├── conv.fivenum.Rd ├── conv.wald.Rd ├── cumul.Rd ├── deltamethod.Rd ├── dfround.Rd ├── emmprep.Rd ├── escalc.Rd ├── figures │ ├── crayon1.png │ ├── crayon2.png │ ├── ex_bubble_plot.png │ ├── ex_forest_plot.png │ ├── ex_funnel_plot.png │ ├── forest-arrangement.pdf │ ├── forest-arrangement.png │ ├── plots-dark.pdf │ ├── plots-dark.png │ ├── plots-light.pdf │ ├── plots-light.png │ ├── selmodel-beta.pdf │ ├── selmodel-beta.png │ ├── selmodel-negexppow.pdf │ ├── selmodel-negexppow.png │ ├── selmodel-preston-prec.pdf │ ├── selmodel-preston-prec.png │ ├── selmodel-preston-step.pdf │ ├── selmodel-preston-step.png │ ├── selmodel-preston.pdf │ ├── selmodel-preston.png │ ├── selmodel-stepfun-fixed.pdf │ ├── selmodel-stepfun-fixed.png │ ├── selmodel-stepfun.pdf │ └── selmodel-stepfun.png ├── fitstats.Rd ├── fitted.rma.Rd ├── forest.Rd ├── forest.cumul.rma.Rd ├── forest.default.Rd ├── forest.rma.Rd ├── formatters.Rd ├── formula.rma.Rd ├── fsn.Rd ├── funnel.Rd ├── gosh.Rd ├── hc.Rd ├── influence.rma.mv.Rd ├── influence.rma.uni.Rd ├── labbe.Rd ├── leave1out.Rd ├── llplot.Rd ├── macros │ └── metafor.Rd ├── matreg.Rd ├── metafor-package.Rd ├── metafor.news.Rd ├── methods.anova.rma.Rd ├── methods.confint.rma.Rd ├── methods.deltamethod.Rd ├── methods.escalc.Rd ├── methods.list.rma.Rd ├── methods.matreg.Rd ├── methods.vif.rma.Rd ├── mfopt.Rd ├── misc-models.Rd ├── misc-options.Rd ├── misc-recs.Rd ├── model.matrix.rma.Rd ├── pairmat.Rd ├── permutest.Rd ├── plot.cumul.rma.Rd ├── plot.gosh.rma.Rd ├── plot.infl.rma.uni.Rd ├── plot.permutest.rma.uni.Rd ├── plot.rma.Rd ├── plot.rma.uni.selmodel.Rd ├── plot.vif.rma.Rd ├── predict.rma.Rd ├── print.anova.rma.Rd ├── print.confint.rma.Rd ├── print.deltamethod.Rd ├── print.escalc.Rd ├── print.fsn.Rd ├── print.gosh.rma.Rd ├── print.hc.rma.uni.Rd ├── print.list.rma.Rd ├── print.matreg.Rd ├── print.permutest.rma.uni.Rd ├── print.ranktest.rma.Rd ├── print.regtest.rma.Rd ├── print.rma.Rd ├── profile.rma.Rd ├── qqnorm.rma.Rd ├── radial.Rd ├── ranef.Rd ├── ranktest.Rd ├── rcalc.Rd ├── regplot.Rd ├── regtest.Rd ├── replmiss.Rd ├── reporter.Rd ├── residuals.rma.Rd ├── rma.glmm.Rd ├── rma.mh.Rd ├── rma.mv.Rd ├── rma.peto.Rd ├── rma.uni.Rd ├── robust.Rd ├── se.Rd ├── selmodel.Rd ├── simulate.rma.Rd ├── tes.Rd ├── to.long.Rd ├── to.table.Rd ├── to.wide.Rd ├── transf.Rd ├── trimfill.Rd ├── update.rma.Rd ├── vcalc.Rd ├── vcov.rma.Rd ├── vec2mat.Rd ├── vif.Rd └── weights.rma.Rd ├── tests ├── testthat.R └── testthat │ ├── settings.r │ ├── test_analysis_example_berkey1995.r │ ├── test_analysis_example_berkey1998.r │ ├── test_analysis_example_dersimonian2007.r │ ├── test_analysis_example_gleser2009.r │ ├── test_analysis_example_henmi2010.r │ ├── test_analysis_example_ishak2007.r │ ├── test_analysis_example_jackson2014.r │ ├── test_analysis_example_konstantopoulos2011.r │ ├── test_analysis_example_law2016.r │ ├── test_analysis_example_lipsey2001.r │ ├── test_analysis_example_miller1978.r │ ├── test_analysis_example_morris2008.r │ ├── test_analysis_example_normand1999.r │ ├── test_analysis_example_raudenbush1985.r │ ├── test_analysis_example_raudenbush2009.r │ ├── test_analysis_example_rothman2008.r │ ├── test_analysis_example_stijnen2010.r │ ├── test_analysis_example_vanhouwelingen1993.r │ ├── test_analysis_example_vanhouwelingen2002.r │ ├── test_analysis_example_viechtbauer2005.r │ ├── test_analysis_example_viechtbauer2007a.r │ ├── test_analysis_example_viechtbauer2007b.r │ ├── test_analysis_example_yusuf1985.r │ ├── test_misc_aggregate.r │ ├── test_misc_anova.r │ ├── test_misc_calc_q.r │ ├── test_misc_coef_se.r │ ├── test_misc_confint.r │ ├── test_misc_cumul.r │ ├── test_misc_dfround.r │ ├── test_misc_diagnostics_rma.mv.r │ ├── test_misc_emmprep.r │ ├── test_misc_escalc.r │ ├── test_misc_fitstats.r │ ├── test_misc_formula.r │ ├── test_misc_fsn.r │ ├── test_misc_funnel.r │ ├── test_misc_handling_nas.r │ ├── test_misc_handling_of_edge_cases_due_to_zeros.r │ ├── test_misc_influence.r │ ├── test_misc_list_rma.r │ ├── test_misc_matreg.r │ ├── test_misc_metan_vs_rma.mh_with_dat.bcg.r │ ├── test_misc_metan_vs_rma.peto_with_dat.bcg.r │ ├── test_misc_metan_vs_rma.uni_with_dat.bcg.r │ ├── test_misc_pdfs.r │ ├── test_misc_permutest.r │ ├── test_misc_plot_rma.r │ ├── test_misc_predict.r │ ├── test_misc_pub_bias.r │ ├── test_misc_replmiss.r │ ├── test_misc_reporter.r │ ├── test_misc_residuals.r │ ├── test_misc_rma_error_handling.r │ ├── test_misc_rma_glmm.r │ ├── test_misc_rma_handling_nas.r │ ├── test_misc_rma_ls.r │ ├── test_misc_rma_mv.r │ ├── test_misc_rma_uni.r │ ├── test_misc_rma_uni_ls.r │ ├── test_misc_rma_vs_direct_computation.r │ ├── test_misc_rma_vs_lm.r │ ├── test_misc_robust.r │ ├── test_misc_selmodel.r │ ├── test_misc_setlab.r │ ├── test_misc_tes.r │ ├── test_misc_to_long_table_wide.r │ ├── test_misc_transf.r │ ├── test_misc_update.r │ ├── test_misc_vcalc.r │ ├── test_misc_vcov.r │ ├── test_misc_vec2mat.r │ ├── test_misc_vif.r │ ├── test_misc_weights.r │ ├── test_plots_baujat_plot.r │ ├── test_plots_caterpillar_plot.r │ ├── test_plots_contour-enhanced_funnel_plot.r │ ├── test_plots_cumulative_forest_plot.r │ ├── test_plots_forest_plot_with_predstyle.r │ ├── test_plots_forest_plot_with_subgroups.r │ ├── test_plots_funnel_plot_variations.r │ ├── test_plots_funnel_plot_with_trim_and_fill.r │ ├── test_plots_gosh.r │ ├── test_plots_labbe_plot.r │ ├── test_plots_llplot.r │ ├── test_plots_meta-analytic_scatterplot.r │ ├── test_plots_normal_qq_plots.r │ ├── test_plots_plot_of_cumulative_results.r │ ├── test_plots_plot_of_influence_diagnostics.r │ ├── test_plots_radial_plot.r │ ├── test_plots_regplot.r │ ├── test_tips_model_selection_with_glmulti_and_mumin.r │ ├── test_tips_multiple_imputation_with_mice.r │ ├── test_tips_regression_with_rma.r │ ├── test_tips_rma_vs_lm_and_lme.r │ └── test_tips_testing_factors_lincoms.r └── vignettes ├── diagram.pdf.asis └── metafor.pdf.asis /R/AIC.rma.r: -------------------------------------------------------------------------------- 1 | AIC.rma <- function(object, ..., k=2, correct=FALSE) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | if (missing(...)) { 8 | 9 | ### if there is just 'object' 10 | 11 | if (object$method == "REML") { 12 | out <- ifelse(correct, object$fit.stats["AICc","REML"], object$fit.stats["AIC","REML"]) 13 | } else { 14 | out <- ifelse(correct, object$fit.stats["AICc","ML"], object$fit.stats["AIC","ML"]) 15 | } 16 | 17 | } else { 18 | 19 | ### if there is 'object' and additional objects via ... 20 | 21 | if (object$method == "REML") { 22 | out <- sapply(list(object, ...), function(x) ifelse(correct, x$fit.stats["AICc","REML"], x$fit.stats["AIC","REML"])) 23 | } else { 24 | out <- sapply(list(object, ...), function(x) ifelse(correct, x$fit.stats["AICc","ML"], x$fit.stats["AIC","ML"])) 25 | } 26 | dfs <- sapply(list(object, ...), function(x) x$parms) 27 | 28 | out <- data.frame(df=dfs, AIC=out) 29 | 30 | if (correct) 31 | names(out)[2] <- "AICc" 32 | 33 | ### get names of objects; same idea as in stats:::AIC.default 34 | 35 | cl <- match.call() 36 | cl$k <- NULL 37 | cl$correct <- NULL 38 | rownames(out) <- as.character(cl[-1L]) 39 | 40 | ### check that all models were fitted to the same data 41 | 42 | chksums <- sapply(list(object, ...), function(x) x$chksumyi) 43 | 44 | if (any(chksums[1] != chksums)) 45 | warning(mstyle$warning("Models not all fitted to the same data."), call.=FALSE) 46 | 47 | } 48 | 49 | return(out) 50 | 51 | } 52 | -------------------------------------------------------------------------------- /R/BIC.rma.r: -------------------------------------------------------------------------------- 1 | BIC.rma <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | if (missing(...)) { 8 | 9 | ### if there is just 'object' 10 | 11 | if (object$method == "REML") { 12 | out <- object$fit.stats["BIC","REML"] 13 | } else { 14 | out <- object$fit.stats["BIC","ML"] 15 | } 16 | 17 | } else { 18 | 19 | ### if there is 'object' and additional objects via ... 20 | 21 | if (object$method == "REML") { 22 | out <- sapply(list(object, ...), function(x) x$fit.stats["BIC","REML"]) 23 | } else { 24 | out <- sapply(list(object, ...), function(x) x$fit.stats["BIC","ML"]) 25 | } 26 | dfs <- sapply(list(object, ...), function(x) x$parms) 27 | 28 | out <- data.frame(df=dfs, BIC=out) 29 | 30 | ### get names of objects; same idea as in stats:::AIC.default 31 | 32 | cl <- match.call() 33 | rownames(out) <- as.character(cl[-1L]) 34 | 35 | ### check that all models were fitted to the same data 36 | 37 | chksums <- sapply(list(object, ...), function(x) x$chksumyi) 38 | 39 | if (any(chksums[1] != chksums)) 40 | warning(mstyle$warning("Models not all fitted to the same data."), call.=FALSE) 41 | 42 | } 43 | 44 | return(out) 45 | 46 | } 47 | -------------------------------------------------------------------------------- /R/addpoly.r: -------------------------------------------------------------------------------- 1 | addpoly <- function(x, ...) 2 | UseMethod("addpoly") 3 | -------------------------------------------------------------------------------- /R/baujat.r: -------------------------------------------------------------------------------- 1 | baujat <- function(x, ...) 2 | UseMethod("baujat") 3 | -------------------------------------------------------------------------------- /R/bldiag.r: -------------------------------------------------------------------------------- 1 | bldiag <- function(..., order) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | mlist <- list(...) 6 | 7 | ### handle case in which a list of matrices is given 8 | if (length(mlist)==1L && is.list(mlist[[1]])) 9 | mlist <- unlist(mlist, recursive=FALSE) 10 | 11 | ### make sure each element is a matrix (so that bldiag(matrix(1, nrow=3, ncol=3), 2) also works) 12 | mlist <- lapply(mlist, function(x) if (inherits(x, "matrix")) x else diag(x, nrow=length(x), ncol=length(x))) 13 | 14 | ### find any ?x0 or 0x? matrices 15 | is00 <- sapply(mlist, function(x) any(dim(x) == c(0L,0L))) 16 | 17 | ### if all are ?x0 or 0x? matrices, return 0x0 matrix 18 | if (all(is00)) 19 | return(matrix(nrow=0, ncol=0)) 20 | 21 | ### otherwise filter out those matrices (if there are any) 22 | if (any(is00)) 23 | mlist <- mlist[!is00] 24 | 25 | csdim <- rbind(c(0,0), apply(sapply(mlist,dim), 1, cumsum)) # consider using rowCumsums() from matrixStats package 26 | 27 | out <- array(0, dim=csdim[length(mlist) + 1,]) 28 | add1 <- matrix(rep(1:0, 2L), ncol=2) 29 | 30 | for (i in seq(along.with=mlist)) { 31 | 32 | indx <- apply(csdim[i:(i+1),] + add1, 2, function(x) x[1]:x[2]) 33 | 34 | if (is.null(dim(indx))) { # non-square matrix 35 | out[indx[[1]],indx[[2]]] <- mlist[[i]] 36 | } else { # square matrix 37 | out[indx[,1],indx[,2]] <- mlist[[i]] 38 | } 39 | 40 | } 41 | 42 | if (!missing(order)) { 43 | if (nrow(out) != ncol(out)) 44 | stop(mstyle$stop("Can only use 'order' argument for square matrices.")) 45 | if (length(order) != nrow(out)) 46 | stop(mstyle$stop(paste0("Length of the 'order' argument (", length(order), ") does not correspond to the dimensions of the matrix (", nrow(out), "x", ncol(out), ")."))) 47 | if (grepl("^order\\(", deparse1(substitute(order)))) { 48 | sort.vec <- order 49 | } else { 50 | sort.vec <- order(order) 51 | } 52 | out[sort.vec, sort.vec] <- out 53 | } 54 | 55 | return(out) 56 | 57 | } 58 | -------------------------------------------------------------------------------- /R/blsplit.r: -------------------------------------------------------------------------------- 1 | blsplit <- function(x, cluster, fun, args, sort=FALSE) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | if (missing(cluster)) 6 | stop(mstyle$stop("Must specify the 'cluster' variable.")) 7 | 8 | if (!is.matrix(x) && !inherits(x, "dgCMatrix")) 9 | stop(mstyle$stop("Argument 'x' must be a matrix.")) 10 | 11 | if (!isSymmetric(x)) 12 | stop(mstyle$stop("Argument 'x' must be a symmetric matrix.")) 13 | 14 | k <- nrow(x) 15 | 16 | if (length(cluster) != k) 17 | stop(mstyle$stop(paste0("Length of the variable specified via 'cluster' (", length(cluster), ") does not correspond to the dimensions of the matrix (", k, "x", k, ")."))) 18 | 19 | res <- list() 20 | 21 | clusters <- unique(cluster) 22 | 23 | if (sort) 24 | clusters <- sort(clusters) 25 | 26 | for (i in seq_along(clusters)) { 27 | res[[i]] <- x[cluster == clusters[i], cluster == clusters[i], drop=FALSE] 28 | } 29 | 30 | names(res) <- clusters 31 | 32 | if (!missing(fun)) { 33 | if (missing(args)) { 34 | res <- lapply(res, fun) 35 | } else { 36 | args <- as.list(args) 37 | for (i in 1:length(res)) { 38 | res[[i]] <- do.call(fun, c(unname(res[i]), args)) 39 | } 40 | } 41 | } 42 | 43 | return(res) 44 | 45 | } 46 | -------------------------------------------------------------------------------- /R/blup.r: -------------------------------------------------------------------------------- 1 | blup <- function(x, ...) 2 | UseMethod("blup") 3 | -------------------------------------------------------------------------------- /R/coef.deltamethod.r: -------------------------------------------------------------------------------- 1 | coef.deltamethod <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="deltamethod") 6 | 7 | coefs <- c(object$tab$coef) 8 | names(coefs) <- rownames(object$tab) 9 | 10 | return(coefs) 11 | 12 | } 13 | -------------------------------------------------------------------------------- /R/coef.matreg.r: -------------------------------------------------------------------------------- 1 | coef.matreg <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="matreg") 6 | 7 | coefs <- c(object$tab$beta) 8 | names(coefs) <- rownames(object$tab) 9 | 10 | return(coefs) 11 | 12 | } 13 | -------------------------------------------------------------------------------- /R/coef.permutest.rma.uni.r: -------------------------------------------------------------------------------- 1 | coef.permutest.rma.uni <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="permutest.rma.uni") 6 | 7 | x <- object 8 | 9 | if (is.element(x$test, c("knha","adhoc","t"))) { 10 | res.table <- data.frame(estimate=x$beta, se=x$se, tval=x$zval, df=x$ddf, pval=x$pval, ci.lb=x$ci.lb, ci.ub=x$ci.ub) 11 | } else { 12 | res.table <- data.frame(estimate=x$beta, se=x$se, zval=x$zval, pval=x$pval, ci.lb=x$ci.lb, ci.ub=x$ci.ub) 13 | } 14 | 15 | if (inherits(x, "permutest.rma.ls")) { 16 | 17 | if (is.element(x$test, c("knha","adhoc","t"))) { 18 | res.table.alpha <- data.frame(estimate=x$alpha, se=x$se.alpha, tval=x$zval.alpha, df=x$ddf.alpha, pval=x$pval.alpha, ci.lb=x$ci.lb.alpha, ci.ub=x$ci.ub.alpha) 19 | } else { 20 | res.table.alpha <- data.frame(estimate=x$alpha, se=x$se.alpha, zval=x$zval.alpha, pval=x$pval.alpha, ci.lb=x$ci.lb.alpha, ci.ub=x$ci.ub.alpha) 21 | } 22 | 23 | res.table <- list(beta=res.table, alpha=res.table.alpha) 24 | 25 | } 26 | 27 | return(res.table) 28 | 29 | } 30 | -------------------------------------------------------------------------------- /R/coef.rma.r: -------------------------------------------------------------------------------- 1 | coef.rma <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | ddd <- list(...) 8 | 9 | coefs <- c(object$beta) 10 | names(coefs) <- rownames(object$beta) 11 | 12 | if (isTRUE(ddd$type=="beta")) 13 | return(coefs) 14 | 15 | if (inherits(object, "rma.ls")) { 16 | coefs <- list(beta=coefs) 17 | coefs$alpha <- c(object$alpha) 18 | names(coefs$alpha) <- rownames(object$alpha) 19 | if (isTRUE(ddd$type=="alpha")) 20 | return(coefs$alpha) 21 | } 22 | 23 | if (inherits(object, "rma.uni.selmodel")) { 24 | coefs <- list(beta=coefs) 25 | coefs$delta <- c(object$delta) 26 | if (length(object$delta) == 1L) { 27 | names(coefs$delta) <- "delta" 28 | } else { 29 | names(coefs$delta) <- paste0("delta.", seq_along(object$delta)) 30 | } 31 | if (isTRUE(ddd$type=="delta")) 32 | return(coefs$delta) 33 | } 34 | 35 | return(coefs) 36 | 37 | } 38 | -------------------------------------------------------------------------------- /R/coef.summary.rma.r: -------------------------------------------------------------------------------- 1 | coef.summary.rma <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="summary.rma") 6 | 7 | ddd <- list(...) 8 | 9 | x <- object 10 | 11 | if (is.element(x$test, c("knha","adhoc","t"))) { 12 | res.table <- data.frame(estimate=x$beta, se=x$se, tval=x$zval, df=x$ddf, pval=x$pval, ci.lb=x$ci.lb, ci.ub=x$ci.ub) 13 | } else { 14 | res.table <- data.frame(estimate=x$beta, se=x$se, zval=x$zval, pval=x$pval, ci.lb=x$ci.lb, ci.ub=x$ci.ub) 15 | } 16 | 17 | if (isTRUE(ddd$type=="beta")) 18 | return(res.table) 19 | 20 | if (inherits(x, "rma.ls")) { 21 | res.table <- list(beta=res.table) 22 | if (is.element(x$test, c("knha","adhoc","t"))) { 23 | res.table$alpha <- data.frame(estimate=x$alpha, se=x$se.alpha, tval=x$zval.alpha, df=x$ddf.alpha, pval=x$pval.alpha, ci.lb=x$ci.lb.alpha, ci.ub=x$ci.ub.alpha) 24 | } else { 25 | res.table$alpha <- data.frame(estimate=x$alpha, se=x$se.alpha, zval=x$zval.alpha, pval=x$pval.alpha, ci.lb=x$ci.lb.alpha, ci.ub=x$ci.ub.alpha) 26 | } 27 | if (isTRUE(ddd$type=="alpha")) 28 | return(res.table$alpha) 29 | } 30 | 31 | if (inherits(x, "rma.uni.selmodel")) { 32 | res.table <- list(beta=res.table) 33 | res.table$delta <- data.frame(estimate=x$delta, se=x$se.delta, zval=x$zval.delta, pval=x$pval.delta, ci.lb=x$ci.lb.delta, ci.ub=x$ci.ub.delta) 34 | if (length(x$delta) == 1L) { 35 | rownames(res.table$delta) <- "delta" 36 | } else { 37 | rownames(res.table$delta) <- paste0("delta.", seq_along(x$delta)) 38 | } 39 | if (isTRUE(ddd$type=="delta")) 40 | return(res.table$delta) 41 | } 42 | 43 | return(res.table) 44 | 45 | } 46 | -------------------------------------------------------------------------------- /R/confint.rma.glmm.r: -------------------------------------------------------------------------------- 1 | confint.rma.glmm <- function(object, parm, level, digits, transf, targs, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma.glmm", notav="rma.glmm") 6 | 7 | } 8 | -------------------------------------------------------------------------------- /R/confint.rma.mh.r: -------------------------------------------------------------------------------- 1 | confint.rma.mh <- function(object, parm, level, digits, transf, targs, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma.mh") 6 | 7 | if (!missing(parm)) 8 | warning(mstyle$warning("Argument 'parm' (currently) ignored."), call.=FALSE) 9 | 10 | x <- object 11 | 12 | if (missing(level)) 13 | level <- x$level 14 | 15 | if (missing(digits)) { 16 | digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) 17 | } else { 18 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 19 | } 20 | 21 | if (missing(transf)) 22 | transf <- FALSE 23 | 24 | if (missing(targs)) 25 | targs <- NULL 26 | 27 | ddd <- list(...) 28 | 29 | .chkdots(ddd, c("time")) 30 | 31 | if (.isTRUE(ddd$time)) 32 | time.start <- proc.time() 33 | 34 | ######################################################################### 35 | 36 | level <- .level(level) 37 | crit <- qnorm(level/2, lower.tail=FALSE) 38 | 39 | beta <- x$beta 40 | ci.lb <- beta - crit * x$se 41 | ci.ub <- beta + crit * x$se 42 | 43 | ### if requested, apply transformation function 44 | 45 | if (.isTRUE(transf) && is.element(x$measure, c("OR","RR","IRR"))) # if transf=TRUE, apply exp transformation to ORs, RRs, and IRRs 46 | transf <- exp 47 | 48 | if (is.function(transf)) { 49 | if (is.null(targs)) { 50 | beta <- sapply(beta, transf) 51 | ci.lb <- sapply(ci.lb, transf) 52 | ci.ub <- sapply(ci.ub, transf) 53 | } else { 54 | if (!is.primitive(transf) && !is.null(targs) && length(formals(transf)) == 1L) 55 | stop(mstyle$stop("Function specified via 'transf' does not appear to have an argument for 'targs'.")) 56 | beta <- sapply(beta, transf, targs) 57 | ci.lb <- sapply(ci.lb, transf, targs) 58 | ci.ub <- sapply(ci.ub, transf, targs) 59 | } 60 | } 61 | 62 | ### make sure order of intervals is always increasing 63 | 64 | tmp <- .psort(ci.lb, ci.ub) 65 | ci.lb <- tmp[,1] 66 | ci.ub <- tmp[,2] 67 | 68 | ######################################################################### 69 | 70 | res <- cbind(estimate=beta, ci.lb, ci.ub) 71 | res <- list(fixed=res) 72 | rownames(res$fixed) <- "" 73 | 74 | res$digits <- digits 75 | 76 | if (.isTRUE(ddd$time)) { 77 | time.end <- proc.time() 78 | .print.time(unname(time.end - time.start)[3]) 79 | } 80 | 81 | class(res) <- "confint.rma" 82 | return(res) 83 | 84 | } 85 | -------------------------------------------------------------------------------- /R/confint.rma.peto.r: -------------------------------------------------------------------------------- 1 | confint.rma.peto <- function(object, parm, level, digits, transf, targs, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma.peto") 6 | 7 | if (!missing(parm)) 8 | warning(mstyle$warning("Argument 'parm' (currently) ignored."), call.=FALSE) 9 | 10 | x <- object 11 | 12 | if (missing(level)) 13 | level <- x$level 14 | 15 | if (missing(digits)) { 16 | digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) 17 | } else { 18 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 19 | } 20 | 21 | if (missing(transf)) 22 | transf <- FALSE 23 | 24 | if (missing(targs)) 25 | targs <- NULL 26 | 27 | ddd <- list(...) 28 | 29 | .chkdots(ddd, c("time")) 30 | 31 | if (.isTRUE(ddd$time)) 32 | time.start <- proc.time() 33 | 34 | ######################################################################### 35 | 36 | level <- .level(level) 37 | crit <- qnorm(level/2, lower.tail=FALSE) 38 | 39 | beta <- x$beta 40 | ci.lb <- beta - crit * x$se 41 | ci.ub <- beta + crit * x$se 42 | 43 | ### if requested, apply transformation function 44 | 45 | if (.isTRUE(transf)) # if transf=TRUE, apply exp transformation to ORs 46 | transf <- exp 47 | 48 | if (is.function(transf)) { 49 | if (is.null(targs)) { 50 | beta <- sapply(beta, transf) 51 | ci.lb <- sapply(ci.lb, transf) 52 | ci.ub <- sapply(ci.ub, transf) 53 | } else { 54 | if (!is.primitive(transf) && !is.null(targs) && length(formals(transf)) == 1L) 55 | stop(mstyle$stop("Function specified via 'transf' does not appear to have an argument for 'targs'.")) 56 | beta <- sapply(beta, transf, targs) 57 | ci.lb <- sapply(ci.lb, transf, targs) 58 | ci.ub <- sapply(ci.ub, transf, targs) 59 | } 60 | } 61 | 62 | ### make sure order of intervals is always increasing 63 | 64 | tmp <- .psort(ci.lb, ci.ub) 65 | ci.lb <- tmp[,1] 66 | ci.ub <- tmp[,2] 67 | 68 | ######################################################################### 69 | 70 | res <- cbind(estimate=beta, ci.lb, ci.ub) 71 | res <- list(fixed=res) 72 | rownames(res$fixed) <- "" 73 | 74 | res$digits <- digits 75 | 76 | if (.isTRUE(ddd$time)) { 77 | time.end <- proc.time() 78 | .print.time(unname(time.end - time.start)[3]) 79 | } 80 | 81 | class(res) <- "confint.rma" 82 | return(res) 83 | 84 | } 85 | -------------------------------------------------------------------------------- /R/cooks.distance.rma.uni.r: -------------------------------------------------------------------------------- 1 | cooks.distance.rma.uni <- function(model, progbar=FALSE, ...) 2 | influence(model, progbar=progbar, measure="cooks.distance", ...) 3 | -------------------------------------------------------------------------------- /R/cumul.r: -------------------------------------------------------------------------------- 1 | cumul <- function(x, ...) 2 | UseMethod("cumul") 3 | -------------------------------------------------------------------------------- /R/deviance.rma.r: -------------------------------------------------------------------------------- 1 | deviance.rma <- function(object, REML, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | # in case something like logLik(res1, res2) is used 8 | 9 | if (!missing(REML) && inherits(REML, "rma")) 10 | REML <- NULL 11 | 12 | if (missing(REML) || is.null(REML)) { 13 | if (object$method == "REML") { 14 | REML <- TRUE 15 | } else { 16 | REML <- FALSE 17 | } 18 | } 19 | 20 | if (REML) { 21 | val <- object$fit.stats["dev","REML"] 22 | } else { 23 | val <- object$fit.stats["dev","ML"] 24 | } 25 | 26 | return(val) 27 | 28 | } 29 | -------------------------------------------------------------------------------- /R/df.residual.rma.r: -------------------------------------------------------------------------------- 1 | df.residual.rma <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | df.resid <- object$k.eff - object$p.eff 8 | 9 | return(df.resid) 10 | 11 | } 12 | -------------------------------------------------------------------------------- /R/dfbetas.rma.uni.r: -------------------------------------------------------------------------------- 1 | dfbetas.rma.uni <- function(model, progbar=FALSE, ...) 2 | influence(model, progbar=progbar, measure="dfbetas", ...) 3 | -------------------------------------------------------------------------------- /R/dfround.r: -------------------------------------------------------------------------------- 1 | dfround <- function(x, digits, drop0=TRUE) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | if (inherits(x, "matrix") && length(dim(x)) == 2L) 6 | x <- data.frame(x, check.names=FALSE) 7 | 8 | .chkclass(class(x), must="data.frame") 9 | 10 | p <- ncol(x) 11 | 12 | if (missing(digits)) 13 | digits <- 0 14 | 15 | digits <- .expand1(digits, p) 16 | drop0 <- .expand1(drop0, p) 17 | 18 | if (p != length(digits)) 19 | stop(mstyle$stop(paste0("Number of columns in 'x' (", p, ") do not match the length of 'digits' (", length(digits), ")."))) 20 | 21 | if (p != length(drop0)) 22 | stop(mstyle$stop(paste0("Number of columns in 'x' (", p, ") do not match the length of 'drop0' (", length(drop0), ")."))) 23 | 24 | if (!is.numeric(digits)) 25 | stop(mstyle$stop("Argument 'digits' must be a numeric vector.")) 26 | 27 | if (!is.logical(drop0)) 28 | stop(mstyle$stop("Argument 'drop0' must be a logical vector.")) 29 | 30 | for (i in seq_len(p)) { 31 | if (!is.numeric(x[[i]])) 32 | next 33 | if (drop0[i]) { 34 | x[[i]] <- round(x[[i]], digits[i]) 35 | } else { 36 | x[[i]] <- formatC(x[[i]], format="f", digits=digits[i]) 37 | } 38 | } 39 | 40 | return(x) 41 | 42 | } 43 | -------------------------------------------------------------------------------- /R/fitstats.r: -------------------------------------------------------------------------------- 1 | fitstats <- function (object, ...) 2 | UseMethod("fitstats") 3 | -------------------------------------------------------------------------------- /R/fitstats.rma.r: -------------------------------------------------------------------------------- 1 | fitstats.rma <- function(object, ..., REML) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | ### unless REML argument is specified, method of first object determines 8 | ### whether to show fit statistics based on the ML or REML likelihood 9 | 10 | if (missing(REML)) { 11 | if (object$method == "REML") { 12 | REML <- TRUE 13 | } else { 14 | REML <- FALSE 15 | } 16 | } 17 | 18 | if (missing(...)) { 19 | 20 | ### if there is just 'object' 21 | 22 | if (REML) { 23 | out <- cbind(object$fit.stats$REML) 24 | colnames(out) <- "REML" 25 | } else { 26 | out <- cbind(object$fit.stats$ML) 27 | colnames(out) <- "ML" 28 | } 29 | 30 | } else { 31 | 32 | ### if there is 'object' and additional objects via ... 33 | 34 | if (REML) { 35 | out <- sapply(list(object, ...), function(x) x$fit.stats$REML) 36 | } else { 37 | out <- sapply(list(object, ...), function(x) x$fit.stats$ML) 38 | } 39 | 40 | out <- data.frame(out) 41 | 42 | ### get names of objects; same idea as in stats:::AIC.default 43 | 44 | cl <- match.call() 45 | cl$REML <- NULL 46 | names(out) <- as.character(cl[-1L]) 47 | 48 | ### check that all models were fitted to the same data 49 | 50 | chksums <- sapply(list(object, ...), function(x) x$chksumyi) 51 | 52 | if (any(chksums[1] != chksums)) 53 | warning(mstyle$warning("Models not all fitted to the same data."), call.=FALSE) 54 | 55 | } 56 | 57 | rownames(out) <- c("logLik:", "deviance:", "AIC:", "BIC:", "AICc:") 58 | return(out) 59 | 60 | #print(fmtx(out, object$digits[["fit"]]), quote=FALSE) 61 | #invisible(out) 62 | 63 | } 64 | -------------------------------------------------------------------------------- /R/fitted.rma.r: -------------------------------------------------------------------------------- 1 | fitted.rma <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | na.act <- getOption("na.action") 8 | 9 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 10 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 11 | 12 | if (is.null(object$X.f)) 13 | stop(mstyle$stop("Information needed to compute the fitted values is not available in the model object.")) 14 | 15 | ### note: fitted values can be calculated for all studies including those that 16 | ### have NA on yi/vi (and with "na.pass" these will be provided); but if there 17 | ### is an NA in the X's, then the fitted value will also be NA 18 | 19 | out <- c(object$X.f %*% object$beta) 20 | names(out) <- object$slab 21 | 22 | #not.na <- !is.na(out) 23 | 24 | if (na.act == "na.omit") 25 | out <- out[object$not.na] 26 | if (na.act == "na.exclude") 27 | out[!object$not.na] <- NA_real_ 28 | if (na.act == "na.fail" && any(!object$not.na)) 29 | stop(mstyle$stop("Missing values in results.")) 30 | 31 | if (inherits(object, "rma.ls")) { 32 | 33 | out <- list(location = out) 34 | out$scale <- c(object$Z.f %*% object$alpha) 35 | 36 | names(out$scale) <- object$slab 37 | 38 | #not.na <- !is.na(out$scale) 39 | 40 | if (na.act == "na.omit") 41 | out$scale <- out$scale[object$not.na] 42 | if (na.act == "na.exclude") 43 | out$scale[!object$not.na] <- NA_real_ 44 | if (na.act == "na.fail" && any(!object$not.na)) 45 | stop(mstyle$stop("Missing values in results.")) 46 | 47 | } 48 | 49 | return(out) 50 | 51 | } 52 | -------------------------------------------------------------------------------- /R/forest.r: -------------------------------------------------------------------------------- 1 | forest <- function(x, ...) 2 | UseMethod("forest") 3 | -------------------------------------------------------------------------------- /R/formula.rma.r: -------------------------------------------------------------------------------- 1 | formula.rma <- function(x, type="mods", ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="rma") 6 | 7 | type <- match.arg(type, c("mods", "yi", "scale")) 8 | 9 | if (type == "scale" && x$model != "rma.ls") 10 | stop(mstyle$stop("Can only use type='scale' for location-scale models.")) 11 | 12 | if (type == "mods") 13 | return(x$formula.mods) 14 | 15 | if (type == "yi") 16 | return(x$formula.yi) 17 | 18 | if (type == "scale") 19 | return(x$formula.scale) 20 | 21 | } 22 | -------------------------------------------------------------------------------- /R/funnel.r: -------------------------------------------------------------------------------- 1 | funnel <- function(x, ...) 2 | UseMethod("funnel") 3 | -------------------------------------------------------------------------------- /R/gosh.r: -------------------------------------------------------------------------------- 1 | gosh <- function(x, ...) 2 | UseMethod("gosh") 3 | -------------------------------------------------------------------------------- /R/hatvalues.rma.mv.r: -------------------------------------------------------------------------------- 1 | hatvalues.rma.mv <- function(model, type="diagonal", ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(model), must="rma.mv") 6 | 7 | na.act <- getOption("na.action") 8 | 9 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 10 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 11 | 12 | if (is.null(model$M) || is.null(model$X)) 13 | stop(mstyle$stop("Information needed to compute the hat values is not available in the model object.")) 14 | 15 | type <- match.arg(type, c("diagonal", "matrix")) 16 | 17 | ######################################################################### 18 | 19 | x <- model 20 | 21 | if (is.null(x$W)) { 22 | W <- chol2inv(chol(x$M)) 23 | stXWX <- chol2inv(chol(as.matrix(t(x$X) %*% W %*% x$X))) 24 | H <- as.matrix(x$X %*% stXWX %*% crossprod(x$X,W)) 25 | #H <- as.matrix(x$X %*% x$vb %*% crossprod(x$X,W)) # x$vb may have been changed through robust() 26 | } else { 27 | A <- x$W 28 | stXAX <- chol2inv(chol(as.matrix(t(x$X) %*% A %*% x$X))) 29 | H <- as.matrix(x$X %*% stXAX %*% crossprod(x$X,A)) 30 | } 31 | 32 | ######################################################################### 33 | 34 | if (type == "diagonal") { 35 | 36 | hii <- rep(NA_real_, x$k.f) 37 | hii[x$not.na] <- as.vector(diag(H)) 38 | hii[hii > 1 - 10 * .Machine$double.eps] <- 1 # as in lm.influence() 39 | names(hii) <- x$slab 40 | 41 | if (na.act == "na.omit") 42 | hii <- hii[x$not.na] 43 | 44 | if (na.act == "na.fail" && any(!x$not.na)) 45 | stop(mstyle$stop("Missing values in results.")) 46 | 47 | return(hii) 48 | 49 | } 50 | 51 | if (type == "matrix") { 52 | 53 | Hfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) 54 | Hfull[x$not.na, x$not.na] <- H 55 | 56 | rownames(Hfull) <- x$slab 57 | colnames(Hfull) <- x$slab 58 | 59 | if (na.act == "na.omit") 60 | Hfull <- Hfull[x$not.na, x$not.na, drop=FALSE] 61 | 62 | if (na.act == "na.fail" && any(!x$not.na)) 63 | stop(mstyle$stop("Missing values in results.")) 64 | 65 | return(Hfull) 66 | 67 | } 68 | 69 | } 70 | -------------------------------------------------------------------------------- /R/hatvalues.rma.uni.r: -------------------------------------------------------------------------------- 1 | hatvalues.rma.uni <- function(model, type="diagonal", ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(model), must="rma.uni", notav=c("rma.uni.selmodel", "rma.gen")) 6 | 7 | na.act <- getOption("na.action") 8 | 9 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 10 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 11 | 12 | if (is.null(model$vi) || is.null(model$X)) 13 | stop(mstyle$stop("Information needed to compute the hat values is not available in the model object.")) 14 | 15 | type <- match.arg(type, c("diagonal", "matrix")) 16 | 17 | ######################################################################### 18 | 19 | x <- model 20 | 21 | if (x$weighted) { 22 | if (is.null(x$weights)) { 23 | W <- diag(1/(x$vi + x$tau2), nrow=x$k, ncol=x$k) 24 | stXWX <- .invcalc(X=x$X, W=W, k=x$k) 25 | H <- x$X %*% stXWX %*% crossprod(x$X,W) 26 | #H <- x$X %*% (x$vb / x$s2w) %*% crossprod(x$X,W) # x$vb may be changed through robust() (and when test="knha") 27 | } else { 28 | A <- diag(x$weights, nrow=x$k, ncol=x$k) 29 | stXAX <- .invcalc(X=x$X, W=A, k=x$k) 30 | H <- x$X %*% stXAX %*% crossprod(x$X,A) 31 | } 32 | } else { 33 | stXX <- .invcalc(X=x$X, W=diag(x$k), k=x$k) 34 | H <- x$X %*% tcrossprod(stXX,x$X) 35 | } 36 | 37 | ######################################################################### 38 | 39 | if (type == "diagonal") { 40 | 41 | hii <- rep(NA_real_, x$k.f) 42 | hii[x$not.na] <- diag(H) 43 | hii[hii > 1 - 10 * .Machine$double.eps] <- 1 # as in lm.influence() 44 | names(hii) <- x$slab 45 | 46 | if (na.act == "na.omit") 47 | hii <- hii[x$not.na] 48 | 49 | if (na.act == "na.fail" && any(!x$not.na)) 50 | stop(mstyle$stop("Missing values in results.")) 51 | 52 | return(hii) 53 | 54 | } 55 | 56 | if (type == "matrix") { 57 | 58 | Hfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) 59 | Hfull[x$not.na, x$not.na] <- H 60 | 61 | rownames(Hfull) <- x$slab 62 | colnames(Hfull) <- x$slab 63 | 64 | if (na.act == "na.omit") 65 | Hfull <- Hfull[x$not.na, x$not.na, drop=FALSE] 66 | 67 | if (na.act == "na.fail" && any(!x$not.na)) 68 | stop(mstyle$stop("Missing values in results.")) 69 | 70 | return(Hfull) 71 | 72 | } 73 | 74 | } 75 | -------------------------------------------------------------------------------- /R/hc.r: -------------------------------------------------------------------------------- 1 | hc <- function(object, ...) 2 | UseMethod("hc") 3 | -------------------------------------------------------------------------------- /R/labbe.r: -------------------------------------------------------------------------------- 1 | labbe <- function(x, ...) 2 | UseMethod("labbe") 3 | -------------------------------------------------------------------------------- /R/leave1out.r: -------------------------------------------------------------------------------- 1 | leave1out <- function(x, ...) 2 | UseMethod("leave1out") 3 | -------------------------------------------------------------------------------- /R/logLik.rma.r: -------------------------------------------------------------------------------- 1 | logLik.rma <- function(object, REML, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | # in case something like logLik(res1, res2) is used 8 | 9 | if (!missing(REML) && inherits(REML, "rma")) 10 | REML <- NULL 11 | 12 | if (missing(REML) || is.null(REML)) { 13 | if (object$method == "REML") { 14 | REML <- TRUE 15 | } else { 16 | REML <- FALSE 17 | } 18 | } 19 | 20 | if (REML) { 21 | val <- object$fit.stats["ll","REML"] 22 | } else { 23 | val <- object$fit.stats["ll","ML"] 24 | } 25 | 26 | attr(val, "nall") <- object$k.eff 27 | attr(val, "nobs") <- object$k.eff - ifelse(REML, object$p.eff, 0) 28 | attr(val, "df") <- object$parms 29 | 30 | class(val) <- "logLik" 31 | return(val) 32 | 33 | } 34 | -------------------------------------------------------------------------------- /R/metafor.news.r: -------------------------------------------------------------------------------- 1 | metafor.news <- function() 2 | news(package="metafor") 3 | -------------------------------------------------------------------------------- /R/methods.confint.rma.r: -------------------------------------------------------------------------------- 1 | ############################################################################ 2 | 3 | as.data.frame.confint.rma <- function(x, ...) { 4 | 5 | .chkclass(class(x), must="confint.rma") 6 | 7 | ddd <- list(...) 8 | 9 | .chkdots(ddd, c("fixed", "random")) 10 | 11 | fixed <- .chkddd(ddd$fixed, is.element("fixed", names(x))) 12 | random <- .chkddd(ddd$random, is.element("random", names(x))) 13 | 14 | if (fixed) { 15 | df <- x$fixed 16 | } else { 17 | df <- NULL 18 | } 19 | 20 | if (random && is.element("random", names(x))) 21 | df <- rbind(df, x$random) 22 | 23 | return(df) 24 | 25 | } 26 | 27 | as.data.frame.list.confint.rma <- function(x, ...) { 28 | 29 | .chkclass(class(x), must="list.confint.rma") 30 | 31 | x$digits <- NULL # remove digits elements 32 | 33 | df <- lapply(x, as.data.frame) 34 | df <- do.call(rbind, df) 35 | return(df) 36 | 37 | } 38 | 39 | ############################################################################ 40 | -------------------------------------------------------------------------------- /R/methods.vif.rma.r: -------------------------------------------------------------------------------- 1 | ############################################################################ 2 | 3 | as.data.frame.vif.rma <- function(x, ...) { 4 | 5 | .chkclass(class(x), must="vif.rma") 6 | 7 | if (!is.null(x$alpha)) { 8 | 9 | tab <- list(beta = as.data.frame(x[[1]], ...), alpha = as.data.frame(x[[2]], ...)) 10 | 11 | } else { 12 | 13 | tab <- data.frame(spec = sapply(x$vif, function(x) x$spec), 14 | coefs = sapply(x$vif, function(x) x$coefs), 15 | m = sapply(x$vif, function(x) x$m), 16 | vif = sapply(x$vif, function(x) x$vif), 17 | sif = sapply(x$vif, function(x) x$sif)) 18 | 19 | # add proportions if they are available 20 | 21 | if (!is.null(x$prop)) 22 | tab$prop <- x$prop 23 | 24 | #names(tab)[2] <- "coef(s)" 25 | #names(tab)[4] <- "(g)vif" 26 | #names(tab)[5] <- "(g)sif" 27 | 28 | # if all btt/att specifications are numeric, remove the 'spec' column 29 | 30 | if (all(substr(tab$spec, 1, 1) %in% as.character(1:9))) 31 | tab$spec <- NULL 32 | 33 | # just use numbers for row names when btt was specified 34 | 35 | if (isTRUE(x$bttspec) || isTRUE(x$attspec)) 36 | rownames(tab) <- NULL 37 | 38 | } 39 | 40 | return(tab) 41 | 42 | } 43 | 44 | ############################################################################ 45 | -------------------------------------------------------------------------------- /R/mfopt.r: -------------------------------------------------------------------------------- 1 | setmfopt <- function(...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | mfopts <- getOption("metafor") 6 | 7 | if (is.null(mfopts) || !is.list(mfopts)) { 8 | options("metafor" = list(space=TRUE)) 9 | mfopts <- getOption("metafor") 10 | } 11 | 12 | newopts <- list(...) 13 | 14 | for (opt in names(newopts)) { 15 | if (opt == "space" && !is.null(newopts[[opt]]) && !is.logical(newopts[[opt]])) 16 | stop(mstyle$stop("'space' must be a logical.")) 17 | if (opt == "digits" && !is.null(newopts[[opt]]) && !is.vector(newopts[[opt]], mode="numeric")) 18 | stop(mstyle$stop("'digits' must be a numeric vector.")) 19 | if (opt == "style" && !is.logical(newopts[[opt]]) && !is.null(newopts[[opt]]) && !is.list(newopts[[opt]])) 20 | stop(mstyle$stop("'style' must be a list.")) 21 | if (opt == "theme" && !is.null(newopts[[opt]]) && !is.element(newopts[[opt]], c("default", "light", "dark", "auto", "custom", "default2", "light2", "dark2", "auto2", "custom2"))) 22 | stop(mstyle$stop("'theme' must be either 'default(2)', 'light(2)', 'dark(2)', 'auto(2)', or 'custom(2)'.")) 23 | if (opt == "fg" && !is.null(newopts[[opt]]) && !is.character(newopts[[opt]])) 24 | stop(mstyle$stop("'fg' must be a character string.")) 25 | if (opt == "bg" && !is.null(newopts[[opt]]) && !is.character(newopts[[opt]])) 26 | stop(mstyle$stop("'bg' must be a character string.")) 27 | mfopts[[opt]] <- newopts[[opt]] 28 | } 29 | 30 | options("metafor" = mfopts) 31 | 32 | } 33 | 34 | getmfopt <- function(x, default=NULL) { 35 | 36 | opt <- getOption("metafor") 37 | 38 | if (!missing(x)) { 39 | x <- as.character(substitute(x)) 40 | opt <- opt[[x]] 41 | } 42 | 43 | if (is.null(opt)) { 44 | return(default) 45 | } else { 46 | return(opt) 47 | } 48 | 49 | } 50 | -------------------------------------------------------------------------------- /R/misc.func.hidden.evals.r: -------------------------------------------------------------------------------- 1 | ############################################################################ 2 | 3 | ### to register getfit method for 'rma.uni' and 'rma.mv' objects: eval(metafor:::.glmulti) 4 | 5 | .glmulti <- str2expression(" 6 | 7 | if (!(\"glmulti\" %in% .packages())) 8 | stop(\"Must load the 'glmulti' package first to use this code.\") 9 | 10 | setOldClass(\"rma.uni\") 11 | 12 | setMethod(\"getfit\", \"rma.uni\", function(object, ...) { 13 | if (object$test==\"z\") { 14 | cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=Inf) 15 | } else { 16 | cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=object$k-object$p) 17 | } 18 | }) 19 | 20 | setOldClass(\"rma.mv\") 21 | 22 | setMethod(\"getfit\", \"rma.mv\", function(object, ...) { 23 | if (object$test==\"z\") { 24 | cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=Inf) 25 | } else { 26 | cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=object$k-object$p) 27 | } 28 | }) 29 | 30 | setOldClass(\"rma.glmm\") 31 | 32 | setMethod(\"getfit\", \"rma.glmm\", function(object, ...) { 33 | if (object$test==\"z\") { 34 | cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=Inf) 35 | } else { 36 | cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=object$k-object$p) 37 | } 38 | }) 39 | 40 | ") 41 | 42 | ### helper functions to make MuMIn work together with metafor: eval(metafor:::.MuMIn) 43 | 44 | .MuMIn <- str2expression(" 45 | 46 | makeArgs.rma <- function (obj, termNames, comb, opt, ...) { 47 | ret <- MuMIn:::makeArgs.default(obj, termNames, comb, opt) 48 | names(ret)[1L] <- \"mods\" 49 | ret 50 | } 51 | 52 | coefTable.rma <- function (model, ...) { 53 | MuMIn:::.makeCoefTable(model$b, model$se, coefNames = rownames(model$b)) 54 | } 55 | 56 | ") 57 | 58 | ### helper functions to make mice work together with metafor (note: no longer 59 | ### needed, as there are glance and tidy methods for rma objects in broom now) 60 | 61 | #.mice <- str2expression(" 62 | # 63 | #glance.rma <- function (x, ...) 64 | # data.frame(df.residual=df.residual(x)) 65 | # 66 | #tidy.rma <- function (x, ...) { 67 | # ret <- coef(summary(x)) 68 | # colnames(ret)[2] <- \"std.error\" 69 | # ret$term <- rownames(ret) 70 | # return(ret) 71 | #} 72 | # 73 | #") 74 | 75 | ############################################################################ 76 | -------------------------------------------------------------------------------- /R/misc.func.hidden.tes.r: -------------------------------------------------------------------------------- 1 | .tes.intfun <- function(x, theta, tau, sei, H0, alternative, crit) { 2 | if (alternative == "two.sided") 3 | pow <- (pnorm(crit, mean=(x-H0)/sei, sd=1, lower.tail=FALSE) + pnorm(-crit, mean=(x-H0)/sei, sd=1, lower.tail=TRUE)) 4 | if (alternative == "greater") 5 | pow <- pnorm(crit, mean=(x-H0)/sei, sd=1, lower.tail=FALSE) 6 | if (alternative == "less") 7 | pow <- pnorm(crit, mean=(x-H0)/sei, sd=1, lower.tail=TRUE) 8 | res <- pow * dnorm(x, theta, tau) 9 | return(res) 10 | } 11 | 12 | .tes.lim <- function(theta, yi, vi, H0, alternative, alpha, tau2, test, tes.alternative, progbar, tes.alpha, correct, rel.tol, subdivisions, tau2.lb) { 13 | pval <- tes(x=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, theta=theta, tau2=tau2, test=test, tes.alternative=tes.alternative, progbar=progbar, 14 | tes.alpha=tes.alpha, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb, find.lim=FALSE)$pval 15 | #cat("theta = ", theta, " pval = ", pval, "\n") 16 | return(pval - tes.alpha) 17 | } 18 | -------------------------------------------------------------------------------- /R/model.matrix.rma.r: -------------------------------------------------------------------------------- 1 | model.matrix.rma <- function(object, asdf=FALSE, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | na.act <- getOption("na.action") 8 | 9 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 10 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 11 | 12 | ### note: lm() always returns X (never the full model matrix, even with na.exclude or na.pass) 13 | ### but it seems a bit more logical to actually return X.f in that case 14 | 15 | if (na.act == "na.omit") 16 | out <- object$X 17 | 18 | if (na.act == "na.exclude" || na.act == "na.pass") 19 | out <- object$X.f 20 | 21 | if (na.act == "na.fail" && any(!object$not.na)) 22 | stop(mstyle$stop("Missing values in results.")) 23 | 24 | if (asdf) 25 | out <- as.data.frame(out) 26 | 27 | if (inherits(object, "rma.ls")) { 28 | 29 | out <- list(location = out) 30 | 31 | if (na.act == "na.omit") 32 | out$scale <- object$Z 33 | 34 | if (na.act == "na.exclude" || na.act == "na.pass") 35 | out$scale <- object$Z.f 36 | 37 | if (na.act == "na.fail" && any(!object$not.na)) 38 | stop(mstyle$stop("Missing values in results.")) 39 | 40 | if (asdf) 41 | out$scale <- as.data.frame(out$scale) 42 | 43 | } 44 | 45 | return(out) 46 | 47 | } 48 | -------------------------------------------------------------------------------- /R/nobs.rma.r: -------------------------------------------------------------------------------- 1 | nobs.rma <- function(object, all=FALSE, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | if (all) { 8 | n.obs <- c(studies = object$k, 9 | data = object$k.all, 10 | subset = sum(object$subset), 11 | not.na = sum(object$not.na), 12 | effective = object$k.eff, 13 | df.residual = object$k.eff - object$p.eff) 14 | } else { 15 | #n.obs <- object$k.eff - ifelse(object$method == "REML", 1, 0) * object$p.eff 16 | n.obs <- object$k 17 | } 18 | 19 | return(n.obs) 20 | 21 | } 22 | -------------------------------------------------------------------------------- /R/pairmat.r: -------------------------------------------------------------------------------- 1 | pairmat <- function(x, btt, btt2, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | if (missing(x)) { 6 | x <- .getfromenv("pairmat", envir=.metafor) 7 | } else { 8 | if (is.atomic(x)) { 9 | btt <- x 10 | x <- .getfromenv("pairmat", envir=.metafor) 11 | } 12 | } 13 | 14 | if (is.null(x)) 15 | stop(mstyle$stop("Need to specify the 'x' argument."), call.=FALSE) 16 | 17 | .chkclass(class(x), must="rma") 18 | 19 | if (x$int.only) 20 | stop(mstyle$stop("Cannot construct contrast matrices for intercept-only models.")) 21 | 22 | if (missing(btt) || is.null(btt)) 23 | stop(mstyle$stop("Need to specify the 'btt' argument."), call.=FALSE) 24 | 25 | ddd <- list(...) 26 | 27 | .chkdots(ddd, c("fixed")) 28 | 29 | fixed <- .chkddd(ddd$fixed, FALSE, .isTRUE(ddd$fixed)) 30 | 31 | ######################################################################### 32 | 33 | btt <- .set.btt(btt, x$p, x$int.incl, colnames(x$X), fixed=fixed) 34 | 35 | p <- length(btt) 36 | 37 | if (p == 1L) 38 | stop(mstyle$stop("Need to specify multiple coefficients via argument 'btt' for pairwise comparisons."), call.=FALSE) 39 | 40 | names <- rownames(x$beta) 41 | connames <- rep("", p*(p-1)/2) 42 | 43 | X <- matrix(0, nrow=p*(p-1)/2, ncol=x$p) 44 | row <- 0 45 | 46 | for (i in 1:(p-1)) { 47 | btti <- btt[i] 48 | for (j in (i+1):p) { 49 | bttj <- btt[j] 50 | row <- row + 1 51 | X[row,btti] <- -1 52 | X[row,bttj] <- +1 53 | connames[row] <- paste0(names[btti], "-", names[bttj]) 54 | } 55 | } 56 | 57 | rownames(X) <- connames 58 | 59 | ######################################################################### 60 | 61 | ### in case btt2 is specified, add these coefficients to X 62 | 63 | if (!missing(btt2)) { 64 | 65 | btt <- .set.btt(btt2, x$p, x$int.incl, colnames(x$X), fixed=fixed) 66 | 67 | p <- length(btt) 68 | 69 | Xadd <- matrix(0, nrow=p, ncol=x$p) 70 | 71 | for (i in 1:p) { 72 | Xadd[i,btt[i]] <- 1 73 | } 74 | 75 | rownames(Xadd) <- names[btt] 76 | 77 | X <- rbind(Xadd, X) 78 | 79 | } 80 | 81 | ######################################################################### 82 | 83 | return(X) 84 | 85 | } 86 | -------------------------------------------------------------------------------- /R/permutest.r: -------------------------------------------------------------------------------- 1 | permutest <- function(x, ...) 2 | UseMethod("permutest") 3 | -------------------------------------------------------------------------------- /R/plot.rma.glmm.r: -------------------------------------------------------------------------------- 1 | plot.rma.glmm <- function(x, qqplot=FALSE, ...) { 2 | 3 | ######################################################################### 4 | 5 | mstyle <- .get.mstyle() 6 | 7 | .chkclass(class(x), must="rma.glmm", notav="rma.glmm") 8 | 9 | } 10 | -------------------------------------------------------------------------------- /R/plot.rma.mh.r: -------------------------------------------------------------------------------- 1 | plot.rma.mh <- function(x, qqplot=FALSE, ...) { 2 | 3 | ######################################################################### 4 | 5 | mstyle <- .get.mstyle() 6 | 7 | .chkclass(class(x), must="rma.mh") 8 | 9 | na.act <- getOption("na.action") 10 | on.exit(options(na.action=na.act), add=TRUE) 11 | 12 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 13 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 14 | 15 | .start.plot() 16 | 17 | # if no plotting device is open or mfrow is too small, set mfrow appropriately 18 | if (dev.cur() == 1L || prod(par("mfrow")) < 4L) 19 | par(mfrow=n2mfrow(4)) 20 | on.exit(par(mfrow=c(1L,1L)), add=TRUE) 21 | 22 | bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) 23 | col.na <- .coladj(par("bg","fg"), dark=0.2, light=-0.2) 24 | 25 | ######################################################################### 26 | 27 | forest(x, ...) 28 | title("Forest Plot", ...) 29 | 30 | ######################################################################### 31 | 32 | funnel(x, ...) 33 | title("Funnel Plot", ...) 34 | 35 | ######################################################################### 36 | 37 | radial(x, ...) 38 | title("Radial Plot", ...) 39 | 40 | ######################################################################### 41 | 42 | if (qqplot) { 43 | 44 | qqnorm(x, ...) 45 | 46 | } else { 47 | 48 | options(na.action = "na.pass") 49 | z <- rstandard(x)$z 50 | options(na.action = na.act) 51 | 52 | not.na <- !is.na(z) 53 | 54 | if (na.act == "na.omit") { 55 | z <- z[not.na] 56 | ids <- x$ids[not.na] 57 | not.na <- not.na[not.na] 58 | } 59 | 60 | if (na.act == "na.exclude" || na.act == "na.pass") 61 | ids <- x$ids 62 | 63 | k <- length(z) 64 | 65 | plot(NA, NA, xlim=c(1,k), ylim=c(min(z, -2, na.rm=TRUE), max(z, 2, na.rm=TRUE)), xaxt="n", xlab="Study", ylab="", bty="l", ...) 66 | lines(seq_len(k)[not.na], z[not.na], col=col.na, ...) 67 | lines(seq_len(k), z, ...) 68 | points(x=seq_len(k), y=z, pch=21, bg=bg, ...) 69 | axis(side=1, at=seq_len(k), labels=ids, ...) 70 | abline(h=0, lty="dashed", ...) 71 | abline(h=c(qnorm(0.025),qnorm(0.975)), lty="dotted", ...) 72 | 73 | title("Standardized Residuals", ...) 74 | 75 | } 76 | 77 | ######################################################################### 78 | 79 | invisible() 80 | 81 | } 82 | -------------------------------------------------------------------------------- /R/plot.rma.mv.r: -------------------------------------------------------------------------------- 1 | plot.rma.mv <- function(x, qqplot=FALSE, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="rma.mv", notav="rma.mv") 6 | 7 | } 8 | -------------------------------------------------------------------------------- /R/plot.rma.peto.r: -------------------------------------------------------------------------------- 1 | plot.rma.peto <- function(x, qqplot=FALSE, ...) { 2 | 3 | ######################################################################### 4 | 5 | mstyle <- .get.mstyle() 6 | 7 | .chkclass(class(x), must="rma.peto") 8 | 9 | na.act <- getOption("na.action") 10 | on.exit(options(na.action=na.act), add=TRUE) 11 | 12 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 13 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 14 | 15 | .start.plot() 16 | 17 | # if no plotting device is open or mfrow is too small, set mfrow appropriately 18 | if (dev.cur() == 1L || prod(par("mfrow")) < 4L) 19 | par(mfrow=n2mfrow(4)) 20 | on.exit(par(mfrow=c(1L,1L)), add=TRUE) 21 | 22 | bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) 23 | col.na <- .coladj(par("bg","fg"), dark=0.2, light=-0.2) 24 | 25 | ######################################################################### 26 | 27 | forest(x, ...) 28 | title("Forest Plot", ...) 29 | 30 | ######################################################################### 31 | 32 | funnel(x, ...) 33 | title("Funnel Plot", ...) 34 | 35 | ######################################################################### 36 | 37 | radial(x, ...) 38 | title("Radial Plot", ...) 39 | 40 | ######################################################################### 41 | 42 | if (qqplot) { 43 | 44 | qqnorm(x, ...) 45 | 46 | } else { 47 | 48 | options(na.action = "na.pass") 49 | z <- rstandard(x)$z 50 | options(na.action = na.act) 51 | 52 | not.na <- !is.na(z) 53 | 54 | if (na.act == "na.omit") { 55 | z <- z[not.na] 56 | ids <- x$ids[not.na] 57 | not.na <- not.na[not.na] 58 | } 59 | 60 | if (na.act == "na.exclude" || na.act == "na.pass") 61 | ids <- x$ids 62 | 63 | k <- length(z) 64 | 65 | plot(NA, NA, xlim=c(1,k), ylim=c(min(z, -2, na.rm=TRUE), max(z, 2, na.rm=TRUE)), xaxt="n", xlab="Study", ylab="", bty="l", ...) 66 | lines(seq_len(k)[not.na], z[not.na], col=col.na, ...) 67 | lines(seq_len(k), z, ...) 68 | points(x=seq_len(k), y=z, pch=21, bg=bg, ...) 69 | axis(side=1, at=seq_len(k), labels=ids, ...) 70 | abline(h=0, lty="dashed", ...) 71 | abline(h=c(qnorm(0.025),qnorm(0.975)), lty="dotted", ...) 72 | 73 | title("Standardized Residuals", ...) 74 | 75 | } 76 | 77 | ######################################################################### 78 | 79 | invisible() 80 | 81 | } 82 | -------------------------------------------------------------------------------- /R/points.regplot.r: -------------------------------------------------------------------------------- 1 | points.regplot <- function(x, ...) { 2 | 3 | .chkclass(class(x), must="regplot") 4 | 5 | ### redraw points 6 | 7 | points(x=x$xi[x$order], y=x$yi[x$order], pch=x$pch[x$order], cex=x$psize[x$order], col=x$col[x$order], bg=x$bg[x$order], ...) 8 | 9 | ### redraw labels 10 | 11 | if (any(x$label)) { 12 | 13 | offset <- attr(x, "offset") 14 | labsize <- attr(x, "labsize") 15 | 16 | for (i in which(x$label)) { 17 | 18 | if (isTRUE(x$yi[i] > x$pred[i])) { # x$pred might be NULL, so use isTRUE() 19 | text(x$xi[i], x$yi[i] + offset[1] + offset[2]*x$psize[i]^offset[3], x$slab[i], cex=labsize, ...) 20 | } else { 21 | text(x$xi[i], x$yi[i] - offset[1] - offset[2]*x$psize[i]^offset[3], x$slab[i], cex=labsize, ...) 22 | } 23 | 24 | } 25 | 26 | } 27 | 28 | invisible() 29 | 30 | } 31 | -------------------------------------------------------------------------------- /R/print.confint.rma.r: -------------------------------------------------------------------------------- 1 | print.confint.rma <- function(x, digits=x$digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="confint.rma") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | .space() 10 | 11 | if (names(x)[1] == "fixed") { 12 | 13 | res.fixed <- cbind(fmtx(x$fixed[,1,drop=FALSE], digits[["est"]]), fmtx(x$fixed[,2:3,drop=FALSE], digits[["ci"]])) 14 | tmp <- capture.output(print(res.fixed, quote=FALSE, right=TRUE)) 15 | .print.table(tmp, mstyle) 16 | 17 | } 18 | 19 | if (is.element("random", names(x))) { 20 | 21 | if (names(x)[1] == "fixed") 22 | cat("\n") 23 | 24 | res.random <- fmtx(x$random, digits[["var"]]) 25 | res.random[,2] <- paste0(x$lb.sign, res.random[,2]) 26 | res.random[,3] <- paste0(x$ub.sign, res.random[,3]) 27 | tmp <- capture.output(print(res.random, quote=FALSE, right=TRUE)) 28 | .print.table(tmp, mstyle) 29 | 30 | ### this can only (currently) happen for 'rma.uni' models 31 | 32 | if (x$ci.null) 33 | message(mstyle$message(paste0("\nThe upper and lower CI bounds for tau^2 both fall below ", round(x$tau2.min,4), ".\nThe CIs are therefore equal to the null/empty set."))) 34 | 35 | } 36 | 37 | .space() 38 | 39 | invisible() 40 | 41 | } 42 | -------------------------------------------------------------------------------- /R/print.deltamethod.r: -------------------------------------------------------------------------------- 1 | print.deltamethod <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="deltamethod") 6 | 7 | if (missing(digits)) { 8 | digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) 9 | } else { 10 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 11 | } 12 | 13 | .space() 14 | 15 | res.table <- data.frame(estimate=fmtx(c(x$tab$coef), digits[["est"]]), se=fmtx(x$tab$se, digits[["se"]]), zval=fmtx(x$tab$zval, digits[["test"]]), pval=fmtp(x$tab$pval, digits[["pval"]]), ci.lb=fmtx(x$tab$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$tab$ci.ub, digits[["ci"]])) 16 | 17 | rownames(res.table) <- rownames(x$tab) 18 | 19 | signif <- symnum(x$tab$pval, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) 20 | 21 | if (signif.stars) { 22 | res.table <- cbind(res.table, signif) 23 | colnames(res.table)[ncol(res.table)] <- "" 24 | } 25 | 26 | if (length(x$tab$coef) == 1L) 27 | res.table <- res.table[1,] 28 | 29 | if (length(x$tab$coef) == 1L) { 30 | tmp <- capture.output(.print.vector(res.table)) 31 | } else { 32 | tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) 33 | } 34 | 35 | #tmp[1] <- paste0(tmp[1], "\u200b") 36 | .print.table(tmp, mstyle) 37 | 38 | if (signif.legend) { 39 | cat("\n") 40 | cat(mstyle$legend("---")) 41 | cat("\n") 42 | cat(mstyle$legend("Signif. codes: "), mstyle$legend(attr(signif, "legend"))) 43 | cat("\n") 44 | } 45 | 46 | .space() 47 | 48 | invisible() 49 | 50 | } 51 | -------------------------------------------------------------------------------- /R/print.escalc.r: -------------------------------------------------------------------------------- 1 | print.escalc <- function(x, digits=attr(x,"digits"), ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="escalc") 6 | 7 | attr(x, "class") <- NULL 8 | 9 | digits <- .get.digits(digits=digits, xdigits=attr(x, "digits"), dmiss=FALSE) 10 | 11 | ### get positions of the variable names in the object 12 | ### note: if the object no longer contains a particular variable, match() returns NA; 13 | ### use na.omit(), so that length() is then zero (as needed for if statements below) 14 | 15 | yi.pos <- na.omit(match(attr(x, "yi.names"), names(x))) 16 | vi.pos <- na.omit(match(attr(x, "vi.names"), names(x))) 17 | sei.pos <- na.omit(match(attr(x, "sei.names"), names(x))) 18 | zi.pos <- na.omit(match(attr(x, "zi.names"), names(x))) 19 | pval.pos <- na.omit(match(attr(x, "pval.names"), names(x))) 20 | ci.lb.pos <- na.omit(match(attr(x, "ci.lb.names"), names(x))) 21 | ci.ub.pos <- na.omit(match(attr(x, "ci.ub.names"), names(x))) 22 | 23 | ### get rownames attribute so we can back-assign it 24 | 25 | rnames <- attr(x, "row.names") 26 | 27 | ### for printing, turn expressions into strings 28 | 29 | is.expr <- sapply(x, is.expression) 30 | x[is.expr] <- lapply(x[is.expr], as.character) 31 | 32 | ### turn x into a regular data frame 33 | 34 | x <- data.frame(x) 35 | rownames(x) <- rnames 36 | 37 | ### round variables according to the digits argument 38 | 39 | if (length(yi.pos) > 0L) 40 | x[yi.pos] <- apply(x[yi.pos], 2, fmtx, digits[["est"]]) 41 | 42 | if (length(vi.pos) > 0L) 43 | x[vi.pos] <- apply(x[vi.pos], 2, fmtx, digits[["var"]]) 44 | 45 | if (length(sei.pos) > 0L) 46 | x[sei.pos] <- apply(x[sei.pos], 2, fmtx, digits[["se"]]) 47 | 48 | if (length(zi.pos) > 0L) 49 | x[zi.pos] <- apply(x[zi.pos], 2, fmtx, digits[["test"]]) 50 | 51 | if (length(pval.pos) > 0L) 52 | x[pval.pos] <- apply(x[pval.pos], 2, fmtp, digits[["pval"]]) # note: using fmtp here 53 | 54 | if (length(ci.lb.pos) > 0L) 55 | x[ci.lb.pos] <- apply(x[ci.lb.pos], 2, fmtx, digits[["ci"]]) 56 | 57 | if (length(ci.ub.pos) > 0L) 58 | x[ci.ub.pos] <- apply(x[ci.ub.pos], 2, fmtx, digits[["ci"]]) 59 | 60 | ### print data frame with styling 61 | 62 | .space() 63 | 64 | tmp <- capture.output(print(x, ...)) 65 | .print.table(tmp, mstyle) 66 | 67 | .space() 68 | 69 | } 70 | -------------------------------------------------------------------------------- /R/print.gosh.rma.r: -------------------------------------------------------------------------------- 1 | print.gosh.rma <- function(x, digits=x$digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="gosh.rma") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | .space() 10 | 11 | cat(mstyle$text("Model fits attempted: ")) 12 | cat(mstyle$result(length(x$fit))) 13 | cat("\n") 14 | cat(mstyle$text("Model fits succeeded: ")) 15 | cat(mstyle$result(sum(x$fit))) 16 | cat("\n\n") 17 | 18 | res.table <- matrix(NA_real_, nrow=ncol(x$res), ncol=6) 19 | 20 | res.table[,1] <- apply(x$res, 2, mean, na.rm=TRUE) 21 | res.table[,2] <- apply(x$res, 2, min, na.rm=TRUE) 22 | res.table[,3] <- apply(x$res, 2, quantile, 0.25, na.rm=TRUE) 23 | res.table[,4] <- apply(x$res, 2, quantile, 0.50, na.rm=TRUE) 24 | res.table[,5] <- apply(x$res, 2, quantile, 0.75, na.rm=TRUE) 25 | res.table[,6] <- apply(x$res, 2, max, na.rm=TRUE) 26 | 27 | res.table <- fmtx(res.table, digits[["est"]]) 28 | 29 | colnames(res.table) <- c("mean", "min", "q1", "median", "q3", "max") 30 | rownames(res.table) <- colnames(x$res) 31 | 32 | if (ncol(x$res) == 6) 33 | rownames(res.table)[2] <- "Q" 34 | 35 | ### add blank row before the model coefficients in meta-regression models 36 | 37 | if (ncol(x$res) > 6) 38 | res.table <- rbind(res.table[seq_len(5),], "", res.table[6:nrow(res.table),,drop=FALSE]) 39 | 40 | ### remove row for tau^2 in FE/EE/CE models 41 | 42 | if (is.element(x$method, c("FE","EE","CE"))) 43 | res.table <- res.table[-5,] 44 | 45 | tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) 46 | .print.table(tmp, mstyle) 47 | 48 | .space() 49 | 50 | invisible() 51 | 52 | } 53 | -------------------------------------------------------------------------------- /R/print.hc.rma.uni.r: -------------------------------------------------------------------------------- 1 | print.hc.rma.uni <- function(x, digits=x$digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="hc.rma.uni") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | res.table <- data.frame(method = c(x$method.rma, x$method), 10 | tau2 = fmtx(c(x$tau2.rma, x$tau2), digits[["var"]]), 11 | estimate = fmtx(c(x$beta.rma, x$beta), digits[["est"]]), 12 | se = fmtx(c(x$se.rma, x$se), digits[["se"]]), 13 | ci.lb = fmtx(c(x$ci.lb.rma, x$ci.lb), digits[["ci"]]), 14 | ci.ub = fmtx(c(x$ci.ub.rma, x$ci.ub), digits[["ci"]]), stringsAsFactors=FALSE) 15 | 16 | if (is.na(x$se[1])) 17 | res.table$se <- NULL 18 | 19 | rownames(res.table) <- c("rma", "hc") 20 | 21 | .space() 22 | 23 | tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) 24 | .print.table(tmp, mstyle) 25 | 26 | .space() 27 | 28 | invisible(res.table) 29 | 30 | } 31 | -------------------------------------------------------------------------------- /R/print.infl.rma.uni.r: -------------------------------------------------------------------------------- 1 | print.infl.rma.uni <- function(x, digits=x$digits, infonly=FALSE, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="infl.rma.uni") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | if (x$p == 1) { 10 | 11 | out <- list(rstudent=x$inf$rstudent, dffits=x$inf$dffits, cook.d=x$inf$cook.d, cov.r=x$inf$cov.r, 12 | tau2.del=x$inf$tau2.del, QE.del=x$inf$QE.del, hat=x$inf$hat, weight=x$inf$weight, 13 | dfbs=x$dfbs[[1]], inf=x$inf$inf, slab=x$inf$slab, digits=digits) 14 | class(out) <- "list.rma" 15 | 16 | if (infonly) 17 | out[["select"]] <- !is.na(x$is.infl) & x$is.infl 18 | 19 | } else { 20 | 21 | out <- x[1:2] 22 | out$inf[["digits"]] <- digits 23 | out$dfbs[["digits"]] <- digits 24 | attr(out$inf, ".rmspace") <- TRUE 25 | attr(out$dfbs, ".rmspace") <- TRUE 26 | 27 | if (infonly) { 28 | out$inf[["select"]] <- !is.na(x$is.infl) & x$is.infl 29 | out$dfbs[["select"]] <- !is.na(x$is.infl) & x$is.infl 30 | } 31 | 32 | } 33 | 34 | print(out) 35 | 36 | } 37 | -------------------------------------------------------------------------------- /R/print.list.anova.rma.r: -------------------------------------------------------------------------------- 1 | print.list.anova.rma <- function(x, digits=x[[1]]$digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="list.anova.rma") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x[[1]]$digits, dmiss=FALSE) 8 | 9 | .space() 10 | 11 | res.table <- as.data.frame(x) 12 | 13 | if ("QM" %in% names(res.table)) 14 | res.table$QM <- fmtx(res.table$QM, digits[["test"]]) 15 | if ("QS" %in% names(res.table)) 16 | res.table$QS <- fmtx(res.table$QS, digits[["test"]]) 17 | if ("Fval" %in% names(res.table)) 18 | res.table$Fval <- fmtx(res.table$Fval, digits[["test"]]) 19 | 20 | signif <- symnum(res.table$pval, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) 21 | 22 | res.table$pval <- fmtp(res.table$pval, digits[["pval"]]) 23 | 24 | if (getOption("show.signif.stars")) { 25 | res.table <- cbind(res.table, signif) 26 | colnames(res.table)[ncol(res.table)] <- "" 27 | } 28 | 29 | tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) 30 | .print.table(tmp, mstyle) 31 | 32 | .space() 33 | 34 | invisible() 35 | 36 | } 37 | -------------------------------------------------------------------------------- /R/print.list.confint.rma.r: -------------------------------------------------------------------------------- 1 | print.list.confint.rma <- function(x, digits=x$digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="list.confint.rma") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | x$digits <- NULL # so length(x) is correct 10 | 11 | .space() 12 | 13 | len <- length(x) 14 | 15 | for (j in seq_len(len)) { 16 | 17 | res.random <- fmtx(x[[j]]$random, digits[["var"]]) 18 | res.random[,2] <- paste0(x[[j]]$lb.sign, res.random[,2]) 19 | res.random[,3] <- paste0(x[[j]]$ub.sign, res.random[,3]) 20 | tmp <- capture.output(print(res.random, quote=FALSE, right=TRUE)) 21 | .print.table(tmp, mstyle) 22 | 23 | if (j != len) 24 | cat("\n") 25 | 26 | } 27 | 28 | .space() 29 | 30 | invisible() 31 | 32 | } 33 | -------------------------------------------------------------------------------- /R/print.matreg.r: -------------------------------------------------------------------------------- 1 | print.matreg <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="matreg") 6 | 7 | if (missing(digits)) { 8 | digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) 9 | } else { 10 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 11 | } 12 | 13 | .space() 14 | 15 | if (x$test == "t") { 16 | res.table <- data.frame(estimate=fmtx(c(x$tab$beta), digits[["est"]]), se=fmtx(x$tab$se, digits[["se"]]), tval=fmtx(x$tab$tval, digits[["test"]]), df=round(x$tab$df,2), pval=fmtp(x$tab$pval, digits[["pval"]]), ci.lb=fmtx(x$tab$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$tab$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) 17 | } else { 18 | res.table <- data.frame(estimate=fmtx(c(x$tab$beta), digits[["est"]]), se=fmtx(x$tab$se, digits[["se"]]), zval=fmtx(x$tab$zval, digits[["test"]]), pval=fmtp(x$tab$pval, digits[["pval"]]), ci.lb=fmtx(x$tab$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$tab$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) 19 | } 20 | 21 | rownames(res.table) <- rownames(x$tab) 22 | 23 | signif <- symnum(x$tab$pval, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) 24 | 25 | if (signif.stars) { 26 | res.table <- cbind(res.table, signif) 27 | colnames(res.table)[ncol(res.table)] <- "" 28 | } 29 | 30 | tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) 31 | #tmp[1] <- paste0(tmp[1], "\u200b") 32 | .print.table(tmp, mstyle) 33 | 34 | if (signif.legend) { 35 | cat("\n") 36 | cat(mstyle$legend("---")) 37 | cat("\n") 38 | cat(mstyle$legend("Signif. codes: "), mstyle$legend(attr(signif, "legend"))) 39 | cat("\n") 40 | } 41 | 42 | .space() 43 | 44 | invisible() 45 | 46 | } 47 | -------------------------------------------------------------------------------- /R/print.profile.rma.r: -------------------------------------------------------------------------------- 1 | print.profile.rma <- function(x, ...) { 2 | 3 | ######################################################################### 4 | 5 | mstyle <- .get.mstyle() 6 | 7 | .chkclass(class(x), must="profile.rma") 8 | 9 | ######################################################################### 10 | 11 | if (x$comps == 1) { 12 | 13 | res <- data.frame(x[1], x[2]) 14 | print(res) 15 | 16 | } else { 17 | 18 | x$comps <- NULL 19 | print(lapply(x, function(x) data.frame(x[1], x[2]))) 20 | 21 | } 22 | 23 | } 24 | -------------------------------------------------------------------------------- /R/print.ranktest.r: -------------------------------------------------------------------------------- 1 | print.ranktest <- function(x, digits=x$digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="ranktest") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | .space() 10 | 11 | cat(mstyle$section("Rank Correlation Test for Funnel Plot Asymmetry")) 12 | cat("\n\n") 13 | cat(mstyle$result(paste0("Kendall's tau = ", fmtx(x$tau, digits[["est"]]), ", p ", fmtp(x$pval, digits[["pval"]], equal=TRUE, sep=TRUE)))) 14 | cat("\n") 15 | #cat("H0: true tau is equal to 0\n\n") 16 | 17 | .space() 18 | 19 | invisible() 20 | 21 | } 22 | -------------------------------------------------------------------------------- /R/print.regtest.r: -------------------------------------------------------------------------------- 1 | print.regtest <- function(x, digits=x$digits, ret.fit=x$ret.fit, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="regtest") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | .space() 10 | 11 | cat(mstyle$section("Regression Test for Funnel Plot Asymmetry")) 12 | cat("\n\n") 13 | if (x$model == "lm") { 14 | cat(mstyle$text("Model: weighted regression with multiplicative dispersion")) 15 | } else { 16 | cat(mstyle$text(paste("Model: ", ifelse(is.element(x$method, c("FE","EE","CE")), "fixed-effects", "mixed-effects"), "meta-regression model"))) 17 | } 18 | cat("\n") 19 | if (x$predictor == "sei") 20 | cat(mstyle$text("Predictor: standard error")) 21 | if (x$predictor == "vi") 22 | cat(mstyle$text("Predictor: sampling variance")) 23 | if (x$predictor == "ni") 24 | cat(mstyle$text("Predictor: sample size")) 25 | if (x$predictor == "ninv") 26 | cat(mstyle$text("Predictor: inverse of the sample size")) 27 | if (x$predictor == "sqrtni") 28 | cat(mstyle$text("Predictor: square root sample size")) 29 | if (x$predictor == "sqrtninv") 30 | cat(mstyle$text("Predictor: inverse of the square root sample size")) 31 | 32 | cat("\n") 33 | 34 | if (ret.fit) { 35 | if (x$model == "lm") { 36 | print(summary(x$fit)) 37 | } else { 38 | .space(FALSE) 39 | print(x$fit) 40 | .space(FALSE) 41 | } 42 | } else { 43 | cat("\n") 44 | } 45 | 46 | cat(mstyle$text("Test for Funnel Plot Asymmetry: ")) 47 | if (is.na(x$ddf)) { 48 | cat(mstyle$result(fmtt(x$zval, "z", pval=x$pval, pname="p", format=2, digits=digits, flag=ifelse(!is.null(x$est) && sign(x$zval)!=sign(x$est), " ", "")))) 49 | } else { 50 | cat(mstyle$result(fmtt(x$zval, "t", df=x$ddf, pval=x$pval, pname="p", format=2, digits=digits, flag=ifelse(!is.null(x$est) && sign(x$zval)!=sign(x$est), " ", "")))) 51 | } 52 | cat("\n") 53 | 54 | if (!is.null(x$est)) { 55 | if (x$predictor == "sei") 56 | cat(mstyle$text("Limit Estimate (as sei -> 0): ")) 57 | if (x$predictor == "vi") 58 | cat(mstyle$text("Limit Estimate (as vi -> 0): ")) 59 | if (x$predictor %in% c("ninv", "sqrtninv")) 60 | cat(mstyle$text("Limit Estimate (as ni -> inf): ")) 61 | cat(mstyle$result(paste0("b = ", fmtx(x$est, digits[["est"]], flag=ifelse(sign(x$zval)!=sign(x$est), " ", "")), " (CI: ", fmtx(x$ci.lb, digits[["est"]]), ", ", fmtx(x$ci.ub, digits[["est"]]), ")"))) 62 | cat("\n") 63 | } 64 | 65 | .space() 66 | 67 | invisible() 68 | 69 | } 70 | -------------------------------------------------------------------------------- /R/print.rma.peto.r: -------------------------------------------------------------------------------- 1 | print.rma.peto <- function(x, digits, showfit=FALSE, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="rma.peto") 6 | 7 | if (missing(digits)) { 8 | digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) 9 | } else { 10 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 11 | } 12 | 13 | .space() 14 | 15 | cat(mstyle$section("Equal-Effects Model")) 16 | cat(mstyle$section(paste0(" (k = ", x$k, ")"))) 17 | 18 | cat("\n") 19 | 20 | if (showfit) { 21 | fs <- fmtx(x$fit.stats$ML, digits[["fit"]]) 22 | names(fs) <- c("logLik", "deviance", "AIC", "BIC", "AICc") 23 | cat("\n") 24 | tmp <- capture.output(print(fs, quote=FALSE, print.gap=2)) 25 | #tmp[1] <- paste0(tmp[1], "\u200b") 26 | .print.table(tmp, mstyle) 27 | } 28 | 29 | cat("\n") 30 | 31 | if (!is.na(x$I2)) { 32 | cat(mstyle$text("I^2 (total heterogeneity / total variability): ")) 33 | cat(mstyle$result(paste0(fmtx(x$I2, 2), "%"))) 34 | cat("\n") 35 | } 36 | if (!is.na(x$H2)) { 37 | cat(mstyle$text("H^2 (total variability / sampling variability): ")) 38 | cat(mstyle$result(fmtx(x$H2, 2))) 39 | cat("\n") 40 | } 41 | 42 | if (!is.na(x$QE)) { 43 | cat("\n") 44 | cat(mstyle$section("Test for Heterogeneity:"), "\n") 45 | cat(mstyle$result(fmtt(x$QE, "Q", df=x$k.pos-1, pval=x$QEp, digits=digits))) 46 | } 47 | 48 | if (any(!is.na(c(x$I2, x$H2, x$QE)))) 49 | cat("\n\n") 50 | 51 | res.table <- c(estimate=fmtx(unname(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]])) 52 | res.table.exp <- c(estimate=fmtx(exp(unname(x$beta)), digits[["est"]]), ci.lb=fmtx(exp(x$ci.lb), digits[["ci"]]), ci.ub=fmtx(exp(x$ci.ub), digits[["ci"]])) 53 | 54 | cat(mstyle$section("Model Results (log scale):")) 55 | cat("\n\n") 56 | tmp <- capture.output(.print.vector(res.table)) 57 | .print.table(tmp, mstyle) 58 | 59 | cat("\n") 60 | cat(mstyle$section("Model Results (OR scale):")) 61 | cat("\n\n") 62 | tmp <- capture.output(.print.vector(res.table.exp)) 63 | .print.table(tmp, mstyle) 64 | 65 | .space() 66 | 67 | invisible() 68 | 69 | } 70 | -------------------------------------------------------------------------------- /R/print.summary.matreg.r: -------------------------------------------------------------------------------- 1 | print.summary.matreg <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="summary.matreg") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | ### strip summary.matreg class from object (otherwise get recursion) 10 | 11 | class(x) <- class(x)[-1] 12 | 13 | ### print with showfit=TRUE 14 | 15 | print(x, digits=digits, signif.stars=signif.stars, signif.legend=signif.legend, ...) 16 | 17 | .space(FALSE) 18 | 19 | if (x$test == "t") { 20 | 21 | cat(mstyle$text("Residual standard error: ")) 22 | cat(mstyle$result(fmtx(sqrt(x$mse), digits[["se"]]))) 23 | cat(mstyle$text(paste0(" on ", x$Fdf[2], " degrees of freedom\n"))) 24 | 25 | cat(mstyle$text("Multiple R-squared: ")) 26 | cat(mstyle$result(fmtx(x$R2, digits[["het"]]))) 27 | cat(mstyle$text(", Adjusted R-squared: ")) 28 | cat(mstyle$result(fmtx(x$R2adj, digits[["het"]]))) 29 | 30 | cat("\n") 31 | 32 | cat(mstyle$text("F-statistic: ")) 33 | cat(mstyle$result(fmtx(x$F[["value"]], digits[["test"]]))) 34 | cat(mstyle$text(paste0(" on ", x$Fdf[1], " and ", x$Fdf[2], " DF, p-value: "))) 35 | cat(mstyle$result(fmtp(x$Fp, digits[["pval"]], equal=FALSE, sep=FALSE))) 36 | 37 | } else { 38 | 39 | cat(mstyle$result("R^2: ")) 40 | cat(mstyle$result(fmtx(x$R2, digits[["het"]]))) 41 | cat(mstyle$result(", ")) 42 | cat(mstyle$result(fmtt(x$QM, "QM", df=x$QMdf[1], pval=x$QMp, digits=digits))) 43 | 44 | } 45 | 46 | cat("\n") 47 | 48 | .space() 49 | 50 | invisible() 51 | 52 | } 53 | -------------------------------------------------------------------------------- /R/print.summary.rma.r: -------------------------------------------------------------------------------- 1 | print.summary.rma <- function(x, digits=x$digits, showfit=TRUE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(x), must="summary.rma") 6 | 7 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 8 | 9 | ### strip summary.rma class from object (otherwise get recursion) 10 | 11 | class(x) <- class(x)[-1] 12 | 13 | ### print with showfit=TRUE 14 | 15 | print(x, digits=digits, showfit=showfit, signif.stars=signif.stars, signif.legend=signif.legend, ...) 16 | 17 | invisible() 18 | 19 | } 20 | -------------------------------------------------------------------------------- /R/qqnorm.rma.glmm.r: -------------------------------------------------------------------------------- 1 | qqnorm.rma.glmm <- function(y, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(y), must="rma.glmm", notav="rma.glmm") 6 | 7 | } 8 | -------------------------------------------------------------------------------- /R/qqnorm.rma.mv.r: -------------------------------------------------------------------------------- 1 | qqnorm.rma.mv <- function(y, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(y), must="rma.mv", notav="rma.mv") 6 | 7 | } 8 | -------------------------------------------------------------------------------- /R/radial.r: -------------------------------------------------------------------------------- 1 | radial <- galbraith <- function(x, ...) 2 | UseMethod("radial") 3 | -------------------------------------------------------------------------------- /R/regplot.r: -------------------------------------------------------------------------------- 1 | regplot <- function(x, ...) 2 | UseMethod("regplot") 3 | -------------------------------------------------------------------------------- /R/replmiss.r: -------------------------------------------------------------------------------- 1 | replmiss <- function(x, y, data) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | ### check if data argument has been specified 6 | 7 | if (missing(data)) 8 | data <- NULL 9 | 10 | if (is.null(data)) { 11 | data <- sys.frame(sys.parent()) 12 | } else { 13 | if (!is.data.frame(data)) 14 | data <- data.frame(data) 15 | } 16 | 17 | mf <- match.call() 18 | 19 | x <- .getx("x", mf=mf, data=data, checknull=FALSE) 20 | y <- .getx("y", mf=mf, data=data, checknull=FALSE) 21 | 22 | if (length(y) == 0L) 23 | return(x) 24 | 25 | if (length(x) == 0L) 26 | x <- rep(NA_real_, length(y)) 27 | 28 | ### in case user specified a constant for y to use for replacement 29 | 30 | y <- .expand1(y, length(x)) 31 | 32 | ### check that x and y are of the same length 33 | 34 | if (length(x) != length(y)) 35 | stop(mstyle$stop("Length of 'x' and 'y' are not the same.")) 36 | 37 | #x <- ifelse(is.na(x), y, x) # this is quite a bit slower than the following 38 | is.na.x <- is.na(x) 39 | x[is.na.x] <- y[is.na.x] 40 | 41 | return(x) 42 | 43 | } 44 | -------------------------------------------------------------------------------- /R/reporter.r: -------------------------------------------------------------------------------- 1 | reporter <- function(x, ...) 2 | UseMethod("reporter") 3 | -------------------------------------------------------------------------------- /R/robust.r: -------------------------------------------------------------------------------- 1 | robust <- function(x, cluster, ...) 2 | UseMethod("robust") 3 | -------------------------------------------------------------------------------- /R/rstandard.rma.mh.r: -------------------------------------------------------------------------------- 1 | rstandard.rma.mh <- function(model, digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(model), must="rma.mh") 6 | 7 | na.act <- getOption("na.action") 8 | 9 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 10 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 11 | 12 | if (is.null(model$yi.f)) 13 | stop(mstyle$stop("Information needed to compute the residuals is not available in the model object.")) 14 | 15 | x <- model 16 | 17 | if (missing(digits)) { 18 | digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) 19 | } else { 20 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 21 | } 22 | 23 | ######################################################################### 24 | 25 | resid <- c(x$yi.f - x$beta) 26 | 27 | resid[abs(resid) < 100 * .Machine$double.eps] <- 0 28 | #resid[abs(resid) < 100 * .Machine$double.eps * median(abs(resid), na.rm=TRUE)] <- 0 # see lm.influence 29 | 30 | ### note: these are like Pearson (or semi-standardized) residuals 31 | 32 | seresid <- sqrt(x$vi.f) 33 | stresid <- resid / seresid 34 | 35 | ######################################################################### 36 | 37 | if (na.act == "na.omit") { 38 | out <- list(resid=resid[x$not.na.yivi], se=seresid[x$not.na.yivi], z=stresid[x$not.na.yivi]) 39 | out$slab <- x$slab[x$not.na.yivi] 40 | } 41 | 42 | if (na.act == "na.exclude" || na.act == "na.pass") { 43 | out <- list(resid=resid, se=seresid, z=stresid) 44 | out$slab <- x$slab 45 | } 46 | 47 | if (na.act == "na.fail" && any(!x$not.na.yivi)) 48 | stop(mstyle$stop("Missing values in results.")) 49 | 50 | out$digits <- digits 51 | 52 | class(out) <- "list.rma" 53 | return(out) 54 | 55 | } 56 | -------------------------------------------------------------------------------- /R/rstandard.rma.peto.r: -------------------------------------------------------------------------------- 1 | rstandard.rma.peto <- function(model, digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(model), must="rma.peto") 6 | 7 | na.act <- getOption("na.action") 8 | 9 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 10 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 11 | 12 | if (is.null(model$yi.f)) 13 | stop(mstyle$stop("Information needed to compute the residuals is not available in the model object.")) 14 | 15 | x <- model 16 | 17 | if (missing(digits)) { 18 | digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) 19 | } else { 20 | digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) 21 | } 22 | 23 | ######################################################################### 24 | 25 | resid <- c(x$yi.f - x$beta) 26 | 27 | resid[abs(resid) < 100 * .Machine$double.eps] <- 0 28 | #resid[abs(resid) < 100 * .Machine$double.eps * median(abs(resid), na.rm=TRUE)] <- 0 # see lm.influence 29 | 30 | ### note: these are like Pearson (or semi-standardized) residuals 31 | 32 | seresid <- sqrt(x$vi.f) 33 | stresid <- resid / seresid 34 | 35 | ######################################################################### 36 | 37 | if (na.act == "na.omit") { 38 | out <- list(resid=resid[x$not.na.yivi], se=seresid[x$not.na.yivi], z=stresid[x$not.na.yivi]) 39 | out$slab <- x$slab[x$not.na.yivi] 40 | } 41 | 42 | if (na.act == "na.exclude" || na.act == "na.pass") { 43 | out <- list(resid=resid, se=seresid, z=stresid) 44 | out$slab <- x$slab 45 | } 46 | 47 | if (na.act == "na.fail" && any(!x$not.na.yivi)) 48 | stop(mstyle$stop("Missing values in results.")) 49 | 50 | out$digits <- digits 51 | 52 | class(out) <- "list.rma" 53 | return(out) 54 | 55 | } 56 | -------------------------------------------------------------------------------- /R/rstudent.rma.uni.r: -------------------------------------------------------------------------------- 1 | rstudent.rma.uni <- function(model, digits, progbar=FALSE, ...) 2 | influence(model, digits=digits, progbar=progbar, measure="rstudent", ...) 3 | -------------------------------------------------------------------------------- /R/se.r: -------------------------------------------------------------------------------- 1 | se <- function(object, ...) 2 | UseMethod("se") 3 | 4 | se.default <- function(object, ...) { 5 | 6 | mstyle <- .get.mstyle() 7 | 8 | vb <- try(vcov(object, ...), silent=TRUE) 9 | 10 | if (inherits(vb, "try-error") || !is.matrix(vb) || !.is.square(vb)) 11 | stop(mstyle$stop("Default method for extracting the standard errors does not work for such model objects.")) 12 | 13 | return(sqrt(diag(vb))) 14 | 15 | } 16 | 17 | se.rma <- function(object, ...) { 18 | 19 | mstyle <- .get.mstyle() 20 | 21 | .chkclass(class(object), must="rma") 22 | 23 | ddd <- list(...) 24 | 25 | ses <- c(object$se) 26 | names(ses) <- rownames(object$beta) 27 | 28 | if (isTRUE(ddd$type=="beta")) 29 | return(ses) 30 | 31 | if (inherits(object, "rma.ls")) { 32 | ses <- list(beta=ses) 33 | ses$alpha <- c(object$se.alpha) 34 | names(ses$alpha) <- rownames(object$alpha) 35 | if (isTRUE(ddd$type=="alpha")) 36 | return(ses$alpha) 37 | } 38 | 39 | if (inherits(object, "rma.uni.selmodel")) { 40 | ses <- list(beta=ses) 41 | ses$delta <- c(object$se.delta) 42 | if (length(object$delta) == 1L) { 43 | names(ses$delta) <- "delta" 44 | } else { 45 | names(ses$delta) <- paste0("delta.", seq_along(object$delta)) 46 | } 47 | if (isTRUE(ddd$type=="delta")) 48 | return(ses$delta) 49 | } 50 | 51 | return(ses) 52 | 53 | } 54 | -------------------------------------------------------------------------------- /R/selmodel.r: -------------------------------------------------------------------------------- 1 | selmodel <- function(x, ...) 2 | UseMethod("selmodel") 3 | -------------------------------------------------------------------------------- /R/simulate.rma.r: -------------------------------------------------------------------------------- 1 | simulate.rma <- function(object, nsim=1, seed=NULL, olim, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma", notav=c("rma.gen", "rma.glmm", "rma.mh", "rma.peto", "rma.uni.selmodel")) 6 | 7 | if (is.null(object$X)) 8 | stop(mstyle$stop("Information needed to simulate values is not available in the model object.")) 9 | 10 | na.act <- getOption("na.action") 11 | 12 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 13 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 14 | 15 | ### as in stats:::simulate.lm 16 | if (!exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) 17 | runif(1) 18 | if (is.null(seed)) { 19 | RNGstate <- get(".Random.seed", envir = .GlobalEnv) 20 | } else { 21 | R.seed <- get(".Random.seed", envir = .GlobalEnv) 22 | set.seed(seed) 23 | RNGstate <- structure(seed, kind = as.list(RNGkind())) 24 | on.exit(assign(".Random.seed", R.seed, envir = .GlobalEnv), add=TRUE) 25 | } 26 | 27 | nsim <- round(nsim) 28 | 29 | if (nsim <= 0) 30 | stop(mstyle$stop("Argument 'nsim' must be >= 1.")) 31 | 32 | ######################################################################### 33 | 34 | ### fitted values 35 | 36 | ftd <- c(object$X %*% object$beta) 37 | 38 | ### simulate for rma.uni (and rma.ls) objects 39 | 40 | if (inherits(object, "rma.uni")) 41 | val <- replicate(nsim, rnorm(object$k, mean=ftd, sd=sqrt(object$vi + object$tau2))) 42 | 43 | ### simulate for rma.mv objects 44 | 45 | if (inherits(object, "rma.mv")) 46 | val <- t(.mvrnorm(nsim, mu=ftd, Sigma=object$M)) 47 | 48 | ### apply observation/outcome limits if specified 49 | 50 | if (!missing(olim)) { 51 | if (length(olim) != 2L) 52 | stop(mstyle$stop("Argument 'olim' must be of length 2.")) 53 | olim <- sort(olim) 54 | val <- .applyolim(val, olim) 55 | } 56 | 57 | ######################################################################### 58 | 59 | res <- matrix(NA_real_, nrow=object$k.f, ncol=nsim) 60 | res[object$not.na,] <- val 61 | res <- as.data.frame(res) 62 | 63 | rownames(res) <- object$slab 64 | colnames(res) <- paste0("sim_", seq_len(nsim)) 65 | 66 | if (na.act == "na.omit") 67 | res <- res[object$not.na,,drop=FALSE] 68 | 69 | attr(res, "seed") <- RNGstate 70 | 71 | return(res) 72 | 73 | } 74 | -------------------------------------------------------------------------------- /R/summary.matreg.r: -------------------------------------------------------------------------------- 1 | summary.matreg <- function(object, digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="matreg") 6 | 7 | if (missing(digits)) { 8 | digits <- .get.digits(xdigits=object$digits, dmiss=TRUE) 9 | } else { 10 | digits <- .get.digits(digits=digits, xdigits=object$digits, dmiss=FALSE) 11 | } 12 | 13 | object$digits <- digits 14 | 15 | class(object) <- c("summary.matreg", class(object)) 16 | return(object) 17 | 18 | } 19 | -------------------------------------------------------------------------------- /R/summary.rma.r: -------------------------------------------------------------------------------- 1 | summary.rma <- function(object, digits, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma") 6 | 7 | if (missing(digits)) { 8 | digits <- .get.digits(xdigits=object$digits, dmiss=TRUE) 9 | } else { 10 | digits <- .get.digits(digits=digits, xdigits=object$digits, dmiss=FALSE) 11 | } 12 | 13 | object$digits <- digits 14 | 15 | class(object) <- c("summary.rma", class(object)) 16 | return(object) 17 | 18 | } 19 | -------------------------------------------------------------------------------- /R/trimfill.r: -------------------------------------------------------------------------------- 1 | trimfill <- function(x, ...) 2 | UseMethod("trimfill") 3 | -------------------------------------------------------------------------------- /R/update.rma.r: -------------------------------------------------------------------------------- 1 | ### based on stats:::update.default but with some adjustments 2 | 3 | update.rma <- function(object, formula., ..., evaluate=TRUE) { 4 | 5 | mstyle <- .get.mstyle() 6 | 7 | .chkclass(class(object), must="rma", notav="robust.rma") 8 | 9 | if (is.null(call <- getCall(object))) 10 | stop(mstyle$stop("Need an object with call component.")) 11 | 12 | extras <- match.call(expand.dots = FALSE)$... 13 | 14 | if (!missing(formula.)) { 15 | 16 | if (inherits(object, c("rma.uni","rma.mv"))) { 17 | if (inherits(object$call$yi, "call")) { 18 | call$yi <- update.formula(object$call$yi, formula.) 19 | } else { 20 | if (is.null(object$call$mods)) { 21 | object$call$mods <- ~ 1 22 | call$mods <- update.formula(object$call$mods, formula.) 23 | } else { 24 | if (!any(grepl("~", object$call$mods))) { 25 | stop(mstyle$stop("The 'mods' argument in 'object' must be a formula for updating to work.")) 26 | } else { 27 | call$mods <- update.formula(object$call$mods, formula.) 28 | } 29 | } 30 | } 31 | } 32 | 33 | if (inherits(object, "rma.glmm")) 34 | call$mods <- update.formula(object$call$mods, formula.) 35 | 36 | } 37 | 38 | if (length(extras)) { 39 | existing <- !is.na(match(names(extras), names(call))) 40 | for (a in names(extras)[existing]) call[[a]] <- extras[[a]] 41 | if (any(!existing)) { 42 | call <- c(as.list(call), extras[!existing]) 43 | call <- as.call(call) 44 | } 45 | } 46 | 47 | if (evaluate) 48 | eval(call, parent.frame()) 49 | else call 50 | 51 | } 52 | -------------------------------------------------------------------------------- /R/vcov.deltamethod.r: -------------------------------------------------------------------------------- 1 | vcov.deltamethod <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="deltamethod") 6 | 7 | out <- object$vcov 8 | return(out) 9 | 10 | } 11 | -------------------------------------------------------------------------------- /R/vcov.matreg.r: -------------------------------------------------------------------------------- 1 | vcov.matreg <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="matreg") 6 | 7 | out <- object$vb 8 | return(out) 9 | 10 | } 11 | -------------------------------------------------------------------------------- /R/vec2mat.r: -------------------------------------------------------------------------------- 1 | vec2mat <- function(x, diag=FALSE, corr=!diag, dimnames) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | p <- length(x) 6 | 7 | dims <- sqrt(2*p + 1/4) + ifelse(diag, -1/2, 1/2) 8 | 9 | if (abs(dims - round(dims)) >= .Machine$double.eps^0.5) 10 | stop(mstyle$stop("Length of 'x' does not correspond to a square matrix.")) 11 | 12 | dims <- round(dims) 13 | 14 | R <- matrix(NA_real_, nrow=dims, ncol=dims) 15 | 16 | if (!missing(dimnames)) { 17 | if (length(dimnames) != dims) 18 | stop(mstyle$stop(paste0("Length of 'dimnames' (", length(dimnames), ") does not correspond to the dimensions of the matrix (", dims, ")."))) 19 | rownames(R) <- colnames(R) <- dimnames 20 | } 21 | 22 | R[lower.tri(R, diag=diag)] <- x 23 | R[upper.tri(R, diag=diag)] <- t(R)[upper.tri(R, diag=diag)] 24 | 25 | if (corr) 26 | diag(R) <- 1 27 | 28 | return(R) 29 | 30 | } 31 | -------------------------------------------------------------------------------- /R/vif.r: -------------------------------------------------------------------------------- 1 | vif <- function(x, ...) 2 | UseMethod("vif") 3 | -------------------------------------------------------------------------------- /R/weights.rma.glmm.r: -------------------------------------------------------------------------------- 1 | weights.rma.glmm <- function(object, ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma.glmm", notav="rma.glmm") 6 | 7 | } 8 | -------------------------------------------------------------------------------- /R/weights.rma.mh.r: -------------------------------------------------------------------------------- 1 | weights.rma.mh <- function(object, type="diagonal", ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma.mh") 6 | 7 | if (is.null(object$outdat)) 8 | stop(mstyle$stop("Information needed to compute the weights is not available in the model object.")) 9 | 10 | na.act <- getOption("na.action") 11 | 12 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 13 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 14 | 15 | type <- match.arg(type, c("diagonal", "matrix")) 16 | 17 | x <- object 18 | 19 | ######################################################################### 20 | 21 | if (is.element(x$measure, c("RR","OR","RD"))) { 22 | Ni <- with(x$outdat, ai + bi + ci + di) 23 | } else { 24 | Ti <- with(x$outdat, t1i + t2i) 25 | } 26 | 27 | if (x$measure == "OR") 28 | wi <- with(x$outdat, (bi / Ni) * ci) 29 | 30 | if (x$measure == "RR") 31 | wi <- with(x$outdat, (ci / Ni) * (ai+bi)) 32 | 33 | if (x$measure == "RD") 34 | wi <- with(x$outdat, ((ai+bi) / Ni) * (ci+di)) 35 | 36 | if (x$measure == "IRR") 37 | wi <- with(x$outdat, (x2i / Ti) * t1i) 38 | 39 | if (x$measure == "IRD") 40 | wi <- with(x$outdat, (t1i / Ti) * t2i) 41 | 42 | ######################################################################### 43 | 44 | if (type == "diagonal") { 45 | 46 | weight <- rep(NA_real_, x$k.f) 47 | weight[x$not.na] <- wi / sum(wi) * 100 48 | names(weight) <- x$slab 49 | 50 | if (na.act == "na.omit") 51 | weight <- weight[x$not.na] 52 | 53 | if (na.act == "na.fail" && any(!x$not.na)) 54 | stop(mstyle$stop("Missing values in weights.")) 55 | 56 | return(weight) 57 | 58 | } 59 | 60 | if (type == "matrix") { 61 | 62 | Wfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) 63 | Wfull[x$not.na, x$not.na] <- diag(wi) 64 | 65 | rownames(Wfull) <- x$slab 66 | colnames(Wfull) <- x$slab 67 | 68 | if (na.act == "na.omit") 69 | Wfull <- Wfull[x$not.na, x$not.na, drop=FALSE] 70 | 71 | if (na.act == "na.fail" && any(!x$not.na)) 72 | stop(mstyle$stop("Missing values in results.")) 73 | 74 | return(Wfull) 75 | 76 | } 77 | 78 | } 79 | -------------------------------------------------------------------------------- /R/weights.rma.mv.r: -------------------------------------------------------------------------------- 1 | weights.rma.mv <- function(object, type="diagonal", ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma.mv") 6 | 7 | if (is.null(object$not.na)) 8 | stop(mstyle$stop("Information needed to compute the weights is not available in the model object.")) 9 | 10 | na.act <- getOption("na.action") 11 | 12 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 13 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 14 | 15 | type <- match.arg(type, c("diagonal", "matrix", "rowsum")) 16 | 17 | x <- object 18 | 19 | ######################################################################### 20 | 21 | if (is.null(x$W)) { 22 | W <- chol2inv(chol(x$M)) 23 | } else { 24 | W <- x$W 25 | } 26 | 27 | ######################################################################### 28 | 29 | if (type == "diagonal") { 30 | 31 | wi <- as.vector(diag(W)) 32 | weight <- rep(NA_real_, x$k.f) 33 | weight[x$not.na] <- wi / sum(wi) * 100 34 | names(weight) <- x$slab 35 | 36 | if (na.act == "na.omit") 37 | weight <- weight[x$not.na] 38 | 39 | if (na.act == "na.fail" && any(!x$not.na)) 40 | stop(mstyle$stop("Missing values in weights.")) 41 | 42 | return(weight) 43 | 44 | } 45 | 46 | if (type == "matrix") { 47 | 48 | Wfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) 49 | Wfull[x$not.na, x$not.na] <- as.matrix(W) # as.matrix() needed when sparse=TRUE 50 | 51 | rownames(Wfull) <- x$slab 52 | colnames(Wfull) <- x$slab 53 | 54 | if (na.act == "na.omit") 55 | Wfull <- Wfull[x$not.na, x$not.na, drop=FALSE] 56 | 57 | if (na.act == "na.fail" && any(!x$not.na)) 58 | stop(mstyle$stop("Missing values in results.")) 59 | 60 | return(Wfull) 61 | 62 | } 63 | 64 | if (type == "rowsum") { 65 | 66 | if (!x$int.only) 67 | stop("Row-sum weights are only meaningful for intercept-only models.") 68 | 69 | wi <- rowSums(W) 70 | weight <- rep(NA_real_, x$k.f) 71 | weight[x$not.na] <- wi / sum(wi) * 100 72 | names(weight) <- x$slab 73 | 74 | if (na.act == "na.omit") 75 | weight <- weight[x$not.na] 76 | 77 | if (na.act == "na.fail" && any(!x$not.na)) 78 | stop(mstyle$stop("Missing values in weights.")) 79 | 80 | return(weight) 81 | 82 | } 83 | 84 | } 85 | -------------------------------------------------------------------------------- /R/weights.rma.peto.r: -------------------------------------------------------------------------------- 1 | weights.rma.peto <- function(object, type="diagonal", ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma.peto") 6 | 7 | if (is.null(object$outdat)) 8 | stop(mstyle$stop("Information needed to compute the weights is not available in the model object.")) 9 | 10 | na.act <- getOption("na.action") 11 | 12 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 13 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 14 | 15 | type <- match.arg(type, c("diagonal", "matrix")) 16 | 17 | x <- object 18 | 19 | ######################################################################### 20 | 21 | n1i <- with(x$outdat, ai + bi) 22 | n2i <- with(x$outdat, ci + di) 23 | Ni <- with(x$outdat, ai + bi + ci + di) 24 | xt <- with(x$outdat, ai + ci) 25 | yt <- with(x$outdat, bi + di) 26 | 27 | wi <- xt * yt * (n1i/Ni) * (n2i/Ni) / (Ni - 1) 28 | 29 | ######################################################################### 30 | 31 | if (type == "diagonal") { 32 | 33 | weight <- rep(NA_real_, x$k.f) 34 | weight[x$not.na] <- wi / sum(wi) * 100 35 | names(weight) <- x$slab 36 | 37 | if (na.act == "na.omit") 38 | weight <- weight[x$not.na] 39 | 40 | if (na.act == "na.fail" && any(!x$not.na)) 41 | stop(mstyle$stop("Missing values in weights.")) 42 | 43 | return(weight) 44 | 45 | } 46 | 47 | if (type == "matrix") { 48 | 49 | Wfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) 50 | Wfull[x$not.na, x$not.na] <- diag(wi) 51 | 52 | rownames(Wfull) <- x$slab 53 | colnames(Wfull) <- x$slab 54 | 55 | if (na.act == "na.omit") 56 | Wfull <- Wfull[x$not.na, x$not.na, drop=FALSE] 57 | 58 | if (na.act == "na.fail" && any(!x$not.na)) 59 | stop(mstyle$stop("Missing values in results.")) 60 | 61 | return(Wfull) 62 | 63 | } 64 | 65 | } 66 | -------------------------------------------------------------------------------- /R/weights.rma.uni.r: -------------------------------------------------------------------------------- 1 | weights.rma.uni <- function(object, type="diagonal", ...) { 2 | 3 | mstyle <- .get.mstyle() 4 | 5 | .chkclass(class(object), must="rma.uni", notav=c("rma.gen", "rma.uni.selmodel")) 6 | 7 | if (is.null(object$not.na)) 8 | stop(mstyle$stop("Information needed to compute the weights is not available in the model object.")) 9 | 10 | na.act <- getOption("na.action") 11 | 12 | if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) 13 | stop(mstyle$stop("Unknown 'na.action' specified under options().")) 14 | 15 | type <- match.arg(type, c("diagonal", "matrix")) 16 | 17 | x <- object 18 | 19 | ######################################################################### 20 | 21 | if (x$weighted) { 22 | if (is.null(x$weights)) { 23 | W <- diag(1/(x$vi + x$tau2), nrow=x$k, ncol=x$k) 24 | } else { 25 | W <- diag(x$weights, nrow=x$k, ncol=x$k) 26 | } 27 | } else { 28 | W <- diag(1/x$k, nrow=x$k, ncol=x$k) 29 | } 30 | 31 | ######################################################################### 32 | 33 | if (type == "diagonal") { 34 | 35 | wi <- as.vector(diag(W)) 36 | weight <- rep(NA_real_, x$k.f) 37 | weight[x$not.na] <- wi / sum(wi) * 100 38 | names(weight) <- x$slab 39 | 40 | if (na.act == "na.omit") 41 | weight <- weight[x$not.na] 42 | 43 | if (na.act == "na.fail" && any(!x$not.na)) 44 | stop(mstyle$stop("Missing values in weights.")) 45 | 46 | return(weight) 47 | 48 | } 49 | 50 | if (type == "matrix") { 51 | 52 | Wfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) 53 | Wfull[x$not.na, x$not.na] <- W 54 | 55 | rownames(Wfull) <- x$slab 56 | colnames(Wfull) <- x$slab 57 | 58 | if (na.act == "na.omit") 59 | Wfull <- Wfull[x$not.na, x$not.na, drop=FALSE] 60 | 61 | if (na.act == "na.fail" && any(!x$not.na)) 62 | stop(mstyle$stop("Missing values in results.")) 63 | 64 | return(Wfull) 65 | 66 | } 67 | 68 | } 69 | -------------------------------------------------------------------------------- /build/metafor.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/build/metafor.pdf -------------------------------------------------------------------------------- /build/stage23.rdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/build/stage23.rdb -------------------------------------------------------------------------------- /build/vignette.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/build/vignette.rds -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite the metafor package in publications, please use:") 2 | 3 | bibentry(bibtype = "Article", 4 | title = "Conducting meta-analyses in {R} with the {metafor} package", 5 | author = person(given = "Wolfgang", family = "Viechtbauer"), 6 | journal = "Journal of Statistical Software", 7 | year = "2010", 8 | volume = "36", 9 | number = "3", 10 | pages = "1--48", 11 | doi = "10.18637/jss.v036.i03", 12 | textVersion = paste("Viechtbauer, W. (2010).", 13 | "Conducting meta-analyses in R with the metafor package.", 14 | "Journal of Statistical Software, 36(3), 1-48.", 15 | "https://doi.org/10.18637/jss.v036.i03") 16 | ) 17 | -------------------------------------------------------------------------------- /inst/doc/diagram.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/inst/doc/diagram.pdf -------------------------------------------------------------------------------- /inst/doc/diagram.pdf.asis: -------------------------------------------------------------------------------- 1 | %\VignetteEngine{R.rsp::asis} 2 | %\VignetteIndexEntry{Diagram of Functions in the metafor Package} 3 | -------------------------------------------------------------------------------- /inst/doc/metafor.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/inst/doc/metafor.pdf -------------------------------------------------------------------------------- /inst/doc/metafor.pdf.asis: -------------------------------------------------------------------------------- 1 | %\VignetteEngine{R.rsp::asis} 2 | %\VignetteIndexEntry{Conducting Meta-Analyses in R with the metafor Package} 3 | -------------------------------------------------------------------------------- /man/addpoly.Rd: -------------------------------------------------------------------------------- 1 | \name{addpoly} 2 | \alias{addpoly} 3 | \title{Add Polygons to Forest Plots} 4 | \description{ 5 | Function to add polygons (sometimes called \sQuote{diamonds}) to a forest plot, for example to show pooled estimates for subgroups of studies or to show fitted/predicted values based on models involving moderators. 6 | } 7 | \usage{ 8 | addpoly(x, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{either an object of class \code{"rma"}, an object of class \code{"predict.rma"}, or the values at which polygons should be drawn. See \sQuote{Details}.} 12 | \item{\dots}{other arguments.} 13 | } 14 | \details{ 15 | Currently, methods exist for three types of situations. 16 | 17 | In the first case, object \code{x} is a fitted model coming from the \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, or \code{\link{rma.mv}} functions. The model must either be an equal- or a random-effects model, that is, the model should not contain any moderators. The corresponding method is \code{\link{addpoly.rma}}. It can be used to add a polygon to an existing forest plot (usually at the bottom), showing the pooled estimate (with its confidence interval) based on the fitted model. 18 | 19 | Alternatively, \code{x} can be an object of class \code{"predict.rma"} obtained with the \code{\link[=predict.rma]{predict}} function. In this case, polygons based on the predicted values are drawn. The corresponding method is \code{\link{addpoly.predict.rma}}. 20 | 21 | Alternatively, object \code{x} can be a vector with the values at which one or more polygons should be drawn. The corresponding method is \code{\link{addpoly.default}}. 22 | } 23 | \author{ 24 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 25 | } 26 | \references{ 27 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 28 | } 29 | \seealso{ 30 | \code{\link{addpoly.rma}}, \code{\link{addpoly.predict.rma}}, and \code{\link{addpoly.default}} for the specific method functions. 31 | 32 | \code{\link{forest}} for functions to draw forest plots to which polygons can be added. 33 | } 34 | \keyword{aplot} 35 | -------------------------------------------------------------------------------- /man/bldiag.Rd: -------------------------------------------------------------------------------- 1 | \name{bldiag} 2 | \alias{bldiag} 3 | \title{Construct Block Diagonal Matrix} 4 | \description{ 5 | Function to construct a block diagonal matrix from (a list of) matrices. 6 | } 7 | \usage{ 8 | bldiag(\dots, order) 9 | } 10 | \arguments{ 11 | \item{\dots}{individual matrices or a list of matrices.} 12 | \item{order}{optional argument to specify a variable based on which a square block diagonal matrix should be ordered.} 13 | } 14 | \author{ 15 | Posted to R-help by Berton Gunter (2 Sep 2005) with some further adjustments by Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 16 | } 17 | \seealso{ 18 | \code{\link{rma.mv}} for the model fitting function that can take such a block diagonal matrix as input (for the \code{V} argument). 19 | 20 | \code{\link{blsplit}} for a function that can split a block diagonal matrix into a list of sub-matrices. 21 | } 22 | \examples{ 23 | ### copy data into 'dat' 24 | dat <- dat.berkey1998 25 | dat 26 | 27 | ### construct list with the variance-covariance matrices of the observed outcomes for the studies 28 | V <- lapply(split(dat[c("v1i","v2i")], dat$trial), as.matrix) 29 | V 30 | 31 | ### construct block diagonal matrix 32 | V <- bldiag(V) 33 | V 34 | 35 | ### if we split based on 'author', the list elements in V are in a different order than tha data 36 | V <- lapply(split(dat[c("v1i","v2i")], dat$author), as.matrix) 37 | V 38 | 39 | ### can use 'order' argument to reorder the block-diagonal matrix into the correct order 40 | V <- bldiag(V, order=dat$author) 41 | V 42 | } 43 | \keyword{manip} 44 | -------------------------------------------------------------------------------- /man/blsplit.Rd: -------------------------------------------------------------------------------- 1 | \name{blsplit} 2 | \alias{blsplit} 3 | \title{Split Block Diagonal Matrix} 4 | \description{ 5 | Function to split a block diagonal matrix into a list of sub-matrices. 6 | } 7 | \usage{ 8 | blsplit(x, cluster, fun, args, sort=FALSE) 9 | } 10 | \arguments{ 11 | \item{x}{a block diagonal matrix.} 12 | \item{cluster}{vector to specify the clustering variable to use for splitting.} 13 | \item{fun}{optional argument to specify a function to apply to each sub-matrix.} 14 | \item{args}{optional argument to specify any additional argument(s) for the function specified via \code{fun}.} 15 | \item{sort}{logical to specify whether to sort the list by the unique cluster values (the default is \code{FALSE}).} 16 | } 17 | \value{ 18 | A list of one or more sub-matrices. 19 | } 20 | \author{ 21 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 22 | } 23 | \seealso{ 24 | \code{\link{bldiag}} for a function to create a block diagonal matrix based on sub-matrices. 25 | 26 | \code{\link{vcalc}} for a function to construct a variance-covariance matrix of dependent effect sizes or outcomes, which often has a block diagonal structure. 27 | } 28 | \examples{ 29 | ### copy data into 'dat' 30 | dat <- dat.assink2016 31 | 32 | ### assume that the effect sizes within studies are correlated with rho=0.6 33 | V <- vcalc(vi, cluster=study, obs=esid, data=dat, rho=0.6) 34 | 35 | ### split V matrix into list of sub-matrices 36 | Vs <- blsplit(V, cluster=dat$study) 37 | Vs[1:2] 38 | lapply(Vs[1:2], cov2cor) 39 | 40 | ### illustrate the use of the fun and args arguments 41 | blsplit(V, cluster=dat$study, cov2cor)[1:2] 42 | blsplit(V, cluster=dat$study, round, 3)[1:2] 43 | } 44 | \keyword{manip} 45 | -------------------------------------------------------------------------------- /man/coef.permutest.rma.uni.Rd: -------------------------------------------------------------------------------- 1 | \name{coef.permutest.rma.uni} 2 | \alias{coef.permutest.rma.uni} 3 | \title{Extract the Model Coefficient Table from 'permutest.rma.uni' Objects} 4 | \description{ 5 | Function to extract the estimated model coefficients, corresponding standard errors, test statistics, p-values (based on the permutation tests), and confidence interval bounds from objects of class \code{"permutest.rma.uni"}. 6 | } 7 | \usage{ 8 | \method{coef}{permutest.rma.uni}(object, \dots) 9 | } 10 | \arguments{ 11 | \item{object}{an object of class \code{"permutest.rma.uni"}.} 12 | \item{\dots}{other arguments.} 13 | } 14 | \value{ 15 | A data frame with the following elements: 16 | \item{estimate}{estimated model coefficient(s).} 17 | \item{se}{corresponding standard error(s).} 18 | \item{zval}{corresponding test statistic(s).} 19 | \item{pval}{p-value(s) based on the permutation test(s).} 20 | \item{ci.lb}{lower bound of the (permutation-based) confidence interval(s).} 21 | \item{ci.ub}{upper bound of the (permutation-based) confidence interval(s).} 22 | 23 | When the model was fitted with \code{test="t"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, then \code{zval} is called \code{tval} in the data frame that is returned by the function. 24 | } 25 | \author{ 26 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 27 | } 28 | \references{ 29 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 30 | } 31 | \seealso{ 32 | \code{\link[=permutest.rma.uni]{permutest}} for the function to conduct permutation tests and \code{\link{rma.uni}} for the function to fit models for which permutation tests can be conducted. 33 | } 34 | \examples{ 35 | ### calculate log risk ratios and corresponding sampling variances 36 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 37 | 38 | ### fit mixed-effects model with absolute latitude and publication year as moderators 39 | res <- rma(yi, vi, mods = ~ ablat + year, data=dat) 40 | 41 | ### carry out permutation test 42 | \dontrun{ 43 | set.seed(1234) # for reproducibility 44 | sav <- permutest(res) 45 | coef(sav) 46 | } 47 | } 48 | \keyword{models} 49 | -------------------------------------------------------------------------------- /man/coef.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{coef.rma} 2 | \alias{coef} 3 | \alias{coef.rma} 4 | \alias{coef.summary.rma} 5 | \title{Extract the Model Coefficients and Coefficient Table from 'rma' and 'summary.rma' Objects} 6 | \description{ 7 | Function to extract the estimated model coefficients from objects of class \code{"rma"}. For objects of class \code{"summary.rma"}, the model coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds are extracted. 8 | } 9 | \usage{ 10 | \method{coef}{rma}(object, \dots) 11 | \method{coef}{summary.rma}(object, \dots) 12 | } 13 | \arguments{ 14 | \item{object}{an object of class \code{"rma"} or \code{"summary.rma"}.} 15 | \item{\dots}{other arguments.} 16 | } 17 | \value{ 18 | Either a vector with the estimated model coefficient(s) or a data frame with the following elements: 19 | \item{estimate}{estimated model coefficient(s).} 20 | \item{se}{corresponding standard error(s).} 21 | \item{zval}{corresponding test statistic(s).} 22 | \item{pval}{corresponding p-value(s).} 23 | \item{ci.lb}{corresponding lower bound of the confidence interval(s).} 24 | \item{ci.ub}{corresponding upper bound of the confidence interval(s).} 25 | 26 | When the model was fitted with \code{test="t"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, then \code{zval} is called \code{tval} in the data frame that is returned by the function. 27 | } 28 | \author{ 29 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 30 | } 31 | \references{ 32 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 33 | } 34 | \seealso{ 35 | \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which model coefficients/tables can be extracted. 36 | } 37 | \examples{ 38 | ### calculate log risk ratios and corresponding sampling variances 39 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 40 | 41 | ### fit mixed-effects model with absolute latitude and publication year as moderators 42 | res <- rma(yi, vi, mods = ~ ablat + year, data=dat) 43 | 44 | ### extract model coefficients 45 | coef(res) 46 | 47 | ### extract model coefficient table 48 | coef(summary(res)) 49 | } 50 | \keyword{models} 51 | -------------------------------------------------------------------------------- /man/dfround.Rd: -------------------------------------------------------------------------------- 1 | \name{dfround} 2 | \alias{dfround} 3 | \title{Round Variables in a Data Frame} 4 | \description{ 5 | Function to round the numeric variables in a data frame. 6 | } 7 | \usage{ 8 | dfround(x, digits, drop0=TRUE) 9 | } 10 | \arguments{ 11 | \item{x}{a data frame.} 12 | \item{digits}{either a single integer or a numeric vector of the same length as there are columns in \code{x}.} 13 | \item{drop0}{logical (or a vector thereof) to specify whether trailing zeros after the decimal mark should be removed (the default is \code{TRUE}).} 14 | } 15 | \details{ 16 | A simple convenience function to round the numeric variables in a data frame, possibly to different numbers of digits. Hence, \code{digits} can either be a single integer (which will then be used to round all numeric variables to the specified number of digits) or a numeric vector (of the same length as there are columns in \code{x}) to specify the number of digits to which each variable should be rounded. 17 | 18 | Non-numeric variables are skipped. If \code{digits} is a vector, some arbitrary value (or \code{NA}) can be specified for those variables. 19 | 20 | Note: When \code{drop0=FALSE}, then \code{\link{formatC}} is used to format the numbers, which turns them into character variables. 21 | } 22 | \value{ 23 | Returns the data frame with variables rounded as specified. 24 | } 25 | \author{ 26 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 27 | } 28 | \examples{ 29 | dat <- dat.bcg 30 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) 31 | res <- rma(yi, vi, mods = ~ ablat + year, data=dat) 32 | coef(summary(res)) 33 | dfround(coef(summary(res)), digits=c(2,3,2,3,2,2)) 34 | } 35 | \keyword{manip} 36 | -------------------------------------------------------------------------------- /man/figures/crayon1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/crayon1.png -------------------------------------------------------------------------------- /man/figures/crayon2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/crayon2.png -------------------------------------------------------------------------------- /man/figures/ex_bubble_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/ex_bubble_plot.png -------------------------------------------------------------------------------- /man/figures/ex_forest_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/ex_forest_plot.png -------------------------------------------------------------------------------- /man/figures/ex_funnel_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/ex_funnel_plot.png -------------------------------------------------------------------------------- /man/figures/forest-arrangement.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/forest-arrangement.pdf -------------------------------------------------------------------------------- /man/figures/forest-arrangement.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/forest-arrangement.png -------------------------------------------------------------------------------- /man/figures/plots-dark.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/plots-dark.pdf -------------------------------------------------------------------------------- /man/figures/plots-dark.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/plots-dark.png -------------------------------------------------------------------------------- /man/figures/plots-light.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/plots-light.pdf -------------------------------------------------------------------------------- /man/figures/plots-light.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/plots-light.png -------------------------------------------------------------------------------- /man/figures/selmodel-beta.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-beta.pdf -------------------------------------------------------------------------------- /man/figures/selmodel-beta.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-beta.png -------------------------------------------------------------------------------- /man/figures/selmodel-negexppow.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-negexppow.pdf -------------------------------------------------------------------------------- /man/figures/selmodel-negexppow.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-negexppow.png -------------------------------------------------------------------------------- /man/figures/selmodel-preston-prec.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-preston-prec.pdf -------------------------------------------------------------------------------- /man/figures/selmodel-preston-prec.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-preston-prec.png -------------------------------------------------------------------------------- /man/figures/selmodel-preston-step.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-preston-step.pdf -------------------------------------------------------------------------------- /man/figures/selmodel-preston-step.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-preston-step.png -------------------------------------------------------------------------------- /man/figures/selmodel-preston.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-preston.pdf -------------------------------------------------------------------------------- /man/figures/selmodel-preston.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-preston.png -------------------------------------------------------------------------------- /man/figures/selmodel-stepfun-fixed.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-stepfun-fixed.pdf -------------------------------------------------------------------------------- /man/figures/selmodel-stepfun-fixed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-stepfun-fixed.png -------------------------------------------------------------------------------- /man/figures/selmodel-stepfun.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-stepfun.pdf -------------------------------------------------------------------------------- /man/figures/selmodel-stepfun.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/metafor/81c9e138c5b9e3cd14f443baf1099cd2079dcba2/man/figures/selmodel-stepfun.png -------------------------------------------------------------------------------- /man/fitted.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{fitted.rma} 2 | \alias{fitted} 3 | \alias{fitted.rma} 4 | \title{Fitted Values for 'rma' Objects} 5 | \description{ 6 | Function to compute the fitted values for objects of class \code{"rma"}. 7 | } 8 | \usage{ 9 | \method{fitted}{rma}(object, \dots) 10 | } 11 | \arguments{ 12 | \item{object}{an object of class \code{"rma"}.} 13 | \item{\dots}{other arguments.} 14 | } 15 | \value{ 16 | A vector with the fitted values. 17 | } 18 | \note{ 19 | The \code{\link[=predict.rma]{predict}} function also provides standard errors and confidence intervals for the fitted values. Best linear unbiased predictions (BLUPs) that combine the fitted values based on the fixed effects and the estimated contributions of the random effects can be obtained with \code{\link[=blup.rma.uni]{blup}} (only for objects of class \code{"rma.uni"}). 20 | 21 | For objects not involving moderators, the fitted values are all identical to the estimated value of the model intercept. 22 | } 23 | \author{ 24 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 25 | } 26 | \references{ 27 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 28 | } 29 | \seealso{ 30 | \code{\link[=predict.rma]{predict}} for a function to computed predicted values and \code{\link[=blup.rma.uni]{blup}} for a function to compute BLUPs that combine the fitted values and predicted random effects. 31 | } 32 | \examples{ 33 | ### calculate log risk ratios and corresponding sampling variances 34 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 35 | 36 | ### fit mixed-effects model with absolute latitude and publication year as moderators 37 | res <- rma(yi, vi, mods = ~ ablat + year, data=dat) 38 | 39 | ### compute the fitted values 40 | fitted(res) 41 | } 42 | \keyword{models} 43 | -------------------------------------------------------------------------------- /man/forest.Rd: -------------------------------------------------------------------------------- 1 | \name{forest} 2 | \alias{forest} 3 | \title{Forest Plots} 4 | \description{ 5 | Function to create forest plots. 6 | } 7 | \usage{ 8 | forest(x, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{either an object of class \code{"rma"}, a vector with the observed effect sizes or outcomes, or an object of class \code{"cumul.rma"}. See \sQuote{Details}.} 12 | \item{\dots}{other arguments.} 13 | } 14 | \details{ 15 | Currently, methods exist for three types of situations. 16 | 17 | In the first case, object \code{x} is a fitted model object coming from the \code{\link{rma.uni}}, \code{\link{rma.mh}}, or \code{\link{rma.peto}} functions. The corresponding method is then \code{\link{forest.rma}}. 18 | 19 | Alternatively, object \code{x} can be a vector with the observed effect sizes or outcomes. The corresponding method is then \code{\link{forest.default}}. 20 | 21 | Finally, object \code{x} can be an object coming from the \code{\link{cumul.rma.uni}}, \code{\link{cumul.rma.mh}}, or \code{\link{cumul.rma.peto}} functions. The corresponding method is then \code{\link{forest.cumul.rma}}. 22 | } 23 | \author{ 24 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 25 | } 26 | \references{ 27 | Lewis, S., & Clarke, M. (2001). Forest plots: Trying to see the wood and the trees. \emph{British Medical Journal}, \bold{322}(7300), 1479--1480. \verb{https://doi.org/10.1136/bmj.322.7300.1479} 28 | 29 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 30 | } 31 | \seealso{ 32 | \code{\link{forest.rma}}, \code{\link{forest.default}}, and \code{\link{forest.cumul.rma}} for the specific method functions. 33 | } 34 | \keyword{hplot} 35 | -------------------------------------------------------------------------------- /man/formula.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{formula.rma} 2 | \alias{formula} 3 | \alias{formula.rma} 4 | \title{Extract the Model Formula from 'rma' Objects} 5 | \description{ 6 | Function to extract the model formula from objects of class \code{"rma"}. 7 | } 8 | \usage{ 9 | \method{formula}{rma}(x, type="mods", \dots) 10 | } 11 | \arguments{ 12 | \item{x}{an object of class \code{"rma"}.} 13 | \item{type}{the formula which should be returned; either \code{"mods"} (default), \code{"yi"} (in case argument \code{yi} was used to specify a formula), or \code{"scale"} (only for location-scale models).} 14 | \item{\dots}{other arguments.} 15 | } 16 | \value{ 17 | The requested formula. 18 | } 19 | \author{ 20 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 21 | } 22 | \references{ 23 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 24 | } 25 | \seealso{ 26 | \code{\link{rma.uni}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which a model formula can be extracted. 27 | } 28 | \examples{ 29 | ### copy BCG vaccine data into 'dat' 30 | dat <- dat.bcg 31 | 32 | ### calculate log risk ratios and corresponding sampling variances 33 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, 34 | slab=paste(author, ", ", year, sep="")) 35 | 36 | ### mixed-effects meta-regression model 37 | res <- rma(yi, vi, mods = ~ ablat + alloc, data=dat) 38 | formula(res, type="mods") 39 | 40 | ### specify moderators via 'yi' argument 41 | res <- rma(yi ~ ablat + alloc, vi, data=dat) 42 | formula(res, type="yi") 43 | } 44 | \keyword{models} 45 | -------------------------------------------------------------------------------- /man/macros/metafor.Rd: -------------------------------------------------------------------------------- 1 | \newcommand{\icsl}{\out{\hspace*{0.1em}}} 2 | \newcommand{\icsh}{\out{ }} 3 | \newcommand{\ics}{\ifelse{latex}{\icsl}{\ifelse{html}{\icsh}{ }}} 4 | -------------------------------------------------------------------------------- /man/metafor.news.Rd: -------------------------------------------------------------------------------- 1 | \name{metafor.news} 2 | \alias{metafor.news} 3 | \title{Read News File of the Metafor Package} 4 | \description{ 5 | Function to read the \file{NEWS} file of the \pkg{\link{metafor-package}}. 6 | } 7 | \usage{ 8 | metafor.news() 9 | } 10 | \details{ 11 | The function is simply a wrapper for \code{news(package="metafor")} which parses and displays the \file{NEWS} file of the package. 12 | } 13 | \author{ 14 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 15 | } 16 | \references{ 17 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 18 | } 19 | \examples{ 20 | \dontrun{ 21 | metafor.news() 22 | } 23 | } 24 | \keyword{utilities} 25 | -------------------------------------------------------------------------------- /man/methods.anova.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{methods.anova.rma} 2 | \alias{methods.anova.rma} 3 | \alias{as.data.frame.anova.rma} 4 | \alias{as.data.frame.list.anova.rma} 5 | \title{Methods for 'anova.rma' Objects} 6 | \description{ 7 | Methods for objects of class \code{"anova.rma"} and \code{"list.anova.rma"}. 8 | } 9 | \usage{ 10 | \method{as.data.frame}{anova.rma}(x, \dots) 11 | \method{as.data.frame}{list.anova.rma}(x, \dots) 12 | } 13 | \arguments{ 14 | \item{x}{an object of class \code{"anova.rma"} or \code{"list.anova.rma"}.} 15 | \item{\dots}{other arguments.} 16 | } 17 | \author{ 18 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 19 | } 20 | \references{ 21 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 22 | } 23 | \examples{ 24 | ### copy data into 'dat' 25 | dat <- dat.bcg 26 | 27 | ### calculate log risk ratios and corresponding sampling variances 28 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) 29 | 30 | ### fit mixed-effects meta-regression model 31 | res <- rma(yi, vi, mods = ~ alloc + ablat, data=dat) 32 | 33 | ### test the allocation factor 34 | sav <- anova(res, btt="alloc") 35 | sav 36 | 37 | ### turn object into a regular data frame 38 | as.data.frame(sav) 39 | 40 | ### test the contrast between levels random and systematic 41 | sav <- anova(res, X=c(0,1,-1,0)) 42 | sav 43 | 44 | ### turn object into a regular data frame 45 | as.data.frame(sav) 46 | 47 | ### fit random-effects model 48 | res0 <- rma(yi, vi, data=dat) 49 | 50 | ### LRT comparing the two models 51 | sav <- anova(res, res0, refit=TRUE) 52 | sav 53 | 54 | ### turn object into a regular data frame 55 | as.data.frame(sav) 56 | } 57 | \keyword{internal} 58 | -------------------------------------------------------------------------------- /man/methods.confint.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{methods.confint.rma} 2 | \alias{methods.confint.rma} 3 | \alias{as.data.frame.confint.rma} 4 | \alias{as.data.frame.list.confint.rma} 5 | \title{Methods for 'confint.rma' Objects} 6 | \description{ 7 | Methods for objects of class \code{"confint.rma"} and \code{"list.confint.rma"}. 8 | } 9 | \usage{ 10 | \method{as.data.frame}{confint.rma}(x, \dots) 11 | \method{as.data.frame}{list.confint.rma}(x, \dots) 12 | } 13 | \arguments{ 14 | \item{x}{an object of class \code{"confint.rma"} or \code{"list.confint.rma"}.} 15 | \item{\dots}{other arguments.} 16 | } 17 | \author{ 18 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 19 | } 20 | \references{ 21 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 22 | } 23 | \examples{ 24 | ### copy data into 'dat' 25 | dat <- dat.bcg 26 | 27 | ### calculate log risk ratios and corresponding sampling variances 28 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) 29 | 30 | ### fit random-effects model 31 | res <- rma(yi, vi, data=dat) 32 | 33 | ### get 95\% CI for tau^2, tau, I^2, and H^2 34 | sav <- confint(res) 35 | sav 36 | 37 | ### turn object into a regular data frame 38 | as.data.frame(sav) 39 | 40 | ############################################################################ 41 | 42 | ### copy data into 'dat' 43 | dat <- dat.berkey1998 44 | 45 | ### construct block diagonal var-cov matrix of the observed outcomes based on variables v1i and v2i 46 | V <- vcalc(vi=1, cluster=author, rvars=c(v1i, v2i), data=dat) 47 | 48 | ### fit multivariate model 49 | res <- rma.mv(yi, V, mods = ~ 0 + outcome, random = ~ outcome | trial, struct="UN", data=dat) 50 | 51 | ### get 95\% CI for variance components and correlation 52 | sav <- confint(res) 53 | sav 54 | 55 | ### turn object into a regular data frame 56 | as.data.frame(sav) 57 | } 58 | \keyword{internal} 59 | -------------------------------------------------------------------------------- /man/methods.deltamethod.Rd: -------------------------------------------------------------------------------- 1 | \name{coef.deltamethod} 2 | \alias{coef.deltamethod} 3 | \alias{vcov.deltamethod} 4 | \title{Extract the Estimates and Variance-Covariance Matrix from 'deltamethod' Objects} 5 | \description{ 6 | Methods for objects of class \code{"deltamethod"}. 7 | } 8 | \usage{ 9 | \method{coef}{deltamethod}(object, \dots) 10 | \method{vcov}{deltamethod}(object, \dots) 11 | } 12 | \arguments{ 13 | \item{object}{an object of class \code{"deltamethod"}.} 14 | \item{\dots}{other arguments.} 15 | } 16 | \details{ 17 | The \code{coef} function extracts the transformed estimates from objects of class \code{"deltamethod"}. The \code{vcov} function extracts the corresponding variance-covariance matrix. 18 | } 19 | \value{ 20 | Either a vector with the transformed estimates or a variance-covariance matrix. 21 | } 22 | \author{ 23 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 24 | } 25 | \references{ 26 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 27 | } 28 | \seealso{ 29 | \code{\link{deltamethod}} for the function to create \code{deltamethod} objects. 30 | } 31 | \keyword{models} 32 | -------------------------------------------------------------------------------- /man/methods.escalc.Rd: -------------------------------------------------------------------------------- 1 | \name{methods.escalc} 2 | \alias{methods.escalc} 3 | \alias{[.escalc} 4 | \alias{$<-.escalc} 5 | \alias{cbind.escalc} 6 | \alias{rbind.escalc} 7 | \title{Methods for 'escalc' Objects} 8 | \description{ 9 | Methods for objects of class \code{"escalc"}. 10 | } 11 | \usage{ 12 | \method{[}{escalc}(x, i, \dots) 13 | \method{$}{escalc}(x, name) <- value 14 | \method{cbind}{escalc}(\dots, deparse.level=1) 15 | \method{rbind}{escalc}(\dots, deparse.level=1) 16 | } 17 | \arguments{ 18 | \item{x}{an object of class \code{"escalc"}.} 19 | \item{\dots}{other arguments.} 20 | } 21 | \note{ 22 | For the \code{`[`} method, any variables specified as part of the \code{i} argument will be searched for within object \code{x} first (see \sQuote{Examples}). 23 | } 24 | \author{ 25 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 26 | } 27 | \references{ 28 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 29 | } 30 | \examples{ 31 | ### calculate log risk ratios and corresponding sampling variances 32 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 33 | 34 | ### select rows where variable 'alloc' is equal to 'random' 35 | dat[dat$alloc == "random",] 36 | 37 | ### variables specified are automatically searched for within the object itself 38 | dat[alloc == "random",] 39 | 40 | ### note: this behavior is specific to 'escalc' objects; this doesn't work for regular data frames 41 | } 42 | \keyword{internal} 43 | -------------------------------------------------------------------------------- /man/methods.list.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{methods.list.rma} 2 | \alias{methods.list.rma} 3 | \alias{as.data.frame.list.rma} 4 | \alias{as.matrix.list.rma} 5 | \alias{[.list.rma} 6 | \alias{head.list.rma} 7 | \alias{tail.list.rma} 8 | \alias{$<-.list.rma} 9 | \title{Methods for 'list.rma' Objects} 10 | \description{ 11 | Methods for objects of class \code{"list.rma"}. 12 | } 13 | \usage{ 14 | \method{as.data.frame}{list.rma}(x, \dots) 15 | \method{as.matrix}{list.rma}(x, \dots) 16 | \method{[}{list.rma}(x, i, \dots) 17 | \method{head}{list.rma}(x, n=6L, \dots) 18 | \method{tail}{list.rma}(x, n=6L, \dots) 19 | \method{$}{list.rma}(x, name) <- value 20 | } 21 | \arguments{ 22 | \item{x}{an object of class \code{"list.rma"}.} 23 | \item{\dots}{other arguments.} 24 | } 25 | \note{ 26 | For the \code{`[`} method, any variables specified as part of the \code{i} argument will be searched for within object \code{x} first (see \sQuote{Examples}). 27 | } 28 | \author{ 29 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 30 | } 31 | \references{ 32 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 33 | } 34 | \examples{ 35 | ### copy data into 'dat' and examine data 36 | dat <- dat.viechtbauer2021 37 | 38 | ### calculate log odds ratios and corresponding sampling variances 39 | dat <- escalc(measure="OR", ai=xTi, n1i=nTi, ci=xCi, n2i=nCi, add=1/2, to="all", data=dat) 40 | 41 | ### fit mixed-effects meta-regression model 42 | res <- rma(yi, vi, mods = ~ dose, data=dat) 43 | 44 | ### get studentized residuals 45 | sav <- rstudent(res) 46 | sav 47 | 48 | ### studies with studentized residuals larger than +-1.96 49 | sav[abs(sav$z) > 1.96,] 50 | 51 | ### variables specified are automatically searched for within the object itself 52 | sav[abs(z) > 1.96,] 53 | 54 | ### note: this behavior is specific to 'rma.list' objects; this doesn't work for regular data frames 55 | } 56 | \keyword{internal} 57 | -------------------------------------------------------------------------------- /man/methods.matreg.Rd: -------------------------------------------------------------------------------- 1 | \name{coef.matreg} 2 | \alias{coef.matreg} 3 | \alias{vcov.matreg} 4 | \title{Extract the Model Coefficients and Variance-Covariance Matrix from 'matreg' Objects} 5 | \description{ 6 | Methods for objects of class \code{"matreg"}. 7 | } 8 | \usage{ 9 | \method{coef}{matreg}(object, \dots) 10 | \method{vcov}{matreg}(object, \dots) 11 | } 12 | \arguments{ 13 | \item{object}{an object of class \code{"matreg"}.} 14 | \item{\dots}{other arguments.} 15 | } 16 | \details{ 17 | The \code{coef} function extracts the estimated model coefficients from objects of class \code{"matreg"}. The \code{vcov} function extracts the corresponding variance-covariance matrix. 18 | } 19 | \value{ 20 | Either a vector with the estimated model coefficients or a variance-covariance matrix. 21 | } 22 | \author{ 23 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 24 | } 25 | \references{ 26 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 27 | } 28 | \seealso{ 29 | \code{\link{matreg}} for the function to create \code{matreg} objects. 30 | } 31 | \examples{ 32 | ### fit a regression model with lm() to the 'mtcars' dataset 33 | res <- lm(mpg ~ hp + wt + am, data=mtcars) 34 | coef(res) 35 | vcov(res) 36 | 37 | ### covariance matrix of the dataset 38 | S <- cov(mtcars) 39 | 40 | ### fit the same regression model using matreg() 41 | res <- matreg(y="mpg", x=c("hp","wt","am"), R=S, cov=TRUE, 42 | means=colMeans(mtcars), n=nrow(mtcars)) 43 | coef(res) 44 | vcov(res) 45 | } 46 | \keyword{models} 47 | -------------------------------------------------------------------------------- /man/methods.vif.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{methods.vif.rma} 2 | \alias{methods.vif.rma} 3 | \alias{as.data.frame.vif.rma} 4 | \title{Methods for 'vif.rma' Objects} 5 | \description{ 6 | Methods for objects of class \code{"vif.rma"}. 7 | } 8 | \usage{ 9 | \method{as.data.frame}{vif.rma}(x, \dots) 10 | } 11 | \arguments{ 12 | \item{x}{an object of class \code{"vif.rma"}.} 13 | \item{\dots}{other arguments.} 14 | } 15 | \author{ 16 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 17 | } 18 | \references{ 19 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 20 | } 21 | \examples{ 22 | ### copy data into 'dat' 23 | dat <- dat.bcg 24 | 25 | ### calculate log risk ratios and corresponding sampling variances 26 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) 27 | 28 | ### fit mixed-effects meta-regression model 29 | res <- rma(yi, vi, mods = ~ ablat + year + alloc, data=dat) 30 | 31 | ### get variance inflation factors for all individual coefficients 32 | sav <- vif(res) 33 | sav 34 | 35 | ### turn object into a regular data frame 36 | as.data.frame(sav) 37 | 38 | ### get VIFs for ablat and year and the generalized VIF for alloc 39 | sav <- vif(res, btt=list("ablat","alloc","year")) 40 | sav 41 | 42 | ### turn object into a regular data frame 43 | as.data.frame(sav) 44 | } 45 | \keyword{internal} 46 | -------------------------------------------------------------------------------- /man/model.matrix.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{model.matrix.rma} 2 | \alias{model.matrix} 3 | \alias{model.matrix.rma} 4 | \title{Extract the Model Matrix from 'rma' Objects} 5 | \description{ 6 | Function to extract the model matrix from objects of class \code{"rma"}. 7 | } 8 | \usage{ 9 | \method{model.matrix}{rma}(object, asdf, \dots) 10 | } 11 | \arguments{ 12 | \item{object}{an object of class \code{"rma"}.} 13 | \item{asdf}{logical to specify whether the model matrix should be turned into a data frame (the default is \code{FALSE}).} 14 | \item{\dots}{other arguments.} 15 | } 16 | \value{ 17 | The model matrix. 18 | } 19 | \author{ 20 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 21 | } 22 | \references{ 23 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 24 | } 25 | \seealso{ 26 | \code{\link{rma.uni}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which a model matrix can be extracted. 27 | 28 | \code{\link[=fitted.rma]{fitted}} for a function to extract the fitted values. 29 | } 30 | \examples{ 31 | ### calculate log risk ratios and corresponding sampling variances 32 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 33 | 34 | ### fit mixed-effects model with absolute latitude and publication year as moderators 35 | res <- rma(yi, vi, mods = ~ ablat + year, data=dat) 36 | 37 | ### extract the model matrix 38 | model.matrix(res) 39 | } 40 | \keyword{models} 41 | -------------------------------------------------------------------------------- /man/print.confint.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{print.confint.rma} 2 | \alias{print.confint.rma} 3 | \alias{print.list.confint.rma} 4 | \title{Print Methods for 'confint.rma' and 'list.confint.rma' Objects} 5 | \description{ 6 | Functions to print objects of class \code{"confint.rma"} and \code{"list.confint.rma"}. 7 | } 8 | \usage{ 9 | \method{print}{confint.rma}(x, digits=x$digits, \dots) 10 | \method{print}{list.confint.rma}(x, digits=x$digits, \dots) 11 | } 12 | \arguments{ 13 | \item{x}{an object of class \code{"confint.rma"} or \code{"list.confint.rma"} obtained with \code{\link[=confint.rma.uni]{confint}}.} 14 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} 15 | \item{\dots}{other arguments.} 16 | } 17 | \details{ 18 | The output includes: 19 | 20 | \itemize{ 21 | \item estimate of the model coefficient or variance/correlation parameter 22 | \item lower bound of the confidence interval 23 | \item upper bound of the confidence interval 24 | } 25 | } 26 | \value{ 27 | The function does not return an object. 28 | } 29 | \author{ 30 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 31 | } 32 | \references{ 33 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 34 | } 35 | \seealso{ 36 | \code{\link[=confint.rma]{confint}} for the functions to create \code{confint.rma} and \code{list.confint.rma} objects. 37 | } 38 | \keyword{print} 39 | -------------------------------------------------------------------------------- /man/print.deltamethod.Rd: -------------------------------------------------------------------------------- 1 | \name{print.deltamethod} 2 | \alias{print.deltamethod} 3 | \title{Print Method for 'deltamethod' Objects} 4 | \description{ 5 | Functions to print objects of class \code{"deltamethod"}. 6 | } 7 | \usage{ 8 | \method{print}{deltamethod}(x, digits, signif.stars=getOption("show.signif.stars"), 9 | signif.legend=signif.stars, \dots) 10 | } 11 | \arguments{ 12 | \item{x}{an object of class \code{"deltamethod"}.} 13 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} 14 | \item{signif.stars}{logical to specify whether p-values should be encoded visually with \sQuote{significance stars}. Defaults to the \code{show.signif.stars} slot of \code{\link{options}}.} 15 | \item{signif.legend}{logical to specify whether the legend for the \sQuote{significance stars} should be printed. Defaults to the value for \code{signif.stars}.} 16 | \item{\dots}{other arguments.} 17 | } 18 | \details{ 19 | The output is a table with the estimated coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds. 20 | } 21 | \value{ 22 | The function does not return an object. 23 | } 24 | \author{ 25 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 26 | } 27 | \seealso{ 28 | \code{\link{deltamethod}} for the function to create \code{deltamethod} objects. 29 | } 30 | \keyword{print} 31 | -------------------------------------------------------------------------------- /man/print.fsn.Rd: -------------------------------------------------------------------------------- 1 | \name{print.fsn} 2 | \alias{print.fsn} 3 | \title{Print Method for 'fsn' Objects} 4 | \description{ 5 | Function to print objects of class \code{"fsn"}. 6 | } 7 | \usage{ 8 | \method{print}{fsn}(x, digits=x$digits, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{an object of class \code{"fsn"} obtained with \code{\link{fsn}}.} 12 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} 13 | \item{\dots}{other arguments.} 14 | } 15 | \details{ 16 | The output shows the results from the fail-safe N calculation. 17 | } 18 | \value{ 19 | The function does not return an object. 20 | } 21 | \author{ 22 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 23 | } 24 | \references{ 25 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 26 | } 27 | \seealso{ 28 | \code{\link{fsn}} for the function to create \code{fsn} objects. 29 | } 30 | \keyword{print} 31 | -------------------------------------------------------------------------------- /man/print.gosh.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{print.gosh.rma} 2 | \alias{print.gosh.rma} 3 | \title{Print Method for 'gosh.rma' Objects} 4 | \description{ 5 | Function to print objects of class \code{"gosh.rma"}. 6 | } 7 | \usage{ 8 | \method{print}{gosh.rma}(x, digits=x$digits, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{an object of class \code{"gosh.rma"} obtained with \code{\link{gosh}}.} 12 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} 13 | \item{\dots}{other arguments.} 14 | } 15 | \details{ 16 | The output shows how many model fits were attempted, how many succeeded, and summary statistics (i.e., the mean, minimum, first quartile, median, third quartile, and maximum) for the various measures of (residual) heterogeneity and the model coefficient(s) computed across all of the subsets. 17 | } 18 | \value{ 19 | The function does not return an object. 20 | } 21 | \author{ 22 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 23 | } 24 | \references{ 25 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 26 | } 27 | \seealso{ 28 | \code{\link{gosh}} for the function to create \code{gosh.rma} objects. 29 | } 30 | \keyword{print} 31 | -------------------------------------------------------------------------------- /man/print.hc.rma.uni.Rd: -------------------------------------------------------------------------------- 1 | \name{print.hc.rma.uni} 2 | \alias{print.hc.rma.uni} 3 | \title{Print Method for 'hc.rma.uni' Objects} 4 | \description{ 5 | Function to print objects of class \code{"hc.rma.uni"}. \loadmathjax 6 | } 7 | \usage{ 8 | \method{print}{hc.rma.uni}(x, digits=x$digits, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{an object of class \code{"hc.rma.uni"} obtained with \code{\link[=hc.rma.uni]{hc}}.} 12 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} 13 | \item{\dots}{other arguments.} 14 | } 15 | \details{ 16 | The output is a data frame with two rows, the first (labeled \code{rma}) corresponding to the results based on the usual estimation method, the second (labeled \code{hc}) corresponding to the results based on the method by Henmi and Copas (2010). The data frame includes the following variables: 17 | 18 | \itemize{ 19 | \item the method used to estimate \mjseqn{\tau^2} (always \code{DL} for \code{hc}) 20 | \item the estimated amount of heterogeneity 21 | \item the estimated average true outcome 22 | \item the corresponding standard error (\code{NA} when \code{transf} argument has been used) 23 | \item the lower and upper confidence interval bounds 24 | } 25 | } 26 | \value{ 27 | The function returns the data frame invisibly. 28 | } 29 | \author{ 30 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 31 | } 32 | \references{ 33 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 34 | } 35 | \seealso{ 36 | \code{\link[=hc.rma.uni]{hc}} for the function to create \code{hc.rma.uni} objects. 37 | } 38 | \keyword{print} 39 | -------------------------------------------------------------------------------- /man/print.list.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{print.list.rma} 2 | \alias{print.list.rma} 3 | \title{Print Method for 'list.rma' Objects} 4 | \description{ 5 | Function to print objects of class \code{"list.rma"}. 6 | } 7 | \usage{ 8 | \method{print}{list.rma}(x, digits=x$digits, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{an object of class \code{"list.rma"}.} 12 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} 13 | \item{\dots}{other arguments.} 14 | } 15 | \value{ 16 | See the documentation of the function that creates the \code{"list.rma"} object for details on what is printed. Regardless of what is printed, a data frame with the results is also returned invisibly. 17 | 18 | See \code{\link{methods.list.rma}} for some additional method functions for \code{"list.rma"} objects. 19 | } 20 | \author{ 21 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 22 | } 23 | \references{ 24 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 25 | } 26 | \keyword{print} 27 | -------------------------------------------------------------------------------- /man/print.matreg.Rd: -------------------------------------------------------------------------------- 1 | \name{print.matreg} 2 | \alias{print.matreg} 3 | \alias{summary.matreg} 4 | \alias{print.summary.matreg} 5 | \title{Print and Summary Methods for 'matreg' Objects} 6 | \description{ 7 | Functions to print objects of class \code{"matreg"} and \code{"summary.matreg"}. \loadmathjax 8 | } 9 | \usage{ 10 | \method{print}{matreg}(x, digits, signif.stars=getOption("show.signif.stars"), 11 | signif.legend=signif.stars, \dots) 12 | 13 | \method{summary}{matreg}(object, digits, \dots) 14 | 15 | \method{print}{summary.matreg}(x, digits, signif.stars=getOption("show.signif.stars"), 16 | signif.legend=signif.stars, \dots) 17 | } 18 | \arguments{ 19 | \item{x}{an object of class \code{"matreg"} or \code{"summary.matreg"} (for \code{print}).} 20 | \item{object}{an object of class \code{"matreg"} (for \code{summary}).} 21 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} 22 | \item{signif.stars}{logical to specify whether p-values should be encoded visually with \sQuote{significance stars}. Defaults to the \code{show.signif.stars} slot of \code{\link{options}}.} 23 | \item{signif.legend}{logical to specify whether the legend for the \sQuote{significance stars} should be printed. Defaults to the value for \code{signif.stars}.} 24 | \item{\dots}{other arguments.} 25 | } 26 | \details{ 27 | The output is a table with the estimated coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds. When using \code{summary}, the output includes additional statistics, including \mjseqn{R^2} and the omnibus test of the model coefficients (either an F- or a chi-square test). 28 | } 29 | \value{ 30 | The function does not return an object. 31 | } 32 | \author{ 33 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 34 | } 35 | \seealso{ 36 | \code{\link{matreg}} for the function to create \code{matreg} objects. 37 | } 38 | \keyword{print} 39 | -------------------------------------------------------------------------------- /man/print.permutest.rma.uni.Rd: -------------------------------------------------------------------------------- 1 | \name{print.permutest.rma.uni} 2 | \alias{print.permutest.rma.uni} 3 | \title{Print Method for 'permutest.rma.uni' Objects} 4 | \description{ 5 | Function to print objects of class \code{"permutest.rma.uni"}. 6 | } 7 | \usage{ 8 | \method{print}{permutest.rma.uni}(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), 9 | signif.legend=signif.stars, \dots) 10 | } 11 | \arguments{ 12 | \item{x}{an object of class \code{"permutest.rma.uni"} obtained with \code{\link[=permutest.rma.uni]{permutest}}.} 13 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} 14 | \item{signif.stars}{logical to specify whether p-values should be encoded visually with \sQuote{significance stars}. Defaults to the \code{show.signif.stars} slot of \code{\link{options}}.} 15 | \item{signif.legend}{logical to specify whether the legend for the \sQuote{significance stars} should be printed. Defaults to the value for \code{signif.stars}.} 16 | \item{\dots}{other arguments.} 17 | } 18 | \details{ 19 | The output includes: 20 | 21 | \itemize{ 22 | \item the results of the omnibus test of moderators. Suppressed if the model includes only one coefficient (e.g., only an intercept, like in the equal- and random-effects models). The p-value is based on the permutation test. 23 | \item a table with the estimated coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds. The p-values are based on permutation tests. If \code{permci} was set to \code{TRUE}, then the permutation-based CI bounds are shown. 24 | } 25 | } 26 | \value{ 27 | The function does not return an object. 28 | } 29 | \author{ 30 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 31 | } 32 | \references{ 33 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 34 | } 35 | \seealso{ 36 | \code{\link[=permutest.rma.uni]{permutest}} for the function to create \code{permutest.rma.uni} objects. 37 | } 38 | \keyword{print} 39 | -------------------------------------------------------------------------------- /man/print.ranktest.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{print.ranktest} 2 | \alias{print.ranktest} 3 | \title{Print Method for 'ranktest' Objects} 4 | \description{ 5 | Function to print objects of class \code{"ranktest"}. 6 | } 7 | \usage{ 8 | \method{print}{ranktest}(x, digits=x$digits, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{an object of class \code{"ranktest"} obtained with \code{\link{ranktest}}.} 12 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} 13 | \item{\dots}{other arguments.} 14 | } 15 | \details{ 16 | The output includes: 17 | 18 | \itemize{ 19 | \item the estimated value of Kendall's tau rank correlation coefficient 20 | \item the corresponding p-value for the test that the true tau is equal to zero 21 | } 22 | } 23 | \value{ 24 | The function does not return an object. 25 | } 26 | \author{ 27 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 28 | } 29 | \references{ 30 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 31 | } 32 | \seealso{ 33 | \code{\link{ranktest}} for the function to create \code{ranktest} objects. 34 | } 35 | \keyword{print} 36 | -------------------------------------------------------------------------------- /man/print.regtest.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{print.regtest} 2 | \alias{print.regtest} 3 | \title{Print Method for 'regtest' Objects} 4 | \description{ 5 | Function to print objects of class \code{"regtest"}. 6 | } 7 | \usage{ 8 | \method{print}{regtest}(x, digits=x$digits, ret.fit=x$ret.fit, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{an object of class \code{"regtest"} obtained with \code{\link{regtest}}.} 12 | \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} 13 | \item{ret.fit}{logical to specify whether the full results from the fitted model should also be returned. If unspecified, the default is to take the value from the object.} 14 | \item{\dots}{other arguments.} 15 | } 16 | \details{ 17 | The output includes: 18 | 19 | \itemize{ 20 | \item the model used for the regression test 21 | \item the predictor used for the regression test 22 | \item the results from the fitted model (only when \code{ret.fit=TRUE}) 23 | \item the test statistic of the test that the predictor is unreleated to the outcomes 24 | \item the degrees of freedom of the test statistic (only if the test statistic follows a t-distribution) 25 | \item the corresponding p-value 26 | \item the \sQuote{limit estimate} and its corresponding CI (only for predictors \code{"sei"} \code{"vi"}, \code{"ninv"}, or \code{"sqrtninv"} and when the model does not contain any additional moderators) 27 | } 28 | } 29 | \value{ 30 | The function does not return an object. 31 | } 32 | \author{ 33 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 34 | } 35 | \references{ 36 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 37 | } 38 | \seealso{ 39 | \code{\link{regtest}} for the function to create \code{regtest} objects. 40 | } 41 | \keyword{print} 42 | -------------------------------------------------------------------------------- /man/replmiss.Rd: -------------------------------------------------------------------------------- 1 | \name{replmiss} 2 | \alias{replmiss} 3 | \title{Replace Missing Values in a Vector} 4 | \description{ 5 | Function to replace missing (\code{NA}) values in a vector. 6 | } 7 | \usage{ 8 | replmiss(x, y, data) 9 | } 10 | \arguments{ 11 | \item{x}{vector that may include one or more missing values.} 12 | \item{y}{either a scalar or a vector of the same length as \code{x} with the value(s) to replace missing values with.} 13 | \item{data}{optional data frame containing the variables given to the arguments above.} 14 | } 15 | \value{ 16 | Vector \code{x} with the missing values replaced based on the scalar or vector \code{y}. 17 | } 18 | \author{ 19 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 20 | } 21 | \examples{ 22 | x <- c(4,2,7,NA,1,NA,5) 23 | x <- replmiss(x,0) 24 | x 25 | 26 | x <- c(4,2,7,NA,1,NA,5) 27 | y <- c(2,3,6,5,8,1,2) 28 | x <- replmiss(x,y) 29 | x 30 | } 31 | \keyword{manip} 32 | -------------------------------------------------------------------------------- /man/se.Rd: -------------------------------------------------------------------------------- 1 | \name{se} 2 | \alias{se} 3 | \alias{se.default} 4 | \alias{se.rma} 5 | \title{Extract the Standard Errors from 'rma' Objects} 6 | \description{ 7 | Function to extract the standard errors from objects of class \code{"rma"}. 8 | } 9 | \usage{ 10 | se(object, \dots) 11 | \method{se}{default}(object, \dots) 12 | \method{se}{rma}(object, \dots) 13 | } 14 | \arguments{ 15 | \item{object}{an object of class \code{"rma"}.} 16 | \item{\dots}{other arguments.} 17 | } 18 | \value{ 19 | A vector with the standard errors. 20 | } 21 | \author{ 22 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 23 | } 24 | \references{ 25 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 26 | } 27 | \seealso{ 28 | \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which standard errors can be extracted. 29 | } 30 | \examples{ 31 | ### calculate log risk ratios and corresponding sampling variances 32 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 33 | 34 | ### fit mixed-effects model with absolute latitude and publication year as moderators 35 | res <- rma(yi, vi, mods = ~ ablat + year, data=dat) 36 | res 37 | 38 | ### extract model coefficients 39 | coef(res) 40 | 41 | ### extract the standard errors 42 | se(res) 43 | } 44 | \keyword{models} 45 | -------------------------------------------------------------------------------- /man/update.rma.Rd: -------------------------------------------------------------------------------- 1 | \name{update.rma} 2 | \alias{update} 3 | \alias{update.rma} 4 | \title{Model Updating for 'rma' Objects} 5 | \description{ 6 | Function to update and (by default) refit \code{"rma"} models. It does this by extracting the call stored in the object, updating the call, and (by default) evaluating that call. 7 | } 8 | \usage{ 9 | \method{update}{rma}(object, formula., \dots, evaluate=TRUE) 10 | } 11 | \arguments{ 12 | \item{object}{an object of class \code{"rma"}.} 13 | \item{formula.}{changes to the formula. See \sQuote{Details}.} 14 | \item{\dots}{additional arguments to the call, or arguments with changed values.} 15 | \item{evaluate}{logical to specify whether to evaluate the new call or just return the call.} 16 | } 17 | \details{ 18 | For objects of class \code{"rma.uni"}, \code{"rma.glmm"}, and \code{"rma.mv"}, the \code{formula.} argument can be used to update the set of moderators included in the model (see \sQuote{Examples}). 19 | } 20 | \value{ 21 | If \code{evaluate=TRUE} the fitted object, otherwise the updated call. 22 | } 23 | \author{ 24 | Based on \code{\link{update.default}}, with changes made by Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}) so that the formula updating works with the (somewhat non-standard) interface of the \code{\link{rma.uni}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} functions. 25 | } 26 | \references{ 27 | Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} 28 | } 29 | \seealso{ 30 | \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models which can be updated / refit. 31 | } 32 | \examples{ 33 | ### calculate log risk ratios and corresponding sampling variances 34 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 35 | 36 | ### fit random-effects model (method="REML" is default) 37 | res <- rma(yi, vi, data=dat, digits=3) 38 | res 39 | 40 | ### fit mixed-effects model with two moderators (absolute latitude and publication year) 41 | res <- update(res, ~ ablat + year) 42 | res 43 | 44 | ### remove 'year' moderator 45 | res <- update(res, ~ . - year) 46 | res 47 | 48 | ### fit model with ML estimation 49 | update(res, method="ML") 50 | 51 | ### example with rma.glmm() 52 | res <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, digits=3) 53 | res <- update(res, mods = ~ ablat) 54 | res 55 | 56 | ### fit conditional model with approximate likelihood 57 | update(res, model="CM.AL") 58 | } 59 | \keyword{models} 60 | -------------------------------------------------------------------------------- /man/vec2mat.Rd: -------------------------------------------------------------------------------- 1 | \name{vec2mat} 2 | \alias{vec2mat} 3 | \title{Convert a Vector into a Square Matrix} 4 | \description{ 5 | Function to convert a vector into a square matrix by filling up the lower triangular part of the matrix. 6 | } 7 | \usage{ 8 | vec2mat(x, diag=FALSE, corr=!diag, dimnames) 9 | } 10 | \arguments{ 11 | \item{x}{a vector of the correct length.} 12 | \item{diag}{logical to specify whether the vector also contains the diagonal values of the lower triangular part of the matrix (the default is \code{FALSE}).} 13 | \item{corr}{logical to specify whether the diagonal of the matrix should be replaced with 1's (the default is to do this when \code{diag=FALSE}).} 14 | \item{dimnames}{optional vector of the correct length with the dimension names of the matrix.} 15 | } 16 | \details{ 17 | The values in \code{x} are filled into the lower triangular part of a square matrix with the appropriate dimensions (which are determined based on the length of \code{x}). If \code{diag=TRUE}, then \code{x} is assumed to also contain the diagonal values of the lower triangular part of the matrix. If \code{corr=TRUE}, then the diagonal of the matrix is replaced with 1's. 18 | } 19 | \value{ 20 | A matrix. 21 | } 22 | \author{ 23 | Wolfgang Viechtbauer (\email{wvb@metafor-project.org}, \url{https://www.metafor-project.org}). 24 | } 25 | \examples{ 26 | vec2mat(1:6, corr=FALSE) 27 | vec2mat(seq(0.2, 0.7, by=0.1), corr=TRUE) 28 | vec2mat(1:10, diag=TRUE) 29 | vec2mat(1:6, corr=FALSE, dimnames=c("A","B","C","D")) 30 | } 31 | \keyword{manip} 32 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | ### to also run skip_on_cran() tests, uncomment: 2 | #Sys.setenv(NOT_CRAN="true") 3 | 4 | library(testthat) 5 | library(metafor) 6 | test_check("metafor", reporter="summary") 7 | -------------------------------------------------------------------------------- /tests/testthat/test_analysis_example_henmi2010.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/analyses:henmi2010 4 | 5 | source("settings.r") 6 | 7 | context("Checking analysis example: henmi2010") 8 | 9 | ### load dataset 10 | dat <- dat.lee2004 11 | 12 | ### calculate log odds ratios and corresponding sampling variances 13 | dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat) 14 | 15 | test_that("results are correct for the random-effects model.", { 16 | 17 | ### fit random-effects model with DL estimator 18 | res <- rma(yi, vi, data=dat, method="DL") 19 | 20 | ### compare with results on page 2978 21 | expect_equivalent(res$tau2, 0.3325, tolerance=.tol[["var"]]) 22 | expect_equivalent(coef(res), -0.6787, tolerance=.tol[["coef"]]) 23 | expect_equivalent(res$ci.lb, -1.0664, tolerance=.tol[["ci"]]) 24 | expect_equivalent(res$ci.ub, -0.2911, tolerance=.tol[["ci"]]) 25 | 26 | }) 27 | 28 | test_that("results are correct for the Henmi & Copas method.", { 29 | 30 | ### fit random-effects model with DL estimator 31 | res <- rma(yi, vi, data=dat, method="DL") 32 | 33 | ### apply Henmi & Copas method 34 | sav <- hc(res) 35 | out <- capture.output(print(sav)) ### so that print.hc.rma.uni() is run (at least once) 36 | 37 | ### compare with results on page 2978 38 | expect_equivalent(sav$beta, -0.5145, tolerance=.tol[["coef"]]) 39 | expect_equivalent(sav$ci.lb, -0.9994, tolerance=.tol[["ci"]]) 40 | expect_equivalent(sav$ci.ub, -0.0295, tolerance=.tol[["ci"]]) 41 | 42 | }) 43 | 44 | rm(list=ls()) 45 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_coef_se.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: coef() and se() functions") 4 | 5 | source("settings.r") 6 | 7 | test_that("coef() and se() works correctly.", { 8 | 9 | dat <- dat.baskerville2012 10 | res <- rma(smd, se^2, data=dat, method="ML", digits=3) 11 | sel <- selmodel(res, type="beta") 12 | 13 | tmp <- list(beta = c(intrcpt = 0.114740253923052), delta = c(delta.1 = 0.473113053609697, delta.2 = 4.46131624677985)) 14 | expect_equivalent(coef(sel)$beta, tmp$beta, tolerance=.tol[["coef"]]) 15 | expect_equivalent(coef(sel)$delta, tmp$delta, tolerance=.tol[["coef"]]) 16 | expect_equivalent(coef(sel, type="beta"), tmp$beta, tolerance=.tol[["coef"]]) 17 | expect_equivalent(coef(sel, type="delta"), tmp$delta, tolerance=.tol[["coef"]]) 18 | 19 | tmp <- list(beta = c(intrcpt = 0.166413798184622), delta = c(delta.1 = 0.235248084207613, delta.2 = 2.18419833595518)) 20 | expect_equivalent(se(sel)$beta, tmp$beta, tolerance=.tol[["se"]]) 21 | expect_equivalent(se(sel)$delta, tmp$delta, tolerance=.tol[["se"]]) 22 | expect_equivalent(se(sel, type="beta"), tmp$beta, tolerance=.tol[["se"]]) 23 | expect_equivalent(se(sel, type="delta"), tmp$delta, tolerance=.tol[["se"]]) 24 | 25 | dat <- dat.bangertdrowns2004 26 | dat$ni100 <- dat$ni/100 27 | res <- rma(yi, vi, mods = ~ ni100, scale = ~ ni100, data=dat) 28 | 29 | tmp <- list(beta = c(intrcpt = 0.301681362709591, ni100 = -0.0552663301809239), alpha = c(intrcpt = -1.92087854601148, ni100 = -0.917428772771085)) 30 | expect_equivalent(coef(res)$beta, tmp$beta, tolerance=.tol[["coef"]]) 31 | expect_equivalent(coef(res)$alpha, tmp$alpha, tolerance=.tol[["coef"]]) 32 | expect_equivalent(coef(res, type="beta"), tmp$beta, tolerance=.tol[["coef"]]) 33 | expect_equivalent(coef(res, type="alpha"), tmp$alpha, tolerance=.tol[["coef"]]) 34 | 35 | tmp <- list(beta = c(intrcpt = 0.0661161560867381, ni100 = 0.0197546220146866), alpha = c(intrcpt = 0.668982417863205, ni100 = 0.514064772257437)) 36 | expect_equivalent(se(res)$beta, tmp$beta, tolerance=.tol[["se"]]) 37 | expect_equivalent(se(res)$alpha, tmp$alpha, tolerance=.tol[["se"]]) 38 | expect_equivalent(se(res, type="beta"), tmp$beta, tolerance=.tol[["se"]]) 39 | expect_equivalent(se(res, type="alpha"), tmp$alpha, tolerance=.tol[["se"]]) 40 | 41 | }) 42 | 43 | rm(list=ls()) 44 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_confint.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: confint() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("confint() works correctly for 'rma.uni' objects.", { 8 | 9 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 10 | res <- rma(yi, vi, data=dat, method="DL") 11 | sav <- confint(res, fixed=TRUE, transf=exp) 12 | 13 | expect_equivalent(sav$fixed, c(0.4896, 0.3449, 0.6950), tolerance=.tol[["ci"]]) 14 | expect_equivalent(sav$random[1,], c(0.3088, 0.1197, 1.1115), tolerance=.tol[["var"]]) 15 | expect_equivalent(sav$random[3,], c(92.1173, 81.9177, 97.6781), tolerance=.tol[["het"]]) 16 | expect_equivalent(sav$random[4,], c(12.6861, 5.5303, 43.0680), tolerance=.tol[["het"]]) 17 | 18 | sav <- round(as.data.frame(sav), 4) 19 | expect_equivalent(sav[,1], c(0.4896, 0.3088, 0.5557, 92.1173, 12.6861)) 20 | 21 | }) 22 | 23 | test_that("confint() works correctly for 'rma.mh' objects.", { 24 | 25 | res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 26 | sav <- confint(res, transf=exp) 27 | 28 | expect_equivalent(sav$fixed, c(0.6353, 0.5881, 0.6862), tolerance=.tol[["ci"]]) 29 | 30 | }) 31 | 32 | test_that("confint() works correctly for 'rma.peto' objects.", { 33 | 34 | res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 35 | sav <- confint(res, transf=exp) 36 | 37 | expect_equivalent(sav$fixed, c(0.6222, 0.5746, 0.6738), tolerance=.tol[["ci"]]) 38 | 39 | }) 40 | 41 | rm(list=ls()) 42 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_dfround.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: dfround() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("dfround() works correctly.", { 8 | 9 | dat <- as.data.frame(dat.raudenbush1985) 10 | dat$yi <- c(dat$yi) 11 | dat <- dfround(dat, c(rep(NA,8), 2, 3)) 12 | expect_identical(dat$yi, c(0.03, 0.12, -0.14, 1.18, 0.26, -0.06, -0.02, -0.32, 0.27, 0.8, 0.54, 0.18, -0.02, 0.23, -0.18, -0.06, 0.3, 0.07, -0.07)) 13 | expect_identical(dat$vi, c(0.016, 0.022, 0.028, 0.139, 0.136, 0.011, 0.011, 0.048, 0.027, 0.063, 0.091, 0.05, 0.084, 0.084, 0.025, 0.028, 0.019, 0.009, 0.03)) 14 | 15 | }) 16 | 17 | rm(list=ls()) 18 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_emmprep.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: emmprep() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("emmprep() gives correct results for an intercept-only model.", { 8 | 9 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 10 | 11 | res <- rma(yi, vi, data=dat) 12 | 13 | sav <- capture.output(emmprep(res, verbose=TRUE)) 14 | sav <- emmprep(res) 15 | 16 | skip_on_cran() 17 | 18 | tmp <- emmeans::emmeans(sav, specs="1", type="response") 19 | tmp <- as.data.frame(tmp) 20 | 21 | expect_equivalent(tmp$response, 0.4894209, tolerance=.tol[["pred"]]) 22 | expect_equivalent(tmp$asymp.LCL, 0.3440743, tolerance=.tol[["ci"]]) 23 | expect_equivalent(tmp$asymp.UCL, 0.6961661, tolerance=.tol[["ci"]]) 24 | 25 | }) 26 | 27 | test_that("emmprep() gives correct results for a meta-regression model.", { 28 | 29 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 30 | 31 | dat$yi[1] <- NA 32 | res <- suppressWarnings(rma(yi, vi, mods = ~ ablat + alloc, data=dat, subset=-2, test="knha")) 33 | 34 | sav <- emmprep(res) 35 | 36 | skip_on_cran() 37 | 38 | tmp <- emmeans::emmeans(sav, specs="1", type="response") 39 | tmp <- as.data.frame(tmp) 40 | 41 | expect_equivalent(tmp$response, 0.5395324, tolerance=.tol[["pred"]]) 42 | expect_equivalent(tmp$lower.CL, 0.3564229, tolerance=.tol[["ci"]]) 43 | expect_equivalent(tmp$upper.CL, 0.8167130, tolerance=.tol[["ci"]]) 44 | 45 | sav <- emmprep(res, data=dat[-c(1,2),], df=7, sigma=sqrt(res$tau2), tran="log") 46 | tmp <- as.data.frame(tmp) 47 | 48 | expect_equivalent(tmp$response, 0.5395324, tolerance=.tol[["pred"]]) 49 | expect_equivalent(tmp$lower.CL, 0.3564229, tolerance=.tol[["ci"]]) 50 | expect_equivalent(tmp$upper.CL, 0.8167130, tolerance=.tol[["ci"]]) 51 | 52 | }) 53 | 54 | test_that("emmprep() gives correct results for the r-to-z transformation.", { 55 | 56 | dat <- dat.mcdaniel1994 57 | dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat) 58 | 59 | res <- suppressWarnings(rma(yi, vi, mods = ~ factor(type), data=dat, test="knha")) 60 | 61 | sav <- emmprep(res) 62 | 63 | skip_on_cran() 64 | 65 | tmp <- emmeans::emmeans(sav, specs="1", type="response") 66 | tmp <- as.data.frame(tmp) 67 | 68 | expect_equivalent(tmp$response, 0.2218468, tolerance=.tol[["pred"]]) 69 | expect_equivalent(tmp$lower.CL, 0.1680606, tolerance=.tol[["ci"]]) 70 | expect_equivalent(tmp$upper.CL, 0.2743160, tolerance=.tol[["ci"]]) 71 | 72 | }) 73 | 74 | rm(list=ls()) 75 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_formula.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: formula() function") 4 | 5 | source("settings.r") 6 | 7 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 8 | 9 | test_that("formula() works correctly for 'rma.uni' objects.", { 10 | 11 | res <- rma(yi, vi, data=dat, method="DL") 12 | expect_null(formula(res, type="mods")) 13 | expect_null(formula(res, type="yi")) 14 | 15 | res <- rma(yi, vi, mods = ~ ablat, data=dat, method="DL") 16 | expect_equal(~ablat, formula(res, type="mods")) 17 | expect_null(formula(res, type="yi")) 18 | 19 | res <- rma(yi ~ ablat, vi, data=dat, method="DL") 20 | expect_equal(~ablat, formula(res, type="mods")) 21 | expect_equal(yi~ablat, formula(res, type="yi")) 22 | 23 | expect_error(formula(res, type="scale")) 24 | 25 | }) 26 | 27 | rm(list=ls()) 28 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_handling_of_edge_cases_due_to_zeros.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: handling of edge cases due to zeros") 4 | 5 | source("settings.r") 6 | 7 | test_that("rma.peto(), rma.mh(), and rma.glmm() handle outcome1 never occurring properly.", { 8 | 9 | ai <- c(0,0,0,0) 10 | bi <- c(10,15,20,25) 11 | ci <- c(0,0,0,0) 12 | di <- c(10,10,30,20) 13 | 14 | expect_that(suppressWarnings(rma.peto(ai=ai, bi=bi, ci=ci, di=di)), throws_error()) 15 | 16 | expect_warning(res <- rma.mh(measure="OR", ai=ai, bi=bi, ci=ci, di=di)) 17 | expect_true(is.na(res$beta)) 18 | expect_warning(res <- rma.mh(measure="RR", ai=ai, bi=bi, ci=ci, di=di)) 19 | expect_true(is.na(res$beta)) 20 | expect_warning(res <- rma.mh(measure="RD", ai=ai, bi=bi, ci=ci, di=di)) 21 | expect_equivalent(res$beta, 0) 22 | 23 | skip_on_cran() 24 | 25 | expect_error(suppressWarnings(rma.glmm(measure="OR", ai=ai, bi=bi, ci=ci, di=di))) 26 | 27 | }) 28 | 29 | test_that("rma.peto(), rma.mh(), and rma.glmm() handle outcome2 never occurring properly.", { 30 | 31 | ai <- c(10,15,20,25) 32 | bi <- c(0,0,0,0) 33 | ci <- c(10,10,30,20) 34 | di <- c(0,0,0,0) 35 | 36 | expect_error(suppressWarnings(rma.peto(ai=ai, bi=bi, ci=ci, di=di))) 37 | 38 | expect_warning(res <- rma.mh(measure="OR", ai=ai, bi=bi, ci=ci, di=di)) 39 | expect_true(is.na(res$beta)) 40 | expect_warning(res <- rma.mh(measure="RR", ai=ai, bi=bi, ci=ci, di=di)) 41 | expect_equivalent(res$beta, 0) 42 | expect_warning(res <- rma.mh(measure="RD", ai=ai, bi=bi, ci=ci, di=di)) 43 | expect_equivalent(res$beta, 0) 44 | 45 | skip_on_cran() 46 | 47 | expect_error(suppressWarnings(rma.glmm(measure="OR", ai=ai, bi=bi, ci=ci, di=di))) 48 | 49 | }) 50 | 51 | rm(list=ls()) 52 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_list_rma.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: head.list.rma() and tail.list.rma() functions") 4 | 5 | source("settings.r") 6 | 7 | test_that("head.list.rma() works correctly.", { 8 | 9 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 10 | res <- rma(yi, vi, data=dat) 11 | res <- head(rstandard(res), 4) 12 | 13 | sav <- structure(list(resid = c(-0.1748, -0.8709, -0.6335, -0.727), se = c(0.7788, 0.6896, 0.8344, 0.5486), z = c(-0.2244, -1.2629, -0.7592, -1.3253), slab = 1:4, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4)), class = "list.rma") 14 | 15 | expect_equivalent(res, sav, tolerance=.tol[["misc"]]) 16 | 17 | }) 18 | 19 | test_that("tail.list.rma() works correctly.", { 20 | 21 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 22 | res <- rma(yi, vi, data=dat) 23 | res <- tail(rstandard(res), 4) 24 | 25 | sav <- structure(list(resid = c(-0.6568, 0.3752, 1.1604, 0.6972), se = c(0.5949, 0.5416, 0.9019, 0.5936), z = c(-1.104, 0.6927, 1.2867, 1.1746 ), slab = 10:13, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4)), class = "list.rma") 26 | 27 | expect_equivalent(res, sav, tolerance=.tol[["misc"]]) 28 | 29 | }) 30 | 31 | test_that("as.data.frame.list.rma() works correctly.", { 32 | 33 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 34 | res <- rma(yi, vi, mods = ~ ablat, data=dat) 35 | res <- predict(res) 36 | res <- as.data.frame(res) 37 | res <- res[1:3,1:2] 38 | 39 | sav <- structure(list(pred = c(-1.02900878645837, -1.34912705666653, -0.97080546460234), se = c(0.140375124151501, 0.201103941277043, 0.131456743392091)), row.names = c(NA, 3L), class = "data.frame") 40 | 41 | expect_equivalent(res, sav, tolerance=.tol[["misc"]]) 42 | 43 | }) 44 | 45 | test_that("as.matrix.list.rma() works correctly.", { 46 | 47 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 48 | res <- rma(yi, vi, mods = ~ ablat, data=dat) 49 | res <- predict(res) 50 | res <- as.matrix(res) 51 | res <- res[1:3,1:2] 52 | 53 | sav <- structure(c(-1.02900878645837, -1.34912705666653, -0.97080546460234, 0.140375124151501, 0.201103941277043, 0.131456743392091), dim = 3:2, dimnames = list(c("1", "2", "3"), c("pred", "se"))) 54 | 55 | expect_equivalent(res, sav, tolerance=.tol[["misc"]]) 56 | 57 | }) 58 | 59 | rm(list=ls()) 60 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_metan_vs_rma.peto_with_dat.bcg.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: rma.peto() against metan with 'dat.bcg'") 4 | 5 | source("settings.r") 6 | 7 | test_that("results match (EE model, measure='OR').", { 8 | 9 | ### compare results with: metan tpos tneg cpos cneg, peto nograph or log 10 | 11 | res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 12 | 13 | expect_equivalent(res$beta, -0.4744, tolerance=.tol[["coef"]]) 14 | expect_equivalent(res$ci.lb, -0.5541, tolerance=.tol[["ci"]]) 15 | expect_equivalent(res$ci.ub, -0.3948, tolerance=.tol[["ci"]]) 16 | expect_equivalent(res$zval, -11.6689, tolerance=.tol[["test"]]) ### 11.67 in Stata 17 | expect_equivalent(res$QE, 167.7302, tolerance=.tol[["test"]]) 18 | 19 | ### compare results with: metan tpos tneg cpos cneg, peto nograph or 20 | 21 | sav <- predict(res, transf=exp) 22 | 23 | expect_equivalent(sav$pred, 0.6222, tolerance=.tol[["pred"]]) 24 | expect_equivalent(sav$ci.lb, 0.5746, tolerance=.tol[["ci"]]) 25 | expect_equivalent(sav$ci.ub, 0.6738, tolerance=.tol[["ci"]]) 26 | 27 | }) 28 | 29 | rm(list=ls()) 30 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_pdfs.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: pdfs of various measures") 4 | 5 | source("settings.r") 6 | 7 | test_that(".dsmd() works correctly.", { 8 | 9 | d <- metafor:::.dsmd(0.5, n1=15, n2=15, theta=0.8, correct=TRUE) 10 | expect_equivalent(d, 0.8208, tolerance=.tol[["den"]]) 11 | 12 | d <- metafor:::.dsmd(0.5, n1=15, n2=15, theta=0.8, correct=FALSE) 13 | expect_equivalent(d, 0.7757, tolerance=.tol[["den"]]) 14 | 15 | }) 16 | 17 | test_that(".dcor() works correctly.", { 18 | 19 | d <- metafor:::.dcor(0.5, n=15, rho=0.8) 20 | expect_equivalent(d, 0.2255, tolerance=.tol[["den"]]) 21 | 22 | }) 23 | 24 | test_that(".dzcor() works correctly.", { 25 | 26 | d <- metafor:::.dzcor(0.5, n=15, rho=0.8) 27 | expect_equivalent(d, 0.1183, tolerance=.tol[["den"]]) 28 | 29 | d <- metafor:::.dzcor(0.5, n=15, zrho=transf.rtoz(0.8)) 30 | expect_equivalent(d, 0.1183, tolerance=.tol[["den"]]) 31 | 32 | }) 33 | 34 | rm(list=ls()) 35 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_pub_bias.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: regtest() and ranktest() functions") 4 | 5 | source("settings.r") 6 | 7 | test_that("regtest() works correctly for 'rma.uni' objects.", { 8 | 9 | dat <- dat.egger2001 10 | dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat) 11 | res <- rma(yi, vi, data=dat) 12 | sav <- regtest(res) 13 | expect_equivalent(sav$zval, -4.6686, tolerance=.tol[["test"]]) 14 | 15 | out <- capture.output(print(sav)) ### so that print.regtest.rma() is run (at least once) 16 | 17 | sav <- regtest(yi, vi, data=dat) 18 | expect_equivalent(sav$zval, -4.6686, tolerance=.tol[["test"]]) 19 | 20 | sav <- regtest(yi, vi, data=dat) 21 | expect_equivalent(sav$zval, -4.6686, tolerance=.tol[["test"]]) 22 | 23 | sav <- regtest(res, model="lm", predictor="sqrtninv") 24 | expect_equivalent(sav$zval, -5.6083, tolerance=.tol[["test"]]) 25 | 26 | sav <- regtest(yi, vi, data=dat, model="lm", predictor="sqrtninv") 27 | expect_equivalent(sav$zval, -5.6083, tolerance=.tol[["test"]]) 28 | 29 | sav <- regtest(yi, vi, data=dat, model="lm", predictor="sqrtninv") 30 | expect_equivalent(sav$zval, -5.6083, tolerance=.tol[["test"]]) 31 | 32 | }) 33 | 34 | test_that("ranktest() works correctly for 'rma.uni' objects.", { 35 | 36 | dat <- dat.egger2001 37 | dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat) 38 | res <- rma(yi, vi, data=dat) 39 | sav <- ranktest(res) 40 | expect_equivalent(sav$tau, 0.15) 41 | expect_equivalent(sav$pval, 0.4503, tolerance=.tol[["pval"]]) 42 | 43 | sav <- ranktest(yi, vi, data=dat) 44 | expect_equivalent(sav$tau, 0.15) 45 | expect_equivalent(sav$pval, 0.4503, tolerance=.tol[["pval"]]) 46 | 47 | sav <- ranktest(yi, vi, data=dat) 48 | expect_equivalent(sav$tau, 0.15) 49 | expect_equivalent(sav$pval, 0.4503, tolerance=.tol[["pval"]]) 50 | 51 | out <- capture.output(print(sav)) ### so that print.ranktest.rma() is run (at least once) 52 | 53 | }) 54 | 55 | rm(list=ls()) 56 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_replmiss.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: replmiss() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("replmiss() works correctly.", { 8 | 9 | var1 <- c(1:4,NA,6,NA,8:10) 10 | var2 <- as.numeric(1:10) 11 | 12 | expect_identical(replmiss(var1, 0), c(1, 2, 3, 4, 0, 6, 0, 8, 9, 10)) 13 | expect_identical(replmiss(var1, var2), as.numeric(1:10)) 14 | expect_error(replmiss(var1, 1:9)) 15 | 16 | }) 17 | 18 | rm(list=ls()) 19 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_reporter.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: reporter() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("reporter() works correctly for 'rma.uni' objects.", { 8 | 9 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 10 | expect_error(res <- rma(yi, vi, data=dat), NA) # to avoid this being an empty test 11 | 12 | skip_on_cran() 13 | 14 | reporter(res, open=FALSE) 15 | 16 | }) 17 | 18 | rm(list=ls()) 19 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_rma_error_handling.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: proper handling of errors in rma()") 4 | 5 | source("settings.r") 6 | 7 | test_that("rma() handles NAs correctly.", { 8 | 9 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 10 | 11 | dat$yi[1] <- NA 12 | dat$yi[2] <- NA 13 | 14 | expect_warning(res <- rma(yi, vi, data=dat, digits=3)) 15 | 16 | expect_equivalent(res$k, 11) 17 | expect_equivalent(res$k.f, 13) 18 | expect_equivalent(length(res$yi), 11) 19 | expect_equivalent(length(res$yi.f), 13) 20 | expect_equivalent(res$not.na, rep(c(FALSE,TRUE),times=c(2,11))) 21 | 22 | dat$ablat[3] <- NA 23 | 24 | ### TODO: complete this ... 25 | 26 | }) 27 | 28 | rm(list=ls()) 29 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_rma_vs_direct_computation.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: rma.uni() against direct computations") 4 | 5 | source("settings.r") 6 | 7 | test_that("results match (FE model).", { 8 | 9 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 10 | 11 | res <- rma(yi, vi, mods = ~ ablat + year, data=dat, method="FE") 12 | 13 | X <- cbind(1, dat$ablat, dat$year) 14 | W <- diag(1/dat$vi) 15 | y <- cbind(dat$yi) 16 | 17 | beta <- solve(t(X) %*% W %*% X) %*% t(X) %*% W %*% y 18 | vb <- solve(t(X) %*% W %*% X) 19 | 20 | expect_equivalent(res$beta, beta) 21 | expect_equivalent(res$vb, vb) 22 | 23 | yhat <- c(X %*% beta) 24 | 25 | expect_equivalent(fitted(res), yhat) 26 | 27 | H <- X %*% solve(t(X) %*% W %*% X) %*% t(X) %*% W 28 | 29 | expect_equivalent(hatvalues(res, type="matrix"), H) 30 | 31 | ei <- (diag(res$k) - H) %*% y 32 | 33 | expect_equivalent(resid(res), c(ei)) 34 | 35 | }) 36 | 37 | rm(list=ls()) 38 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_rma_vs_lm.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking tip: rma() results match up with those from lm()") 4 | 5 | source("settings.r") 6 | 7 | test_that("results for rma() and lm() match.", { 8 | 9 | dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat.molloy2014) 10 | 11 | res1 <- rma(yi, 0, data=dat) 12 | res2 <- lm(yi ~ 1, data=dat) 13 | 14 | ### coefficients should be the same 15 | expect_equivalent(coef(res1), coef(res2)) 16 | 17 | ### standard errors should be the same 18 | expect_equivalent(se(res1), se(res2)) 19 | 20 | }) 21 | 22 | test_that("results for rma.mv() and lm() match.", { 23 | 24 | dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat.molloy2014) 25 | dat$id <- 1:nrow(dat) 26 | 27 | res1 <- rma.mv(yi, 0, random = ~ 1 | id, data=dat, sparse=.sparse) 28 | res2 <- lm(yi ~ 1, data=dat) 29 | 30 | ### coefficients should be the same 31 | expect_equivalent(coef(res1), coef(res2)) 32 | 33 | ### standard errors should be the same 34 | expect_equivalent(se(res1), se(res2)) 35 | 36 | ### get profile likelihood CI for sigma^2 37 | sav <- confint(res1) 38 | expect_equivalent(sav$random[1,2:3], c(.0111, .0474), tolerance=.tol[["var"]]) 39 | 40 | ### fit with sparse=TRUE 41 | res1 <- rma.mv(yi, 0, random = ~ 1 | id, data=dat, sparse=TRUE) 42 | 43 | ### coefficients should be the same 44 | expect_equivalent(coef(res1), coef(res2)) 45 | 46 | ### standard errors should be the same 47 | expect_equivalent(se(res1), se(res2)) 48 | 49 | ### get profile likelihood CI for sigma^2 50 | sav <- confint(res1) 51 | expect_equivalent(sav$random[1,2:3], c(.0111, .0474), tolerance=.tol[["var"]]) 52 | 53 | }) 54 | 55 | rm(list=ls()) 56 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_tes.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: tes() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("tes() works correctly for 'dat.dorn2007'.", { 8 | 9 | dat <- escalc(measure="RR", ai=x.a, n1i=n.a, ci=x.p, n2i=n.p, data=dat.dorn2007) 10 | 11 | sav <- tes(dat$yi, dat$vi, test="chi2") 12 | out <- capture.output(print(sav)) 13 | 14 | expect_identical(sav$O, 10L) 15 | expect_equivalent(sav$E, 4.923333, tolerance=.tol[["misc"]]) 16 | expect_equivalent(sav$X2, 7.065648, tolerance=.tol[["test"]]) 17 | expect_equivalent(sav$pval, 0.003928794, tolerance=.tol[["pval"]]) 18 | 19 | sav <- tes(yi, vi, data=dat, test="chi2") 20 | expect_equivalent(sav$pval, 0.003928794, tolerance=.tol[["pval"]]) 21 | 22 | sav <- tes(yi, vi, data=dat, test="binom") 23 | expect_equivalent(sav$pval, 0.01159554, tolerance=.tol[["pval"]]) 24 | 25 | skip_on_cran() 26 | 27 | sav <- tes(yi, vi, data=dat, test="exact", progbar=FALSE) 28 | expect_equivalent(sav$pval, 0.007778529, tolerance=.tol[["pval"]]) 29 | 30 | res <- rma(yi, vi, data=dat, method="EE") 31 | sav <- tes(res, test="chi2") 32 | 33 | expect_identical(sav$O, 10L) 34 | expect_equivalent(sav$E, 4.923333, tolerance=.tol[["misc"]]) 35 | expect_equivalent(sav$X2, 7.065648, tolerance=.tol[["test"]]) 36 | expect_equivalent(sav$pval, 0.003928794, tolerance=.tol[["pval"]]) 37 | 38 | }) 39 | 40 | rm(list=ls()) 41 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_transf.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: transformation functions") 4 | 5 | source("settings.r") 6 | 7 | test_that("transformations work correctly.", { 8 | 9 | expect_equivalent(transf.rtoz(.5), 0.549306, tolerance=.tol[["est"]]) 10 | expect_equivalent(transf.ztor(transf.rtoz(.5)), .5) 11 | 12 | expect_equivalent(transf.logit(.1), -2.197225, tolerance=.tol[["est"]]) 13 | expect_equivalent(transf.ilogit(transf.logit(.1)), .1) 14 | 15 | expect_equivalent(transf.arcsin(.1), 0.321751, tolerance=.tol[["est"]]) 16 | expect_equivalent(transf.iarcsin(transf.arcsin(.1)), .1) 17 | 18 | expect_equivalent(transf.pft(.1,10), 0.373394, tolerance=.tol[["est"]]) 19 | expect_equivalent(transf.ipft(transf.pft(.1,10), 10), .1) 20 | expect_equivalent(transf.ipft.hm(transf.pft(.1,10), targs=list(ni=c(10))), .1) 21 | 22 | expect_equivalent(transf.isqrt(.1), 0.01) 23 | 24 | expect_equivalent(transf.irft(.1,10), 0.381721, tolerance=.tol[["est"]]) 25 | expect_equivalent(transf.iirft(transf.irft(.1,10), 10), .1) 26 | 27 | expect_equivalent(transf.ahw(.9), 0.535841, tolerance=.tol[["est"]]) 28 | expect_equivalent(transf.iahw(transf.ahw(.9)), .9) 29 | 30 | expect_equivalent(transf.abt(.9), 2.302585, tolerance=.tol[["est"]]) 31 | expect_equivalent(transf.iabt(transf.abt(.9)), .9) 32 | 33 | expect_equivalent(transf.ztor.int(transf.rtoz(.5), targs=list(tau2=0)), .5) 34 | expect_equivalent(transf.ztor.int(transf.rtoz(.5), targs=list(tau2=0.1)), 0.46663, tolerance=.tol[["est"]]) 35 | 36 | expect_equivalent(transf.exp.int(log(.5), targs=list(tau2=0)), .5) 37 | expect_equivalent(transf.exp.int(log(.5), targs=list(tau2=0.1)), 0.525635, tolerance=.tol[["est"]]) 38 | expect_equivalent(transf.exp.int(log(.5), targs=list(tau2=0.1, lower=-10, upper=10)), exp(log(.5) + 0.1/2), tolerance=.tol[["est"]]) 39 | 40 | expect_equivalent(transf.ilogit.int(transf.logit(.1), targs=list(tau2=0)), .1) 41 | expect_equivalent(transf.ilogit.int(transf.logit(.1), targs=list(tau2=0.1)), 0.103591, tolerance=.tol[["est"]]) 42 | 43 | }) 44 | 45 | rm(list=ls()) 46 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_update.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: update() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("update() works for rma().", { 8 | 9 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 10 | 11 | res1 <- rma(yi, vi, data=dat, method="EE") 12 | res2 <- update(res1, method="DL") 13 | res3 <- rma(yi, vi, data=dat, method="DL") 14 | res4 <- update(res3, ~ ablat) 15 | res5 <- rma(yi, vi, mods = ~ ablat, data=dat, method="DL") 16 | res2$time <- NULL 17 | res3$time <- NULL 18 | res4$time <- NULL 19 | res5$time <- NULL 20 | expect_equivalent(res2, res3) 21 | expect_equivalent(res4, res5) 22 | 23 | }) 24 | 25 | test_that("update() works for rma.mv().", { 26 | 27 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 28 | 29 | res1 <- rma.mv(yi, vi, data=dat, method="EE", sparse=.sparse) 30 | res2 <- update(res1, random = ~ 1 | trial, method="REML") 31 | res3 <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, method="REML", sparse=.sparse) 32 | res4 <- update(res3, ~ ablat) 33 | res5 <- rma.mv(yi, vi, random = ~ 1 | trial, mods = ~ ablat, data=dat, method="REML", sparse=.sparse) 34 | res2$time <- NULL 35 | res3$time <- NULL 36 | res4$time <- NULL 37 | res5$time <- NULL 38 | expect_equivalent(res2, res3) 39 | expect_equivalent(res4, res5) 40 | 41 | }) 42 | 43 | test_that("update() works for rma.glmm().", { 44 | 45 | skip_on_cran() 46 | 47 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 48 | 49 | res1 <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, method="EE") 50 | res2 <- update(res1, method="ML") 51 | res3 <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, method="ML") 52 | res4 <- update(res3, mods = ~ ablat) 53 | res5 <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, mods = ~ ablat, data=dat.bcg, method="ML") 54 | res2$time <- NULL 55 | res3$time <- NULL 56 | res4$time <- NULL 57 | res5$time <- NULL 58 | expect_equivalent(res2, res3) 59 | expect_equivalent(res4, res5) 60 | 61 | }) 62 | 63 | rm(list=ls()) 64 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_vcov.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: vcov() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("vcov() works correctly for 'rma.uni' objects.", { 8 | 9 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 10 | res <- rma(yi ~ ablat, vi, data=dat) 11 | 12 | expect_equivalent(vcov(res), structure(c(0.0621, -0.0016, -0.0016, 1e-04), .Dim = c(2L, 2L), .Dimnames = list(c("intrcpt", "ablat"), c("intrcpt", "ablat"))), tolerance=.tol[["var"]]) 13 | expect_equivalent(diag(vcov(res, type="obs")), dat$vi + res$tau2) 14 | expect_equivalent(vcov(res, type="fitted")[1,], c(0.0197, 0.0269, 0.0184, 0.025, -0.0007, 0.0197, 0.0033, -0.0007, 0.0085, 0.0184, 0.0026, 0.0125, 0.0125), tolerance=.tol[["var"]]) 15 | expect_equivalent(vcov(res, type="resid")[1,], c(0.3822, -0.0269, -0.0184, -0.025, 7e-04, -0.0197, -0.0033, 0.0007, -0.0085, -0.0184, -0.0026, -0.0125, -0.0125), tolerance=.tol[["var"]]) 16 | 17 | }) 18 | 19 | test_that("vcov() works correctly for 'rma.mv' objects.", { 20 | 21 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 22 | res <- rma.mv(yi ~ ablat, vi, random = ~ 1 | trial, data=dat, sparse=.sparse) 23 | 24 | expect_equivalent(vcov(res), structure(c(0.062, -0.0016, -0.0016, 1e-04), .Dim = c(2L, 2L), .Dimnames = list(c("intrcpt", "ablat"), c("intrcpt", "ablat"))), tolerance=.tol[["var"]]) 25 | expect_equivalent(diag(vcov(res, type="obs")), dat$vi + res$sigma2) 26 | expect_equivalent(vcov(res, type="fitted")[1,], c(0.0197, 0.0269, 0.0184, 0.025, -0.0007, 0.0197, 0.0033, -0.0007, 0.0085, 0.0184, 0.0026, 0.0125, 0.0125), tolerance=.tol[["var"]]) 27 | expect_equivalent(vcov(res, type="resid")[1,], c(0.3822, -0.0269, -0.0184, -0.025, 7e-04, -0.0197, -0.0033, 0.0007, -0.0085, -0.0184, -0.0026, -0.0125, -0.0125), tolerance=.tol[["var"]]) 28 | 29 | }) 30 | 31 | rm(list=ls()) 32 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_vec2mat.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: vec2mat() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("vec2mat() works correctly.", { 8 | 9 | sav <- vec2mat(1:6, corr=FALSE) 10 | expect_identical(sav, structure(c(NA, 1, 2, 3, 1, NA, 4, 5, 2, 4, NA, 6, 3, 5, 6, NA), .Dim = c(4L, 4L))) 11 | 12 | sav <- vec2mat(round(seq(0.2, 0.7, by=0.1), 1), corr=TRUE) 13 | expect_identical(sav, structure(c(1, 0.2, 0.3, 0.4, 0.2, 1, 0.5, 0.6, 0.3, 0.5, 1, 0.7, 0.4, 0.6, 0.7, 1), .Dim = c(4L, 4L))) 14 | 15 | sav <- vec2mat(1:10, diag=TRUE) 16 | expect_identical(sav, structure(c(1, 2, 3, 4, 2, 5, 6, 7, 3, 6, 8, 9, 4, 7, 9, 10), .Dim = c(4L, 4L))) 17 | 18 | sav <- vec2mat(1:6, corr=FALSE, dimnames=c("A","B","C","D")) 19 | expect_identical(sav, structure(c(NA, 1, 2, 3, 1, NA, 4, 5, 2, 4, NA, 6, 3, 5, 6, NA), .Dim = c(4L, 4L), .Dimnames = list(c("A", "B", "C", "D"), c("A", "B", "C", "D")))) 20 | 21 | }) 22 | 23 | rm(list=ls()) 24 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_vif.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | context("Checking misc: vif() function") 4 | 5 | source("settings.r") 6 | 7 | test_that("vif() works correctly for 'rma.uni' objects.", { 8 | 9 | dat <- dat.bangertdrowns2004 10 | dat <- dat[!apply(dat[,c("length", "wic", "feedback", "info", "pers", "imag", "meta")], 1, anyNA),] 11 | res <- rma(yi, vi, mods = ~ length + wic + feedback + info + pers + imag + meta, data=dat) 12 | 13 | sav <- vif(res) 14 | out <- capture.output(print(sav)) 15 | 16 | vifs <- c(length = 1.53710262575577, wic = 1.38604929927746, feedback = 1.64904565071108, info = 1.83396138431786, pers = 5.67803138275492, imag = 1.1553714953831, meta = 4.53327503733189) 17 | expect_equivalent(sav$vifs, vifs) 18 | 19 | sav <- vif(res, table=TRUE) 20 | out <- capture.output(print(sav)) 21 | 22 | expect_equivalent(sav$vifs, vifs) 23 | 24 | sav <- vif(res, btt=2:3) 25 | out <- capture.output(print(sav)) 26 | 27 | gvif <- 2.06507966959426 28 | expect_equivalent(sav$vifs, gvif) 29 | 30 | }) 31 | 32 | rm(list=ls()) 33 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_baujat_plot.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:baujat_plot 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: Baujat plot") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | doplot <- function() { 16 | 17 | par(mar=c(5,4,2,2)) 18 | 19 | dat <- dat.pignon2000 20 | dat$yi <- with(dat, OmE/V) 21 | dat$vi <- with(dat, 1/V) 22 | 23 | res <- rma(yi, vi, data=dat, method="EE", slab=id) 24 | 25 | baujat(res, xlim=c(0,20), ylim=c(0,0.2), bty="l", las=1) 26 | 27 | } 28 | 29 | png("images/test_plots_baujat_plot_light_test.png", res=200, width=1800, height=1800, type="cairo") 30 | doplot() 31 | dev.off() 32 | 33 | expect_true(.vistest("images/test_plots_baujat_plot_light_test.png", "images/test_plots_baujat_plot_light.png")) 34 | 35 | png("images/test_plots_baujat_plot_dark_test.png", res=200, width=1800, height=1800, type="cairo") 36 | setmfopt(theme="dark") 37 | doplot() 38 | setmfopt(theme="default") 39 | dev.off() 40 | 41 | expect_true(.vistest("images/test_plots_baujat_plot_dark_test.png", "images/test_plots_baujat_plot_dark.png")) 42 | 43 | }) 44 | 45 | rm(list=ls()) 46 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_caterpillar_plot.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:caterpillar_plot 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: caterpillar plot") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | ### simulate some data 16 | set.seed(5132) 17 | k <- 250 18 | vi <- rchisq(k, df=1) * .03 19 | yi <- rnorm(k, rnorm(k, 0.5, 0.4), sqrt(vi)) 20 | 21 | ### fit RE model 22 | res <- rma(yi, vi) 23 | 24 | doplot <- function() { 25 | 26 | par(mar=c(5,1,2,1)) 27 | 28 | forest(yi, vi, header=FALSE, 29 | xlim=c(-2.5,3.5), ylim=c(-8, 254), 30 | order=yi, 31 | slab=NA, annotate=FALSE, 32 | efac=0, 33 | pch=19, 34 | col="gray40", 35 | psize=2, 36 | cex.lab=1, cex.axis=1, 37 | lty=c("solid","blank")) 38 | 39 | points(sort(yi), k:1, pch=19, cex=0.5) 40 | 41 | addpoly(res, mlab="", cex=1) 42 | text(-2, -2, "RE Model", pos=4, offset=0, cex=1) 43 | 44 | } 45 | 46 | png("images/test_plots_caterpillar_plot_light_test.png", res=200, width=1800, height=1500, type="cairo") 47 | doplot() 48 | dev.off() 49 | 50 | expect_true(.vistest("images/test_plots_caterpillar_plot_light_test.png", "images/test_plots_caterpillar_plot_light.png")) 51 | 52 | png("images/test_plots_caterpillar_plot_dark_test.png", res=200, width=1800, height=1500, type="cairo") 53 | setmfopt(theme="dark") 54 | doplot() 55 | setmfopt(theme="default") 56 | dev.off() 57 | 58 | expect_true(.vistest("images/test_plots_caterpillar_plot_dark_test.png", "images/test_plots_caterpillar_plot_dark.png")) 59 | 60 | }) 61 | 62 | rm(list=ls()) 63 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_contour-enhanced_funnel_plot.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:contour_enhanced_funnel_plot 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: contour-enhanced funnel plot") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | res <- rma(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, measure="RR", 16 | slab=paste(author, year, sep=", "), method="REML") 17 | 18 | png("images/test_plots_contour_enhanced_funnel_plot_light_test.png", res=200, width=1800, height=1500, type="cairo") 19 | 20 | par(mar=c(5,4,1,2)) 21 | 22 | funnel(res, level=c(90, 95, 99), refline=0, legend=TRUE) 23 | 24 | dev.off() 25 | 26 | expect_true(.vistest("images/test_plots_contour_enhanced_funnel_plot_light_test.png", "images/test_plots_contour_enhanced_funnel_plot_light.png")) 27 | 28 | png("images/test_plots_contour_enhanced_funnel_plot_dark_test.png", res=200, width=1800, height=1500, type="cairo") 29 | 30 | setmfopt(theme="dark") 31 | 32 | par(mar=c(5,4,1,2)) 33 | 34 | funnel(res, level=c(90, 95, 99), refline=0, legend=TRUE) 35 | 36 | setmfopt(theme="default") 37 | 38 | dev.off() 39 | 40 | expect_true(.vistest("images/test_plots_contour_enhanced_funnel_plot_dark_test.png", "images/test_plots_contour_enhanced_funnel_plot_dark.png")) 41 | 42 | }) 43 | 44 | rm(list=ls()) 45 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_funnel_plot_variations.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:funnel_plot_variations 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: funnel plot variations") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | ### fit equal-effects model 16 | res <- rma(yi, vi, data=dat.hackshaw1998, measure="OR", method="EE") 17 | 18 | png("images/test_plots_funnel_plot_variations_light_test.png", res=200, width=1800, height=1800, type="cairo") 19 | 20 | par(mfrow=c(2,2)) 21 | 22 | funnel(res, main="Standard Error") 23 | funnel(res, yaxis="vi", main="Sampling Variance") 24 | funnel(res, yaxis="seinv", main="Inverse Standard Error") 25 | funnel(res, yaxis="vinv", main="Inverse Sampling Variance") 26 | 27 | dev.off() 28 | 29 | expect_true(.vistest("images/test_plots_funnel_plot_variations_light_test.png", "images/test_plots_funnel_plot_variations_light.png")) 30 | 31 | png("images/test_plots_funnel_plot_variations_dark_test.png", res=200, width=1800, height=1800, type="cairo") 32 | 33 | setmfopt(theme="dark") 34 | 35 | par(mfrow=c(2,2)) 36 | 37 | funnel(res, main="Standard Error") 38 | funnel(res, yaxis="vi", main="Sampling Variance") 39 | funnel(res, yaxis="seinv", main="Inverse Standard Error") 40 | funnel(res, yaxis="vinv", main="Inverse Sampling Variance") 41 | 42 | setmfopt(theme="default") 43 | 44 | dev.off() 45 | 46 | expect_true(.vistest("images/test_plots_funnel_plot_variations_dark_test.png", "images/test_plots_funnel_plot_variations_dark.png")) 47 | 48 | }) 49 | 50 | rm(list=ls()) 51 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_funnel_plot_with_trim_and_fill.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:funnel_plot_with_trim_and_fill 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: funnel plot with trim and fill") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | res <- rma(yi, vi, data=dat.hackshaw1998, measure="OR") 16 | taf <- trimfill(res) 17 | out <- capture.output(print(taf)) 18 | 19 | png("images/test_plots_funnel_plot_with_trim_and_fill_light_test.png", res=200, width=1800, height=1500, type="cairo") 20 | 21 | par(mar=c(5,4,1,2)) 22 | funnel(taf, legend=list(show="cis")) 23 | 24 | dev.off() 25 | 26 | expect_true(.vistest("images/test_plots_funnel_plot_with_trim_and_fill_light_test.png", "images/test_plots_funnel_plot_with_trim_and_fill_light.png")) 27 | 28 | png("images/test_plots_funnel_plot_with_trim_and_fill_dark_test.png", res=200, width=1800, height=1500, type="cairo") 29 | 30 | setmfopt(theme="dark") 31 | 32 | par(mar=c(5,4,1,2)) 33 | funnel(taf, legend=list(show="cis")) 34 | 35 | setmfopt(theme="default") 36 | 37 | dev.off() 38 | 39 | expect_true(.vistest("images/test_plots_funnel_plot_with_trim_and_fill_dark_test.png", "images/test_plots_funnel_plot_with_trim_and_fill_dark.png")) 40 | 41 | }) 42 | 43 | rm(list=ls()) 44 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_llplot.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | source("settings.r") 4 | 5 | context("Checking plots example: likelihood plot") 6 | 7 | test_that("plot can be drawn.", { 8 | 9 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 10 | 11 | skip_on_cran() 12 | 13 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 14 | 15 | png("images/test_plots_llplot_light_test.png", res=200, width=1800, height=1600, type="cairo") 16 | 17 | par(mar=c(5,4,2,2)) 18 | llplot(measure="GEN", yi=yi, vi=vi, data=dat, lwd=1, refline=NA, xlim=c(-3,2)) 19 | 20 | dev.off() 21 | 22 | expect_true(.vistest("images/test_plots_llplot_light_test.png", "images/test_plots_llplot_light.png")) 23 | 24 | png("images/test_plots_llplot_dark_test.png", res=200, width=1800, height=1600, type="cairo") 25 | 26 | setmfopt(theme="dark") 27 | 28 | par(mar=c(5,4,2,2)) 29 | llplot(measure="GEN", yi=yi, vi=vi, data=dat, lwd=1, refline=NA, xlim=c(-3,2)) 30 | 31 | setmfopt(theme="default") 32 | 33 | dev.off() 34 | 35 | expect_true(.vistest("images/test_plots_llplot_dark_test.png", "images/test_plots_llplot_dark.png")) 36 | 37 | }) 38 | 39 | rm(list=ls()) 40 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_meta-analytic_scatterplot.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:meta_analytic_scatterplot 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: meta-analytic scatterplot") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 16 | res <- rma(yi, vi, mods = ~ ablat, data=dat) 17 | 18 | png("images/test_plots_meta_analytic_scatterplot_light_test.png", res=200, width=1800, height=1500, type="cairo") 19 | 20 | par(mar=c(5,5,1,2)) 21 | 22 | regplot(res, xlim=c(10,60), predlim=c(10,60), xlab="Absolute Latitude", refline=0, 23 | atransf=exp, at=log(seq(0.2,1.6,by=0.2)), digits=1, las=1, bty="l", 24 | label=c(4,7,12,13), offset=c(1.6,0.8), labsize=0.9) 25 | 26 | dev.off() 27 | 28 | expect_true(.vistest("images/test_plots_meta_analytic_scatterplot_light_test.png", "images/test_plots_meta_analytic_scatterplot_light.png")) 29 | 30 | png("images/test_plots_meta_analytic_scatterplot_dark_test.png", res=200, width=1800, height=1500, type="cairo") 31 | 32 | setmfopt(theme="dark") 33 | 34 | par(mar=c(5,5,1,2)) 35 | 36 | regplot(res, xlim=c(10,60), predlim=c(10,60), xlab="Absolute Latitude", refline=0, 37 | atransf=exp, at=log(seq(0.2,1.6,by=0.2)), digits=1, las=1, bty="l", 38 | label=c(4,7,12,13), offset=c(1.6,0.8), labsize=0.9) 39 | 40 | setmfopt(theme="default") 41 | 42 | dev.off() 43 | 44 | expect_true(.vistest("images/test_plots_meta_analytic_scatterplot_dark_test.png", "images/test_plots_meta_analytic_scatterplot_dark.png")) 45 | 46 | }) 47 | 48 | rm(list=ls()) 49 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_plot_of_cumulative_results.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:plot_of_cumulative_results 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: plot of cumulative results") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 16 | res <- rma(yi, vi, data=dat) 17 | tmp <- cumul(res, order=year) 18 | 19 | png("images/test_plots_plot_of_cumulative_results_light_test.png", res=200, width=1800, height=1600, type="cairo") 20 | 21 | par(mar=c(5,5,2,2)) 22 | plot(tmp, transf=exp, xlim=c(0.25,0.5), lwd=3, cex=1.3) 23 | 24 | dev.off() 25 | 26 | expect_true(.vistest("images/test_plots_plot_of_cumulative_results_light_test.png", "images/test_plots_plot_of_cumulative_results_light.png")) 27 | 28 | png("images/test_plots_plot_of_cumulative_results_dark_test.png", res=200, width=1800, height=1600, type="cairo") 29 | 30 | setmfopt(theme="dark") 31 | 32 | par(mar=c(5,5,2,2)) 33 | plot(tmp, transf=exp, xlim=c(0.25,0.5), lwd=3, cex=1.3) 34 | 35 | setmfopt(theme="default") 36 | 37 | dev.off() 38 | 39 | expect_true(.vistest("images/test_plots_plot_of_cumulative_results_dark_test.png", "images/test_plots_plot_of_cumulative_results_dark.png")) 40 | 41 | }) 42 | 43 | rm(list=ls()) 44 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_plot_of_influence_diagnostics.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:plot_of_influence_diagnostics 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: plot of influence diagnostics") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | res <- rma(ri=ri, ni=ni, measure="ZCOR", data=dat.mcdaniel1994) 16 | inf <- influence(res) 17 | out <- capture.output(print(inf)) # so that print.infl.rma.uni() is run (at least once) 18 | 19 | png("images/test_plots_plot_of_influence_diagnostics_1_light_test.png", res=200, width=1800, height=3600, type="cairo") 20 | par(mfrow=c(8,1)) 21 | plot(inf) 22 | dev.off() 23 | 24 | expect_true(.vistest("images/test_plots_plot_of_influence_diagnostics_1_light_test.png", "images/test_plots_plot_of_influence_diagnostics_1_light.png")) 25 | 26 | png("images/test_plots_plot_of_influence_diagnostics_1_dark_test.png", res=200, width=1800, height=3600, type="cairo") 27 | setmfopt(theme="dark") 28 | par(mfrow=c(8,1)) 29 | plot(inf) 30 | setmfopt(theme="default") 31 | dev.off() 32 | 33 | expect_true(.vistest("images/test_plots_plot_of_influence_diagnostics_1_dark_test.png", "images/test_plots_plot_of_influence_diagnostics_1_dark.png")) 34 | 35 | png("images/test_plots_plot_of_influence_diagnostics_2_light_test.png", res=200, width=1800, height=1800, type="cairo") 36 | plot(inf, plotinf=FALSE, plotdfbs=TRUE) 37 | dev.off() 38 | 39 | expect_true(.vistest("images/test_plots_plot_of_influence_diagnostics_2_light_test.png", "images/test_plots_plot_of_influence_diagnostics_2_light.png")) 40 | 41 | png("images/test_plots_plot_of_influence_diagnostics_2_dark_test.png", res=200, width=1800, height=1800, type="cairo") 42 | setmfopt(theme="dark") 43 | plot(inf, plotinf=FALSE, plotdfbs=TRUE) 44 | setmfopt(theme="default") 45 | dev.off() 46 | 47 | expect_true(.vistest("images/test_plots_plot_of_influence_diagnostics_2_dark_test.png", "images/test_plots_plot_of_influence_diagnostics_2_dark.png")) 48 | 49 | }) 50 | 51 | rm(list=ls()) 52 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_radial_plot.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:radial_plot 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: radial (Galbraith) plot") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | res <- rma(yi, vi, data=dat.hackshaw1998, method="EE") 16 | 17 | png("images/test_plots_radial_plot_light_test.png", res=200, width=1800, height=1800, type="cairo") 18 | 19 | par(mar=c(5,4,0,3)) 20 | radial(res) 21 | 22 | dev.off() 23 | 24 | expect_true(.vistest("images/test_plots_radial_plot_light_test.png", "images/test_plots_radial_plot_light.png")) 25 | 26 | png("images/test_plots_radial_plot_dark_test.png", res=200, width=1800, height=1800, type="cairo") 27 | 28 | setmfopt(theme="dark") 29 | 30 | par(mar=c(5,4,0,3)) 31 | radial(res) 32 | 33 | setmfopt(theme="default") 34 | 35 | dev.off() 36 | 37 | expect_true(.vistest("images/test_plots_radial_plot_dark_test.png", "images/test_plots_radial_plot_dark.png")) 38 | 39 | }) 40 | 41 | rm(list=ls()) 42 | -------------------------------------------------------------------------------- /tests/testthat/test_plots_regplot.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/plots:baujat_plot 4 | 5 | source("settings.r") 6 | 7 | context("Checking plots example: scatter/bubble plot") 8 | 9 | test_that("plot can be drawn.", { 10 | 11 | expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message 12 | 13 | skip_on_cran() 14 | 15 | dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) 16 | res <- rma(yi, vi, mods = ~ ablat, data=dat) 17 | 18 | png("images/test_plots_regplot_light_test.png", res=200, width=1800, height=1500, type="cairo") 19 | 20 | par(mar=c(5,5,1,2)) 21 | 22 | sav <- regplot(res, xlim=c(10,60), predlim=c(10,60), xlab="Absolute Latitude", refline=0, 23 | atransf=exp, at=log(seq(0.2,1.6,by=0.2)), digits=1, las=1, bty="l", 24 | label=c(4,7,12,13), offset=c(1.6,0.8), labsize=0.9, 25 | pi=TRUE, legend=TRUE, grid=TRUE) 26 | points(sav) 27 | 28 | dev.off() 29 | 30 | expect_true(.vistest("images/test_plots_regplot_light_test.png", "images/test_plots_regplot_light.png")) 31 | 32 | png("images/test_plots_regplot_dark_test.png", res=200, width=1800, height=1500, type="cairo") 33 | 34 | setmfopt(theme="dark") 35 | 36 | par(mar=c(5,5,1,2)) 37 | 38 | sav <- regplot(res, xlim=c(10,60), predlim=c(10,60), xlab="Absolute Latitude", refline=0, 39 | atransf=exp, at=log(seq(0.2,1.6,by=0.2)), digits=1, las=1, bty="l", 40 | label=c(4,7,12,13), offset=c(1.6,0.8), labsize=0.9, 41 | pi=TRUE, legend=TRUE, grid=TRUE) 42 | points(sav) 43 | 44 | setmfopt(theme="default") 45 | 46 | dev.off() 47 | 48 | expect_true(.vistest("images/test_plots_regplot_dark_test.png", "images/test_plots_regplot_dark.png")) 49 | 50 | }) 51 | 52 | rm(list=ls()) 53 | -------------------------------------------------------------------------------- /tests/testthat/test_tips_regression_with_rma.r: -------------------------------------------------------------------------------- 1 | ### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true"); Sys.setenv(RUN_VIS_TESTS="true") 2 | 3 | ### see: https://www.metafor-project.org/doku.php/tips:regression_with_rma 4 | 5 | context("Checking tip: rma() results match up with those from lm()") 6 | 7 | source("settings.r") 8 | 9 | test_that("results for rma() and lm() match for method='FE'.", { 10 | 11 | stackloss$vi <- 0 12 | 13 | res.lm <- lm(stack.loss ~ Air.Flow + Water.Temp + Acid.Conc., data=stackloss) 14 | res.rma <- rma(stack.loss, vi, mods = ~ Air.Flow + Water.Temp + Acid.Conc., data=stackloss, test="knha", control=list(REMLf=FALSE)) 15 | 16 | ### log likelihood (REML) should be the same 17 | expect_equivalent(logLik(res.lm, REML=TRUE), logLik(res.rma), tolerance=.tol[["fit"]]) 18 | 19 | ### coefficients should be the same 20 | expect_equivalent(coef(res.lm), coef(res.rma), tolerance=.tol[["coef"]]) 21 | 22 | ### var-cov matrix should be the same 23 | expect_equivalent(matrix(vcov(res.lm), nrow=4, ncol=4), matrix(vcov(res.rma), nrow=4, ncol=4), tolerance=.tol[["var"]]) 24 | 25 | ### fitted values should be the same 26 | expect_equivalent(fitted(res.lm), fitted(res.rma), tolerance=.tol[["pred"]]) 27 | 28 | ### standardized residuals should be the same 29 | expect_equivalent(rstandard(res.lm), rstandard(res.rma)$z, tolerance=.tol[["test"]]) 30 | 31 | ### studentized residuals should be the same 32 | expect_equivalent(rstudent(res.lm), rstudent(res.rma)$z, tolerance=.tol[["test"]]) 33 | 34 | ### hat values should be the same 35 | expect_equivalent(hatvalues(res.lm), hatvalues(res.rma), tolerance=.tol[["inf"]]) 36 | 37 | ### dffits should be the same 38 | expect_equivalent(dffits(res.lm), influence(res.rma)$inf$dffits, tolerance=.tol[["inf"]]) 39 | 40 | ### covratios should be the same 41 | expect_equivalent(covratio(res.lm), influence(res.rma)$inf$cov.r, tolerance=.tol[["inf"]]) 42 | 43 | ### dfbetas should be the same 44 | expect_equivalent(as.matrix(dfbetas(res.lm)), as.matrix(dfbetas(res.rma)), tolerance=.tol[["inf"]]) 45 | 46 | ### Cook's distancs should differ by a factor of p 47 | expect_equivalent(cooks.distance(res.lm), cooks.distance(res.rma)/res.rma$p, tolerance=.tol[["inf"]]) 48 | 49 | }) 50 | 51 | rm(list=ls()) 52 | -------------------------------------------------------------------------------- /vignettes/diagram.pdf.asis: -------------------------------------------------------------------------------- 1 | %\VignetteEngine{R.rsp::asis} 2 | %\VignetteIndexEntry{Diagram of Functions in the metafor Package} 3 | -------------------------------------------------------------------------------- /vignettes/metafor.pdf.asis: -------------------------------------------------------------------------------- 1 | %\VignetteEngine{R.rsp::asis} 2 | %\VignetteIndexEntry{Conducting Meta-Analyses in R with the metafor Package} 3 | --------------------------------------------------------------------------------