Nothing
### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true")
### see also: https://www.metafor-project.org/doku.php/analyses:raudenbush2009
context("Checking analysis example: raudenbush2009")
source("settings.r")
### load data
dat <- dat.raudenbush1985
test_that("results are correct for the equal-effects model.", {
### equal-effects model
res.EE <- rma(yi, vi, data=dat, digits=3, method="EE")
### compare with results on page 301 (Table 16.2) and page 302
expect_equivalent(coef(res.EE), 0.0604, tolerance=.tol[["coef"]])
expect_equivalent(res.EE$QE, 35.8295, tolerance=.tol[["test"]])
expect_equivalent(res.EE$zval, 1.6553, tolerance=.tol[["test"]]) ### 1.65 in chapter
})
test_that("results are correct for the random-effects model.", {
### random-effects model
res.RE <- rma(yi, vi, data=dat, digits=3)
### compare with results on page 301 (Table 16.2) and page 302
expect_equivalent(coef(res.RE), 0.0837, tolerance=.tol[["coef"]]) ### 0.083 in chapter
expect_equivalent(res.RE$zval, 1.6208, tolerance=.tol[["test"]])
expect_equivalent(res.RE$tau2, 0.0188, tolerance=.tol[["var"]])
### prediction interval
tmp <- predict(res.RE)
### compare with results on page 301 (Table 16.2) and page 302
expect_equivalent(tmp$pi.lb, -0.2036, tolerance=.tol[["ci"]]) ### -0.19 in chapter but computed in a slightly different way
expect_equivalent(tmp$pi.ub, 0.3711, tolerance=.tol[["ci"]]) ### 0.35 in chapter but computed in a slightly different way
### range of BLUPs
tmp <- range(blup(res.RE)$pred)
### compare with results on page 301 (Table 16.2)
expect_equivalent(tmp, c(-0.0293, 0.2485), tolerance=.tol[["pred"]])
})
test_that("results are correct for the mixed-effects model.", {
### recode weeks variable
dat$weeks.c <- ifelse(dat$weeks > 3, 3, dat$weeks)
### mixed-effects model
res.ME <- rma(yi, vi, mods = ~ weeks.c, data=dat, digits=3)
### compare with results on page 301 (Table 16.2)
expect_equivalent(res.ME$tau2, 0.0000, tolerance=.tol[["var"]])
expect_equivalent(coef(res.ME), c(0.4072, -0.1572), tolerance=.tol[["coef"]])
expect_equivalent(res.ME$QE, 16.5708, tolerance=.tol[["test"]])
expect_equivalent(res.ME$zval, c(4.6782, -4.3884), tolerance=.tol[["test"]])
### range of BLUPs
tmp <- range(blup(res.ME)$pred)
### compare with results on page 301 (Table 16.2)
expect_equivalent(tmp, c(-0.0646, 0.4072), tolerance=.tol[["pred"]]) ### -0.07 in chapter
})
test_that("results are correct for the random-effects model (conventional approach).", {
res.std <- list()
res.std$EE <- rma(yi, vi, data=dat, digits=3, method="EE")
res.std$ML <- rma(yi, vi, data=dat, digits=3, method="ML")
res.std$REML <- rma(yi, vi, data=dat, digits=3, method="REML")
res.std$DL <- rma(yi, vi, data=dat, digits=3, method="DL")
res.std$HE <- rma(yi, vi, data=dat, digits=3, method="HE")
tmp <- t(sapply(res.std, function(x) c(tau2=x$tau2, mu=x$beta, se=x$se, z=x$zval, ci.lb=x$ci.lb, ci.ub=x$ci.ub)))
expected <- structure(c(0, 0.0126, 0.0188, 0.0259, 0.0804, 0.0604, 0.0777, 0.0837, 0.0893, 0.1143, 0.0365, 0.0475, 0.0516, 0.0558, 0.0792, 1.6553, 1.6368, 1.6208, 1.6009, 1.4432, -0.0111, -0.0153, -0.0175, -0.02, -0.0409, 0.1318, 0.1708, 0.1849, 0.1987, 0.2696),
.Dim = 5:6, .Dimnames = list(c("EE", "ML", "REML", "DL", "HE"), c("tau2", "mu", "se", "z", "ci.lb", "ci.ub")))
### compare with results on page 309 (Table 16.3)
expect_equivalent(tmp, expected, tolerance=.tol[["misc"]])
})
test_that("results are correct for the random-effects model (Knapp & Hartung method).", {
res.knha <- list()
expect_warning(res.knha$EE <- rma(yi, vi, data=dat, digits=3, method="EE", test="knha"))
res.knha$ML <- rma(yi, vi, data=dat, digits=3, method="ML", test="knha")
res.knha$REML <- rma(yi, vi, data=dat, digits=3, method="REML", test="knha")
res.knha$DL <- rma(yi, vi, data=dat, digits=3, method="DL", test="knha")
res.knha$HE <- rma(yi, vi, data=dat, digits=3, method="HE", test="knha")
tmp <- t(sapply(res.knha, function(x) c(tau2=x$tau2, mu=x$beta, se=x$se, z=x$zval, ci.lb=x$ci.lb, ci.ub=x$ci.ub)))
expected <- structure(c(0, 0.0126, 0.0188, 0.0259, 0.0804, 0.0604, 0.0777, 0.0837, 0.0893, 0.1143, 0.0515, 0.0593, 0.0616, 0.0636, 0.0711, 1.1733, 1.311, 1.3593, 1.405, 1.6078, -0.0477, -0.0468, -0.0457, -0.0442, -0.0351, 0.1685, 0.2023, 0.2131, 0.2229, 0.2637),
.Dim = 5:6, .Dimnames = list(c("EE", "ML", "REML", "DL", "HE"), c("tau2", "mu", "se", "z", "ci.lb", "ci.ub")))
### compare with results on page 309 (Table 16.3)
expect_equivalent(tmp, expected, tolerance=.tol[["misc"]])
})
test_that("results are correct for the random-effects model (Huber-White method).", {
res.std <- list()
res.std$EE <- rma(yi, vi, data=dat, digits=3, method="EE")
res.std$ML <- rma(yi, vi, data=dat, digits=3, method="ML")
res.std$REML <- rma(yi, vi, data=dat, digits=3, method="REML")
res.std$DL <- rma(yi, vi, data=dat, digits=3, method="DL")
res.std$HE <- rma(yi, vi, data=dat, digits=3, method="HE")
res.hw <- list()
res.hw$EE <- robust(res.std$EE, cluster=study, adjust=FALSE)
res.hw$ML <- robust(res.std$ML, cluster=study, adjust=FALSE)
res.hw$REML <- robust(res.std$REML, cluster=study, adjust=FALSE)
res.hw$DL <- robust(res.std$DL, cluster=study, adjust=FALSE)
res.hw$HE <- robust(res.std$HE, cluster=study, adjust=FALSE)
out <- capture.output(print(res.hw$REML)) ### so that print.robust.rma() is run (at least once)
tmp <- t(sapply(res.hw, function(x) c(tau2=x$tau2, mu=x$beta, se=x$se, t=x$zval, ci.lb=x$ci.lb, ci.ub=x$ci.ub)))
expected <- structure(c(0, 0.0126, 0.0188, 0.0259, 0.0804, 0.0604, 0.0777, 0.0837, 0.0893, 0.1143, 0.0398, 0.0475, 0.05, 0.0522, 0.0618, 1.5148, 1.6369, 1.6756, 1.7105, 1.8503, -0.0234, -0.022, -0.0213, -0.0204, -0.0155, 0.1441, 0.1775, 0.1887, 0.199, 0.2441),
.Dim = 5:6, .Dimnames = list(c("EE", "ML", "REML", "DL", "HE"), c("tau2", "mu", "se", "t", "ci.lb", "ci.ub")))
### compare with results on page 309 (Table 16.3)
expect_equivalent(tmp, expected, tolerance=.tol[["misc"]])
})
rm(list=ls())
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.