# NOT RUN {
########################################
# example data by Snedecor and Cochran:
data("SnedecorCochran")
# }
# NOT RUN {
# analysis using improper uniform prior
# (may take a few seconds to compute!):
ma01 <- bayesmeta(y=SnedecorCochran[,"mean"], sigma=sqrt(SnedecorCochran[,"var"]),
label=SnedecorCochran[,"no"])
# analysis using an informative prior
# (normal for mu and half-Cauchy for tau (scale=10))
# (may take a few seconds to compute!):
ma02 <- bayesmeta(y=SnedecorCochran[,"mean"], sigma=sqrt(SnedecorCochran[,"var"]),
label=SnedecorCochran[,"no"],
mu.prior.mean=50, mu.prior.sd=50,
tau.prior=function(x){return(dhalfcauchy(x, scale=10))})
# show some summary statistics:
print(ma01)
summary(ma01)
# show some plots:
forestplot(ma01)
plot(ma01)
# compare resulting marginal densities;
# the effect parameter (mu):
mu <- seq(30, 80, le=200)
plot(mu, ma02$dposterior(mu=mu), type="l", lty="dashed",
xlab=expression("effect "*mu),
ylab=expression("marginal posterior density"),
main="Snedecor/Cochran example")
lines(mu, ma01$dposterior(mu=mu), lty="solid")
# the heterogeneity parameter (tau):
tau <- seq(0, 50, le=200)
plot(tau, ma02$dposterior(tau=tau), type="l", lty="dashed",
xlab=expression("heterogeneity "*tau),
ylab=expression("marginal posterior density"),
main="Snedecor/Cochran example")
lines(tau, ma01$dposterior(tau=tau), lty="solid")
# compute posterior median relative heterogeneity I-squared:
ma01$I2(tau=ma01$summary["median","tau"])
# determine 90 percent upper limits on the heterogeneity tau:
ma01$qposterior(tau=0.90)
ma02$qposterior(tau=0.90)
# determine shortest 90 percent credible interval for tau:
ma01$post.interval(tau.level=0.9, method="shortest")
# }
# NOT RUN {
#####################################
# example data by Sidik and Jonkman:
data("SidikJonkman2007")
# add log-odds-ratios and corresponding standard errors:
sj <- SidikJonkman2007
sj <- cbind(sj, "log.or"=log(sj[,"lihr.events"])-log(sj[,"lihr.cases"]-sj[,"lihr.events"])
-log(sj[,"oihr.events"])+log(sj[,"oihr.cases"]-sj[,"oihr.events"]),
"log.or.se"=sqrt(1/sj[,"lihr.events"] + 1/(sj[,"lihr.cases"]-sj[,"lihr.events"])
+ 1/sj[,"oihr.events"] + 1/(sj[,"oihr.cases"]-sj[,"oihr.events"])))
# }
# NOT RUN {
# analysis using weakly informative half-normal prior
# (may take a few seconds to compute!):
ma03a <- bayesmeta(y=sj[,"log.or"], sigma=sj[,"log.or.se"],
label=sj[,"id.sj"],
tau.prior=function(t){dhalfnormal(t,scale=1)})
# alternatively: may utilize "metafor" package's "escalc()" function
# to compute log-ORs and standard errors:
require("metafor")
es <- escalc(measure="OR",
ai=lihr.events, n1i=lihr.cases,
ci=oihr.events, n2i=oihr.cases,
slab=id, data=SidikJonkman2007)
# apply "bayesmeta()" function directly to "escalc" object:
ma03b <- bayesmeta(es, tau.prior=function(t){dhalfnormal(t,scale=1)})
# "ma03a" and "ma03b" should be identical:
print(ma03a$summary)
print(ma03b$summary)
# compare to metafor's (frequentist) random-effects meta-analysis:
rma03a <- rma.uni(es)
rma03b <- rma.uni(es, method="EB", knha=TRUE)
# compare mu estimates (estimate and confidence interval):
plot(ma03b, which=3)
abline(v=c(rma03a$b, rma03a$ci.lb, rma03a$ci.ub), col="red", lty=c(1,2,2))
abline(v=c(rma03b$b, rma03b$ci.lb, rma03b$ci.ub), col="green3", lty=c(1,2,2))
# compare tau estimates (estimate and confidence interval):
plot(ma03b, which=4)
abline(v=confint(rma03a)$random["tau",], col="red", lty=c(1,2,2))
abline(v=confint(rma03b)$random["tau",], col="green3", lty=c(1,3,3))
# show heterogeneity's posterior density:
plot(ma03a, which=4, main="Sidik/Jonkman example")
# show some numbers (mode, median and mean):
abline(v=ma03a$summary[c("mode","median","mean"),"tau"], col="blue")
# compare with Sidik and Jonkman's estimates:
sj.estimates <- sqrt(c("MM" = 0.429, # method of moments estimator
"VC" = 0.841, # variance component type estimator
"ML" = 0.562, # maximum likelihood estimator
"REML"= 0.598, # restricted maximum likelihood estimator
"EB" = 0.703, # empirical Bayes estimator
"MV" = 0.818, # model error variance estimator
"MVvc"= 0.747)) # a variation of the MV estimator
abline(v=sj.estimates, col="red", lty="dashed")
# }
# NOT RUN {
###########################
# example data by Cochran:
data("Cochran1954")
# }
# NOT RUN {
# analysis using improper uniform prior
# (may take a few seconds to compute!):
ma04 <- bayesmeta(y=Cochran1954[,"mean"], sigma=sqrt(Cochran1954[,"se2"]),
label=Cochran1954[,"observer"])
# show joint posterior density:
plot(ma04, which=2, main="Cochran example")
# show (known) true parameter value:
abline(h=161)
# pick a point estimate for tau:
tau <- ma04$summary["median","tau"]
# highlight two point hypotheses (fixed vs. random effects):
abline(v=c(0, tau), col="orange", lty="dotted", lwd=2)
# show marginal posterior density:
plot(ma04, which=3)
abline(v=161)
# show the conditional distributions of the effect mu
# at two tau values corresponding to fixed and random effects models:
cm <- ma04$cond.moment(tau=c(0,tau))
mu <- seq(130,200, le=200)
lines(mu, dnorm(mu, mean=cm[1,"mean"], sd=cm[1,"sd"]), col="orange", lwd=2)
lines(mu, dnorm(mu, mean=cm[2,"mean"], sd=cm[2,"sd"]), col="orange", lwd=2)
# determine a range of tau values:
tau <- seq(0, ma04$qposterior(tau=0.99), length=100)
# compute conditional posterior moments:
cm.overall <- ma04$cond.moment(tau=tau)
# compute study-specific conditional posterior moments:
cm.indiv <- ma04$cond.moment(tau=tau, individual=TRUE)
# show forest plot along with conditional posterior means:
par(mfrow=c(1,2))
plot(ma04, which=1, main="Cochran 1954 example")
matplot(tau, cm.indiv[,"mean",], type="l", lty="solid", col=1:ma04$k,
xlim=c(0,max(tau)*1.2), xlab=expression("heterogeneity "*tau),
ylab=expression("(conditional) shrinkage estimate E["*
theta[i]*"|"*list(tau, y, sigma)*"]"))
text(rep(max(tau)*1.01, ma04$k), cm.indiv[length(tau),"mean",],
ma04$label, col=1:ma04$k, adj=c(0,0.5))
lines(tau, cm.overall[,"mean"], lty="dashed", lwd=2)
text(max(tau)*1.01, cm.overall[length(tau),"mean"],
"overall", adj=c(0,0.5))
par(mfrow=c(1,1))
# show the individual effects' posterior distributions:
theta <- seq(120, 240, le=300)
plot(range(theta), c(0,0.1), type="n", xlab=expression(theta[i]), ylab="")
for (i in 1:ma04$k) {
# draw estimate +/- uncertainty as a Gaussian:
lines(theta, dnorm(theta, mean=ma04$y[i], sd=ma04$sigma[i]), col=i+1, lty="dotted")
# draw effect's posterior distribution:
lines(theta, ma04$dposterior(theta=theta, indiv=i), col=i+1, lty="solid")
}
abline(h=0)
legend(max(theta), 0.1, legend=ma04$label, col=(1:ma04$k)+1, pch=15, xjust=1, yjust=1)
# }
Run the code above in your browser using DataLab