Leave-one-out test
fd
2025-02-14
load_all() # Load dev package## ℹ Loading orchaRd
##
## Loading the 'orchaRd' package (version 2.0). For an
## introduction and vignette to the package please see: https://daniel1noble.github.io/orchaRd/Example using the BCG vaccine data from metafor
dat <- metafor::escalc(measure = "RR", ai = tpos, bi = tneg, ci = cpos, di = cneg, data = dat.bcg)
res <- metafor::rma(yi, vi, data = dat)
res##
## Random-Effects Model (k = 13; tau^2 estimator: REML)
##
## tau^2 (estimated amount of total heterogeneity): 0.3132 (SE = 0.1664)
## tau (square root of estimated tau^2 value): 0.5597
## I^2 (total heterogeneity / total variability): 92.22%
## H^2 (total variability / sampling variability): 12.86
##
## Test for Heterogeneity:
## Q(df = 12) = 152.2330, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.7145 0.1798 -3.9744 <.0001 -1.0669 -0.3622 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# This gives the same result than leave1out from metafor, but only includes
# beta and confidence interval. Also, the output is a data frame (not like metafor's leave1out),
# so it is ready for plotting.
res_loo <- leave_one_out(res, group = "trial")
res_loo## left_out b ci_lb ci_ub
## 1 1 -0.7070838 -1.0794006 -0.3347670
## 2 2 -0.6540312 -1.0081877 -0.2998748
## 3 3 -0.6855544 -1.0495319 -0.3215769
## 4 4 -0.6284094 -0.9745762 -0.2822426
## 5 5 -0.7641701 -1.1400670 -0.3882732
## 6 6 -0.7108766 -1.1033673 -0.3183858
## 7 7 -0.6552476 -1.0089689 -0.3015263
## 8 8 -0.7947676 -1.1473214 -0.4422138
## 9 9 -0.7411973 -1.1266731 -0.3557215
## 10 10 -0.6530329 -1.0141906 -0.2918752
## 11 11 -0.7578586 -1.1415938 -0.3741234
## 12 12 -0.7598121 -1.1167039 -0.4029203
## 13 13 -0.7775362 -1.1411800 -0.4138924The minimal plot:
loo_plot(res, res_loo)
Add labels and order by descending risk ratio:
# Create a mapping of trial codes to friendly labels.
# This step could also be done in a spreadsheet and read in as a CSV.
labels_df <- dat.bcg %>%
dplyr::distinct(trial, .keep_all = TRUE) %>%
dplyr::mutate(left_out = trial,
label = paste(author, year, sep = ", ")) %>%
dplyr::select(left_out, label)
# Create the plot ordering trials by descending risk ratio. Use the labels_df inseatd of "Trial 1"
# or something like that
loo_plot(res, res_loo, order = "descending", labels = labels_df) +
ggplot2::labs(x = "Risk ratio", y = "Trial") 
Example with random factors and variance-covariance matrix
VCV <- vcalc(vi = lnrr_vi,
cluster = paper_ID,
obs = es_ID,
rho = 0.5,
data = fish)
res_mv <- rma.mv(lnrr, VCV,
random = list( ~ 1 | es_ID,
~ 1 | paper_ID),
data = fish)
res_mv##
## Multivariate Meta-Analysis Model (k = 410; method: REML)
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0264 0.1625 410 no es_ID
## sigma^2.2 0.0134 0.1159 62 no paper_ID
##
## Test for Heterogeneity:
## Q(df = 409) = 60893.1672, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.0100 0.0193 0.5193 0.6036 -0.0278 0.0478
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Pass a list of arguments so it can compute the variance-covariance matrix
# in each iteration.
vcv_args = list(vi = "lnrr_vi",
cluster = "paper_ID",
obs = "es_ID",
rho = 0.5)
# This takes more time...
loo_res_mv <- leave_one_out(res_mv, group = "paper_ID", vcalc = vcv_args)head(loo_res_mv)## left_out b ci_lb ci_ub
## 1 p001 0.008695371 -0.02955782 0.04694856
## 2 p002 0.010882635 -0.02723100 0.04899627
## 3 p003 0.010457336 -0.02787013 0.04878480
## 4 p004 0.010466540 -0.02780625 0.04873933
## 5 p005 0.012301272 -0.02663317 0.05123571
## 6 p006 0.010147017 -0.02799866 0.04829270No ordering, no labels:
loo_plot(res_mv, loo_res_mv) +
ggplot2::labs(x = "lnRR", y = "Paper ID")
Ordered by descending risk ratio:
loo_plot(res_mv, loo_res_mv, order = "ascending", labels = NULL) +
ggplot2::labs(x = "lnRR", y = "Paper ID")