Domain_specific_SRMA
2026-01-31
PRISMA Flow diagram
library(PRISMA2020)
data <- read.csv("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Screening stage/Flow diagram/PRISMA.csv")
data <- PRISMA_data(data);
plot <- PRISMA_flowdiagram(
data,
interactive = TRUE,
previous = TRUE,
other = FALSE,
detail_databases = TRUE,
detail_registers = F,
fontsize = 12,
font = "Arial",
title_colour = "Goldenrod1",
greybox_colour = "Gainsboro",
main_colour = "Black",
arrow_colour = "Black",
arrow_head = "normal",
arrow_tail = "none",
side_boxes = TRUE
)
plotPRISMA_save(plot, filename = "~/Desktop/Projetos/Domain-specific PA - meta-analysis/Screening stage/Flow diagram/Flow_diagram.pdf", filetype="pdf", overwrite = T)## [1] "/Users/feter/Desktop/Projetos/Domain-specific PA - meta-analysis/Screening stage/Flow diagram/Flow_diagram.pdf"Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
library(DT)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$age_group <- factor(data$`Baseline age group (1=30-50 years, 2=50-65 years, 3=65-80 years, 4= 80+ years)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data$design <- case_when(
data$Design == "Prospective cohort study" ~ "Prospective cohort study",
data$Design == "Longitudinal cohort study" ~ "Prospective cohort study",
data$Design == "Case-control study" ~ "Case-control study",
data$Design == "Case-control study nested in prospective cohort study" ~ "Case-control study",
data$Design == "Nested case-control studies" ~ "Case-control study",
data$Design == "Prospective" ~ "Prospective cohort study",
data$Design == "Prospective population-based study" ~ "Prospective cohort study",
data$Design == "Retrospective cohort study" ~ "Case-control study",
data$Design == "prospective cohort study" ~ "Prospective cohort study",
TRUE ~ "Non-specific"
)
datatable(
data,
extensions = 'Buttons', # Ativa a extensão de botões
options = list(
dom = 'Bfrtip', # Define onde os botões e elementos aparecem
buttons = c('copy', 'csv', 'excel', 'pdf', 'print') # Lista os formatos desejados
)
)ALL-CAUSE DEMENTIA
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
meta_model_4level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.2887 80.5773 86.5773 95.8216 86.7302
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0737 0.2715 76 no ID
## sigma^2.2 0.0211 0.1453 162 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 161) = 1565.0918, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2423 0.0378 -6.4159 <.0001 -0.3163 -0.1683 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(meta_model_4level)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.2887 80.5773 88.5773 100.9030 88.8338
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 69 no Cohort
## sigma^2.2 0.0737 0.2715 76 no Cohort/ID
## sigma^2.3 0.0211 0.1453 162 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 161) = 1565.0918, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2423 0.0378 -6.4159 <.0001 -0.3163 -0.1683 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova.rma(meta_model_3level, meta_model_4level)##
## df AIC BIC AICc logLik LRT pval QE
## Full 4 88.5773 100.9030 88.8338 -40.2887 1565.0918
## Reduced 3 86.5773 95.8216 86.7302 -40.2887 0.0000 1.0000 1565.0918# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7848340 0.7288432 0.8451262#---------------------------------------------
# 5. Forest plot
#---------------------------------------------
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Forestplot_overall_pooled.tiff",
units = "in", width = 10, height = 15, res = 300, compression = "lzw")
metafor::forest(meta_model_3level,
slab = data$Publication,
xlab = "Relative Risk (RR)",
atransf = exp,
at = log(c(0.25, 1, 2.5)),
header = "Study",
order = "obs",
cex = 0.5,
ilab = data$Domain, # <<< NEW COLUMN
ilab.xpos = -2.2 # <<< FINE-TUNE POSITION
)
# add column title
text(-2.2, max(meta_model_3level$k)+31, "PA Domain", cex = 0.6, font = 2)
dev.off()## quartz_off_screen
## 2#---------------------------------------------
# 6. Funnel plot
#---------------------------------------------
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Funnel_overall_pooled.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
funnel(meta_model_3level, yaxis = "sei", xlab = "Log RR", back = "white")
dev.off()## quartz_off_screen
## 2#---------------------------------------------
# 7. Egger’s test for small-study bias
#---------------------------------------------
# Load required package
meta_model_3level$data %>%
mutate(y = logRR/SE, x = 1/SE) %>%
lm(y ~ x, data = .) %>%
summary()##
## Call:
## lm(formula = y ~ x, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -16.1954 -1.0870 0.0607 1.3616 9.3735
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.784103 0.266988 -2.937 0.00381 **
## x -0.092480 0.009332 -9.910 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.047 on 160 degrees of freedom
## Multiple R-squared: 0.3803, Adjusted R-squared: 0.3765
## F-statistic: 98.21 on 1 and 160 DF, p-value: < 2.2e-16##############################################
#---------------------------------------------
# 8. Heterogeneity
#---------------------------------------------
library(dmetar)
i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 1.602932 ---
## Level 2 21.911499 21.91
## Level 3 76.485569 76.49
## Total I2: 98.4%##############################################
#---------------------------------------------
# 9. Comparing two and three-level models
#---------------------------------------------
l3.removed <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
sigma2 = c(0, NA))
anova(meta_model_3level, l3.removed)##
## df AIC BIC AICc logLik LRT pval QE
## Full 3 86.5773 95.8216 86.7302 -40.2887 1565.0918
## Reduced 2 141.1766 147.3394 141.2525 -68.5883 56.5992 <.0001 1565.0918MODERATION - ALL-CAUSE DEMENTIA
#---------------------------------------------
# 10. Moderation
#---------------------------------------------
summarize_moderator <- function(model, varname, dataset) {
# ---- step A: build prediction dataset (1 row per level)
newdata <- data.frame(x = levels(dataset[[varname]]))
# ---- step B: build dummy matrix for moderator (NO intercept)
X <- model.matrix(~ x, newdata)[, -1, drop = FALSE]
# ---- step C: rename dummy columns to EXACT coefficient names
coef_names <- names(coef(model))[-1] # drop intercept
colnames(X) <- coef_names
# ---- step D: predict log RR, convert to RR and CI
pred <- predict(model, newmods = X)
df_rr <- data.frame(
moderator_level = newdata$x,
RR = exp(pred$pred),
lower = exp(pred$ci.lb),
upper = exp(pred$ci.ub)
)
# ---- step E: descriptive summary by moderator level
df_desc <- dataset %>%
group_by(.data[[varname]]) %>%
summarise(
total_cases = sum(cases, na.rm = TRUE),
total_PY = sum(PY, na.rm = TRUE),
IR = total_cases / total_PY,
studies = n_distinct(ID), # # of unique studies
effect_sizes = n() # # of estimates (rows)
)
list(RR = df_rr, DESCRIPTIVES = df_desc)
}AGE
data$age_group <- factor(data$age_group,
levels = c(1,2,3,4),
labels = c("30-49 years", "50-64 years", "65-80 years", ">80 years"),
ordered = T)
mod_age <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ age_group)
summary(mod_age)##
## Multivariate Meta-Analysis Model (k = 161; method: REML)
##
## logLik Deviance AIC BIC AICc
## -36.4306 72.8612 84.8612 103.1987 85.4212
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0710 0.2665 75 no ID
## sigma^2.2 0.0209 0.1447 161 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 157) = 1524.6689, p-val < .0001
##
## Test of Moderators (coefficients 2:4):
## QM(df = 3) = 2.4286, p-val = 0.4883
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2093 0.0468 -4.4779 <.0001 -0.3010 -0.1177 ***
## age_group.L -0.0864 0.1096 -0.7883 0.4305 -0.3012 0.1284
## age_group.Q 0.0750 0.0932 0.8048 0.4209 -0.1077 0.2578
## age_group.C 0.0160 0.0727 0.2195 0.8262 -0.1266 0.1585
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_age)
summary(i2)## % of total variance I2
## Level 1 1.64317 ---
## Level 2 22.39118 22.39
## Level 3 75.96565 75.97
## Total I2: 98.36%results_age <- summarize_moderator(mod_age, "age_group", data)
# VIEW OUTPUT
results_age$RR## moderator_level RR lower upper
## 1 30-49 years 0.7439901 0.5769380 0.9594119
## 2 50-64 years 0.8743287 0.6877595 1.1115086
## 3 65-80 years 0.8241727 0.6785443 1.0010556
## 4 >80 years 0.8111168 0.7400982 0.8889504results_age$DESCRIPTIVES## # A tibble: 5 × 6
## age_group total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 30-49 years 4606 2960868. 0.00156 16 29
## 2 50-64 years 21903 13165509. 0.00166 15 37
## 3 65-80 years 91138 34793408. 0.00262 40 84
## 4 >80 years 931 47551 0.0196 6 11
## 5 <NA> 0 0 NaN 1 1STUDY QUALITY
data$quality <- factor(data$quality,
levels = c("Poor", "Moderate", "Good"),ordered = T)
mod_quality <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ quality)
summary(mod_quality)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.9630 77.9261 87.9261 103.2706 88.3182
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0730 0.2701 76 no ID
## sigma^2.2 0.0213 0.1460 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 159) = 1264.5184, p-val < .0001
##
## Test of Moderators (coefficients 2:3):
## QM(df = 2) = 1.9653, p-val = 0.3743
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2512 0.0402 -6.2542 <.0001 -0.3299 -0.1725 ***
## quality.L -0.0219 0.0734 -0.2984 0.7654 -0.1658 0.1220
## quality.Q -0.0917 0.0655 -1.4007 0.1613 -0.2200 0.0366
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_quality)
summary(i2)## % of total variance I2
## Level 1 1.612441 ---
## Level 2 22.253044 22.25
## Level 3 76.134516 76.13
## Total I2: 98.39%results_quality <- summarize_moderator(mod_quality, "quality", data)
# VIEW OUTPUT
results_quality$RR## moderator_level RR lower upper
## 1 Poor 0.7097203 0.6037926 0.8342316
## 2 Moderate 0.7610249 0.6319495 0.9164637
## 3 Good 0.7778828 0.7189995 0.8415883results_quality$DESCRIPTIVES## # A tibble: 3 × 6
## quality total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 Poor 50967 1784243. 0.0286 34 48
## 2 Moderate 26886 8347568. 0.00322 29 82
## 3 Good 40725 40835525. 0.000997 13 32MEETING PA GUIDELINES
mod_meeting <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ metting)
summary(mod_meeting)##
## Multivariate Meta-Analysis Model (k = 108; method: REML)
##
## logLik Deviance AIC BIC AICc
## -26.3407 52.6814 60.6814 71.3352 61.0775
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0835 0.2890 55 no ID
## sigma^2.2 0.0046 0.0678 108 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 106) = 612.3890, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 11.9326, p-val = 0.0006
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2526 0.0488 -5.1717 <.0001 -0.3483 -0.1569 ***
## metting2 -0.1295 0.0375 -3.4544 0.0006 -0.2029 -0.0560 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_meeting)
summary(i2)## % of total variance I2
## Level 1 2.865106 ---
## Level 2 5.063492 5.06
## Level 3 92.071402 92.07
## Total I2: 97.13%results_meeting <- summarize_moderator(mod_meeting, "metting", data)
results_meeting$RR## moderator_level RR lower upper
## 1 1 0.7767732 0.7058587 0.8548121
## 2 2 0.6824421 0.6189241 0.7524788results_meeting$DESCRIPTIVES## # A tibble: 3 × 6
## metting total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 1 44577 36933592. 0.00121 39 50
## 2 2 4922 944412. 0.00521 35 58
## 3 <NA> 69079 13089332. 0.00528 25 54DEMENTIA CRITERIA
data$dem_criteria <- factor(data$Dementia...12, levels = c("DSM-III/IV/V", "Clinical evaluation", "Health records", "Cognitive test", "Other"),
ordered = T)
mod_criteria <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ dem_criteria )
summary(mod_criteria)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -34.6452 69.2905 83.2905 104.6842 84.0422
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0681 0.2609 76 no ID
## sigma^2.2 0.0206 0.1436 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 157) = 1387.3873, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 10.8181, p-val = 0.0287
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.3502 0.0498 -7.0304 <.0001 -0.4479 -0.2526 ***
## dem_criteria.L -0.2904 0.1143 -2.5399 0.0111 -0.5145 -0.0663 *
## dem_criteria.Q -0.0543 0.1018 -0.5339 0.5934 -0.2538 0.1451
## dem_criteria.C 0.1446 0.1272 1.1372 0.2555 -0.1046 0.3939
## dem_criteria^4 0.2213 0.1002 2.2086 0.0272 0.0249 0.4177 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_criteria)
summary(i2)## % of total variance I2
## Level 1 1.712508 ---
## Level 2 22.847218 22.85
## Level 3 75.440274 75.44
## Total I2: 98.29%results_criteria <- summarize_moderator(mod_criteria, "dem_criteria", data)
results_criteria$RR## moderator_level RR lower upper
## 1 DSM-III/IV/V 0.6672663 0.5311773 0.8382217
## 2 Clinical evaluation 0.7045214 0.6389831 0.7767819
## 3 Health records 0.8141399 0.6324463 1.0480317
## 4 Cognitive test 0.5269670 0.3945363 0.7038496
## 5 Other 0.8790315 0.7367715 1.0487598results_criteria$DESCRIPTIVES## # A tibble: 5 × 6
## dem_criteria total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 DSM-III/IV/V 7707 1147763. 0.00671 28 56
## 2 Clinical evaluation 4192 1106931 0.00379 13 17
## 3 Health records 101984 48063060. 0.00212 26 72
## 4 Cognitive test 2098 145085 0.0145 5 5
## 5 Other 2597 504497. 0.00515 4 12Follow-up
data$follow_up <- factor(data$follow_up, levels = c(1,2,3), ordered = T)
mod_followup <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ follow_up)
summary(mod_followup)##
## Multivariate Meta-Analysis Model (k = 157; method: REML)
##
## logLik Deviance AIC BIC AICc
## -29.8966 59.7932 69.7932 84.9780 70.1986
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0610 0.2471 73 no ID
## sigma^2.2 0.0184 0.1355 157 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 154) = 1200.2203, p-val < .0001
##
## Test of Moderators (coefficients 2:3):
## QM(df = 2) = 5.8667, p-val = 0.0532
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2703 0.0411 -6.5778 <.0001 -0.3508 -0.1897 ***
## follow_up.L 0.1939 0.0807 2.4015 0.0163 0.0356 0.3521 *
## follow_up.Q -0.0412 0.0601 -0.6853 0.4932 -0.1590 0.0766
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_followup)
summary(i2)## % of total variance I2
## Level 1 2.843567 ---
## Level 2 22.470884 22.47
## Level 3 74.685550 74.69
## Total I2: 97.16%results_followup <- summarize_moderator(mod_followup, "follow_up", data)
results_followup$RR## moderator_level RR lower upper
## 1 1 0.7631795 0.7041310 0.8271797
## 2 2 0.9264517 0.7865901 1.0911817
## 3 3 0.7323885 0.6168573 0.8695574results_followup$DESCRIPTIVES## # A tibble: 4 × 6
## follow_up total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 1 9352 592992. 0.0158 13 26
## 2 2 63539 48177343. 0.00132 40 92
## 3 3 5459 2197001. 0.00248 20 39
## 4 <NA> 40228 0 Inf 3 5Sex
data$women_group <- cut(data$percentage_women,
breaks = c(-Inf, 0.50, Inf),
labels = c("≤50%", ">50%"))
mod_women <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ women_group)
summary(mod_women)##
## Multivariate Meta-Analysis Model (k = 72; method: REML)
##
## logLik Deviance AIC BIC AICc
## -13.8785 27.7570 35.7570 44.7510 36.3724
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0221 0.1486 72 no ID
## sigma^2.2 0.0221 0.1486 72 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 70) = 467.4029, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.3003, p-val = 0.5837
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2495 0.0679 -3.6739 0.0002 -0.3826 -0.1164 ***
## women_group>50% 0.0419 0.0765 0.5480 0.5837 -0.1080 0.1918
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_women)
summary(i2)## % of total variance I2
## Level 1 2.580218 ---
## Level 2 48.709891 48.71
## Level 3 48.709891 48.71
## Total I2: 97.42%results_women <- summarize_moderator(mod_women, "women_group", data)
results_women$RR## moderator_level RR lower upper
## 1 ≤50% 0.8125637 0.7583589 0.8706429
## 2 >50% 0.7792070 0.6821061 0.8901306results_women$DESCRIPTIVES## # A tibble: 3 × 6
## women_group total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 ≤50% 7034 1600863. 0.00439 18 18
## 2 >50% 102562 48986672. 0.00209 54 54
## 3 <NA> 8982 379801 0.0236 38 90Study design
data$design <- factor(data$design, ordered = T)
mod_design <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ design)
summary(mod_design)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.1222 80.2443 88.2443 100.5450 88.5024
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0752 0.2742 76 no ID
## sigma^2.2 0.0212 0.1454 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 160) = 1389.9398, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.0230, p-val = 0.8793
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2330 0.0730 -3.1914 0.0014 -0.3761 -0.0899 **
## design.L -0.0157 0.1032 -0.1518 0.8793 -0.2180 0.1867
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_design)
summary(i2)## % of total variance I2
## Level 1 1.578926 ---
## Level 2 21.613451 21.61
## Level 3 76.807623 76.81
## Total I2: 98.42%results_design <- summarize_moderator(mod_design, "design", data)
# VIEW OUTPUT
results_design$RR## moderator_level RR lower upper
## 1 Case-control study 0.7921592 0.6865440 0.9140217
## 2 Prospective cohort study 0.7798404 0.6989497 0.8700927results_design$DESCRIPTIVES## # A tibble: 2 × 6
## design total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 Case-control study 43717 410087 0.107 5 11
## 2 Prospective cohort study 74861 50557249. 0.00148 71 151Number of covariates
data$covariates <- as.numeric(data$`Total number of covariates`)
mod_covariates <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ covariates)
summary(mod_covariates)##
## Multivariate Meta-Analysis Model (k = 160; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.0335 76.0669 84.0669 96.3173 84.3284
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0722 0.2687 74 no ID
## sigma^2.2 0.0209 0.1446 160 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 158) = 1261.6815, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.2207, p-val = 0.6385
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2709 0.0831 -3.2615 0.0011 -0.4338 -0.1081 **
## covariates 0.0036 0.0076 0.4698 0.6385 -0.0114 0.0185
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1exp(mod_covariates$b)## [,1]
## intrcpt 0.7626639
## covariates 1.0035928exp(mod_covariates$ci.lb)## [1] 0.6480698 0.9886895exp(mod_covariates$ci.ub)## [1] 0.8975209 1.0187207i2 <- var.comp(mod_covariates)
summary(i2)## % of total variance I2
## Level 1 2.467673 ---
## Level 2 21.898046 21.9
## Level 3 75.634281 75.63
## Total I2: 97.53%DOMAINS
mod_domain <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
summary(mod_domain)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -34.5480 69.0959 83.0959 104.4896 83.8476
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0627 0.2504 76 no ID
## sigma^2.2 0.0195 0.1395 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 157) = 1390.5776, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 15.8362, p-val = 0.0032
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2235 0.1240 -1.8020 0.0716 -0.4666 0.0196 .
## DomainLTPA -0.0356 0.1246 -0.2859 0.7750 -0.2799 0.2086
## DomainNon-specific -0.0389 0.1250 -0.3107 0.7560 -0.2839 0.2062
## DomainOPA 0.2249 0.1303 1.7264 0.0843 -0.0304 0.4802 .
## DomainTPA 0.2731 0.1408 1.9402 0.0524 -0.0028 0.5491 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_domain)
summary(i2)## % of total variance I2
## Level 1 1.846334 ---
## Level 2 23.253285 23.25
## Level 3 74.900381 74.9
## Total I2: 98.15%data_leisure <- data %>%
subset(leisure==1)
mod_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_leisure)##
## Multivariate Meta-Analysis Model (k = 42; method: REML)
##
## logLik Deviance AIC BIC AICc
## 7.0500 -14.1001 -8.1001 -2.9593 -7.4514
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0203 0.1426 20 no ID
## sigma^2.2 0.0040 0.0633 42 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 41) = 139.3871, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1988 0.0402 -4.9517 <.0001 -0.2775 -0.1201 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_leisure)
summary(i2)## % of total variance I2
## Level 1 21.85620 ---
## Level 2 12.86308 12.86
## Level 3 65.28073 65.28
## Total I2: 78.14%# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_leisure$b, mod_leisure$ci.lb, mod_leisure$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8196816 0.7576433 0.8867997data_work <- data %>%
subset(work_pa==1)
mod_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_work)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 6.3760 7.8307 9.3760
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0170 0.1303 5 no ID
## sigma^2.2 0.0308 0.1754 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_work)
summary(i2)## % of total variance I2
## Level 1 14.40088 ---
## Level 2 55.14999 55.15
## Level 3 30.44913 30.45
## Total I2: 85.6%# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_work$b, mod_work$ci.lb, mod_work$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.196800 1.005628 1.424315data_travel <- data %>%
subset(travel==1)
mod_travel <- rma.mv(yi = logRR,
V = var,
data = data_travel,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_travel)##
## Multivariate Meta-Analysis Model (k = 5; method: REML)
##
## logLik Deviance AIC BIC AICc
## 3.0158 -6.0317 -0.0317 -1.8728 23.9683
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 3 no ID
## sigma^2.2 0.0000 0.0000 5 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 4) = 1.8238, p-val = 0.7681
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.0833 0.0263 3.1658 0.0015 0.0317 0.1349 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_travel$b, mod_travel$ci.lb, mod_travel$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.086863 1.032235 1.144381i2 <- var.comp(mod_travel)
summary(i2)## % of total variance I2
## Level 1 1.000000e+02 ---
## Level 2 9.635930e-11 0
## Level 3 3.900174e-08 0
## Total I2: 0%data_household <- data %>%
subset(household==1)
mod_household <- rma.mv(yi = logRR,
V = var,
data = data_household,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_household)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.8881 -1.7763 2.2237 -1.7763 14.2237
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0083 0.0910 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 6.0490, p-val = 0.0139
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1632 0.0704 -2.3192 0.0204 -0.3012 -0.0253 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_household$b, mod_household$ci.lb, mod_household$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8493840 0.7399293 0.9750300# To estimate cases and PY per domain
data$cases[data$Ind_ID==149] = 5185
data$cases[data$Ind_ID==151] = 5185
data$cases[data$Ind_ID==153] = 5185
data$cases[data$Ind_ID==155] = 5185
data$PY[data$Ind_ID==149] = 5352889
data$PY[data$Ind_ID==151] = 5352889
data$PY[data$Ind_ID==153] = 5352889
data$PY[data$Ind_ID==155] = 5352889
data$cases[data$Ind_ID==62] = 44
data$PY[data$Ind_ID==62] = 24318
results_desc <- data %>%
group_by(Domain) %>%
summarise(
total_cases = sum(cases, na.rm = TRUE),
total_PY = sum(PY, na.rm = TRUE),
IR = total_cases / total_PY,
effect_sizes = n(),
studies = n_distinct(ID)
)
results_desc## # A tibble: 5 × 6
## Domain total_cases total_PY IR effect_sizes studies
## <chr> <dbl> <dbl> <dbl> <int> <int>
## 1 HPA 5185 5352889 0.000969 2 1
## 2 LTPA 17757 6924217. 0.00256 42 20
## 3 Non-specific 94784 42938752. 0.00221 100 53
## 4 OPA 7562 5525774. 0.00137 13 5
## 5 TPA 14074 11661578. 0.00121 5 3Domains
model_domain <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
summary(model_domain)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -34.5480 69.0959 83.0959 104.4896 83.8476
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0627 0.2504 76 no ID
## sigma^2.2 0.0195 0.1395 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 157) = 1390.5776, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 15.8362, p-val = 0.0032
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2235 0.1240 -1.8020 0.0716 -0.4666 0.0196 .
## DomainLTPA -0.0356 0.1246 -0.2859 0.7750 -0.2799 0.2086
## DomainNon-specific -0.0389 0.1250 -0.3107 0.7560 -0.2839 0.2062
## DomainOPA 0.2249 0.1303 1.7264 0.0843 -0.0304 0.4802 .
## DomainTPA 0.2731 0.1408 1.9402 0.0524 -0.0028 0.5491 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_leisure <- data %>%
subset(leisure==1)
model_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_leisure)##
## Multivariate Meta-Analysis Model (k = 42; method: REML)
##
## logLik Deviance AIC BIC AICc
## 7.0500 -14.1001 -8.1001 -2.9593 -7.4514
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0203 0.1426 20 no ID
## sigma^2.2 0.0040 0.0633 42 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 41) = 139.3871, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1988 0.0402 -4.9517 <.0001 -0.2775 -0.1201 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(model_leisure)
summary(i2)## % of total variance I2
## Level 1 21.85620 ---
## Level 2 12.86308 12.86
## Level 3 65.28073 65.28
## Total I2: 78.14%mod.model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ leisure)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.8176 77.6352 85.6352 97.9359 85.8933
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0813 0.2852 76 no ID
## sigma^2.2 0.0171 0.1308 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 160) = 1533.6481, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 3.9483, p-val = 0.0469
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2097 0.0420 -4.9918 <.0001 -0.2921 -0.1274 ***
## leisure1 -0.1223 0.0615 -1.9870 0.0469 -0.2429 -0.0017 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Domains - Work
data_work <- data %>%
subset(work_pa==1)
model_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_work)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 6.3760 7.8307 9.3760
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0170 0.1303 5 no ID
## sigma^2.2 0.0308 0.1754 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(model_work)
summary(i2)## % of total variance I2
## Level 1 14.40088 ---
## Level 2 55.14999 55.15
## Level 3 30.44913 30.45
## Total I2: 85.6%mod.model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ work_pa)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -37.1153 74.2307 82.2307 94.5314 82.4888
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0647 0.2544 76 no ID
## sigma^2.2 0.0213 0.1459 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 160) = 1473.9592, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 7.3714, p-val = 0.0066
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2525 0.0363 -6.9570 <.0001 -0.3236 -0.1813 ***
## work_pa1 0.2209 0.0813 2.7150 0.0066 0.0614 0.3803 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Domains - Commuting
data_commuting <- data %>%
subset(travel==1)
model_commuting <- rma.mv(yi = logRR,
V = var,
data = data_commuting,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_commuting)##
## Multivariate Meta-Analysis Model (k = 5; method: REML)
##
## logLik Deviance AIC BIC AICc
## 3.0158 -6.0317 -0.0317 -1.8728 23.9683
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 3 no ID
## sigma^2.2 0.0000 0.0000 5 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 4) = 1.8238, p-val = 0.7681
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.0833 0.0263 3.1658 0.0015 0.0317 0.1349 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(model_commuting)
summary(i2)## % of total variance I2
## Level 1 1.000000e+02 ---
## Level 2 9.635930e-11 0
## Level 3 3.900174e-08 0
## Total I2: 0%mod.model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ travel)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.2365 76.4731 84.4731 96.7738 84.7312
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0722 0.2687 76 no ID
## sigma^2.2 0.0194 0.1392 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 160) = 1513.5200, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 5.3091, p-val = 0.0212
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2475 0.0374 -6.6257 <.0001 -0.3207 -0.1743 ***
## travel1 0.2425 0.1052 2.3041 0.0212 0.0362 0.4488 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Domains - Household
data_household <- data %>%
subset(household==1)
model_household <- rma.mv(yi = logRR,
V = var,
data = data_household,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_household)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.8881 -1.7763 2.2237 -1.7763 14.2237
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0083 0.0910 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 6.0490, p-val = 0.0139
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1632 0.0704 -2.3192 0.0204 -0.3012 -0.0253 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1mod.model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ household)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.8019 81.6039 89.6039 101.9046 89.8619
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0739 0.2718 76 no ID
## sigma^2.2 0.0213 0.1458 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 160) = 1561.5256, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.7079, p-val = 0.4001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2419 0.0378 -6.4001 <.0001 -0.3160 -0.1679 ***
## household1 -0.1004 0.1193 -0.8414 0.4001 -0.3342 0.1334
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1extract_meta_info <- function(model, domain) {
s <- summary(model)
tibble::tibble(
domain = domain,
k = model$k,
estimate = s$beta[1],
se = s$se[1],
ci_lb = s$ci.lb[1],
ci_ub = s$ci.ub[1],
pval = s$pval[1],
zval = s$zval[1],
Q = s$QE, # heterogeneity Q
Q_pval = s$QEp # heterogeneity p-value
)
}
results_all <- dplyr::bind_rows(
extract_meta_info(model_leisure, "Leisure"),
extract_meta_info(model_work, "Work"),
extract_meta_info(model_commuting, "Commuting"),
extract_meta_info(model_household, "Household")
)
results_all## # A tibble: 4 × 10
## domain k estimate se ci_lb ci_ub pval zval Q Q_pval
## <chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Leisure 42 -0.199 0.0402 -0.278 -0.120 7.36e-7 -4.95 139. 1.21e-12
## 2 Work 13 0.180 0.0888 0.00561 0.354 4.31e-2 2.02 79.9 4.31e-12
## 3 Commuting 5 0.0833 0.0263 0.0317 0.135 1.55e-3 3.17 1.82 7.68e- 1
## 4 Household 2 -0.163 0.0704 -0.301 -0.0253 2.04e-2 -2.32 6.05 1.39e- 2#Create a new column with RR and 95% CI formatted
results_all$RR_label <- sprintf("%.2f (%.2f–%.2f); ES=%.f",
exp(results_all$estimate),
exp(results_all$ci_lb),
exp(results_all$ci_ub),
results_all$k)
pval_category <- function(p) {
case_when(
p < 0.001 ~ "<0.001",
p < 0.01 ~ "<0.01",
p < 0.05 ~ "<0.05",
TRUE ~ ">0.05"
)
}
pval_symbol <- function(p) {
case_when(
p < 0.001 ~ "★★★",
p < 0.01 ~ "★★",
p < 0.05 ~ "★",
TRUE ~ "●"
)
}
results_all <- results_all %>%
mutate(
pval_cat = pval_category(pval),
pval_shape = pval_symbol(pval)
)
library(ggplot2)
# png("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Moderation_domains.tiff", units = "in", width = 14, height = 10, res=300)
forest <- ggplot(results_all, aes(x = exp(estimate),y=domain,
xmin=exp(ci_lb), xmax=exp(ci_ub), shape=pval_cat)) +
geom_point(position = position_dodge2(width = 0.9, padding = 0.6), size = 3) +
geom_linerange(position = position_dodge2(width = 0.9, padding = 0.6), size = 1) +
geom_vline(xintercept = 1, linetype = "dashed") +
geom_text(aes(label = RR_label), hjust = 0.5, vjust = -1,
size = 5, family = "arial") +
scale_y_discrete(name= "") +
scale_x_continuous(name = "Relative risk") +
scale_shape_discrete(name="P-value") +
theme_bw() +
theme(text = element_text(size = 20, family = "arial"),
panel.grid = element_line(colour = "white"),
axis.text.y = element_text(size = 20),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
plot.margin = margin(0.5, 0.5, 0.5, 0.5, "cm"), axis.text.x = element_text(size = 20),
axis.title.x = element_text(size = 16))## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.forest
# dev.off()ALZHEIMER’S DISEASE
## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data_alz <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Alzheimer_disease_studies", col_names = T)
data_alz$non_leisure <- factor(data_alz$`Only non-leisure-related PA (1= yes, 0=no)`)
data_alz$work_pa <- factor(data_alz$`Only work-related PA (1= yes, 0=no)`)
data_alz$leisure <- factor(data_alz$`Only leisure PA (1= yes, 0=no)`)
data_alz$travel <- factor(data_alz$`Only travel-related PA (1= yes, 0=no)`)
data_alz$household <- factor(data_alz$`Only household-related PA (1= yes, 0=no)`)
data_alz$age_group <- factor(data_alz$`Baseline age group (1=30-60 years, 2=70-79 years, 3=80+ years)`)
data_alz$follow_up <- factor(data_alz$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data_alz$metting <- factor(data_alz$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data_alz <- data_alz %>%
subset(is.na(Ind_ID)==F)
data_alz$design <- case_when(
data_alz$Design == "Prospective cohort study" ~ "Prospective cohort study",
data_alz$Design == "Longitudinal cohort study" ~ "Prospective cohort study",
data_alz$Design == "Case-control study" ~ "Case-control study",
data_alz$Design == "Case-control study nested in prospective cohort study" ~ "Case-control study",
data_alz$Design == "Nested case-control studies" ~ "Case-control study",
data_alz$Design == "Prospective" ~ "Prospective cohort study",
data_alz$Design == "Prospective population-based study" ~ "Prospective cohort study",
data_alz$Design == "Retrospective cohort study" ~ "Case-control study",
data_alz$Design == "prospective cohort study" ~ "Prospective cohort study",
TRUE ~ "Non-specific"
)
datatable(
data_alz,
extensions = 'Buttons', # Ativa a extensão de botões
options = list(
dom = 'Bfrtip', # Define onde os botões e elementos aparecem
buttons = c('copy', 'csv', 'excel', 'pdf', 'print') # Lista os formatos desejados
)
)#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data_alz$logRR <- log(data_alz$RR)
data_alz$SE <- data_alz$`Standard error (SE)`
data_alz$var <- data_alz$SE^2
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.3737 78.7474 84.7474 91.3163 85.1345
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0745 0.2730 30 no ID
## sigma^2.2 0.0649 0.2547 67 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 66) = 441.3006, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2606 0.0697 -3.7388 0.0002 -0.3972 -0.1240 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7705857 0.6721862 0.8833895data_alz$Domain <- case_when(
data_alz$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data_alz$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data_alz$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data_alz$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
#---------------------------------------------
# 5. Forest plot
#---------------------------------------------
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Forestplot_overall_pooled_ALZ.tiff",
units = "in", width = 12, height = 15, res = 300, compression = "lzw")
forest(meta_model,
slab = data_alz$Publication,
xlab = "Relative Risk (RR)",
atransf = exp,
at = log(c(0.25, 1, 2.5)),
header = "Study",
order = "obs",
cex = 1,
ilab = data_alz$Domain, # <<< NEW COLUMN
ilab.xpos = -1.7 # <<< FINE-TUNE POSITION
)
# add column title
text(-1.7, max(meta_model$k)+31, "PA Domain", cex = 0.6, font = 2)
dev.off()## quartz_off_screen
## 2#---------------------------------------------
# 6. Funnel plot
#---------------------------------------------
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Funnel_overall_pooled_ALZ.tiff",
units = "in", width = 14, height = 12, res = 300, compression = "lzw")
funnel(meta_model, yaxis = "sei", xlab = "Log RR", back = "white")
dev.off()## quartz_off_screen
## 2#---------------------------------------------
# 7. Egger’s test for small-study bias
#---------------------------------------------
# Load required package
meta_model$data %>%
mutate(y = logRR/SE, x = 1/SE) %>%
lm(y ~ x, data = .) %>%
summary()##
## Call:
## lm(formula = y ~ x, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.931 -1.325 0.607 1.572 4.473
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.39233 0.38370 -3.629 0.000561 ***
## x 0.02329 0.03330 0.699 0.486918
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.376 on 65 degrees of freedom
## Multiple R-squared: 0.007465, Adjusted R-squared: -0.007805
## F-statistic: 0.4889 on 1 and 65 DF, p-value: 0.4869##############################################
#---------------------------------------------
# 8. Heterogeneity
#---------------------------------------------
i2 <- var.comp(meta_model)
summary(i2)## % of total variance I2
## Level 1 6.70179 ---
## Level 2 43.42967 43.43
## Level 3 49.86854 49.87
## Total I2: 93.3%##############################################
#---------------------------------------------
# 9. Comparing two and three-level models
#---------------------------------------------
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML")
l3.removed <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
sigma2 = c(0, NA))
anova(meta_model, l3.removed)##
## df AIC BIC AICc logLik LRT pval QE
## Full 3 84.7474 91.3163 85.1345 -39.3737 441.3006
## Reduced 2 90.3167 94.6960 90.5072 -43.1583 7.5693 0.0059 441.3006MODERATION - ALZHEIMER’S DISEASE
#---------------------------------------------
# 5. Moderation
#---------------------------------------------
summarize_moderator <- function(model, varname, dataset) {
# ---- step A: build prediction dataset (1 row per level)
newdata <- data.frame(x = levels(dataset[[varname]]))
# ---- step B: build dummy matrix for moderator (NO intercept)
X <- model.matrix(~ x, newdata)[, -1, drop = FALSE]
# ---- step C: rename dummy columns to EXACT coefficient names
coef_names <- names(coef(model))[-1] # drop intercept
colnames(X) <- coef_names
# ---- step D: predict log RR, convert to RR and CI
pred <- predict(model, newmods = X)
df_rr <- data.frame(
moderator_level = newdata$x,
RR = exp(pred$pred),
lower = exp(pred$ci.lb),
upper = exp(pred$ci.ub)
)
# ---- step E: descriptive summary by moderator level
df_desc <- dataset %>%
group_by(.data[[varname]]) %>%
summarise(
total_cases = sum(cases, na.rm = TRUE),
total_PY = sum(PY, na.rm = TRUE),
IR = total_cases / total_PY,
studies = n_distinct(ID), # # of unique studies
effect_sizes = n() # # of estimates (rows)
)
list(RR = df_rr, DESCRIPTIVES = df_desc)
}AGE
data_alz$age_group <- cut(data_alz$age,
breaks = c(-Inf, 49, 64, 80, Inf),
labels = c("30-49 years", "50-64 years",
"65-80 years", ">80 years"))
mod_age <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ age_group)
summary(mod_age)##
## Multivariate Meta-Analysis Model (k = 66; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.1139 76.2278 88.2278 100.9906 89.7551
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0946 0.3076 29 no ID
## sigma^2.2 0.0653 0.2556 66 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 62) = 412.4831, p-val < .0001
##
## Test of Moderators (coefficients 2:4):
## QM(df = 3) = 0.3927, p-val = 0.9417
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1793 0.2262 -0.7930 0.4278 -0.6226 0.2639
## age_group50-64 years -0.0445 0.2673 -0.1664 0.8678 -0.5684 0.4794
## age_group65-80 years -0.1277 0.2487 -0.5134 0.6076 -0.6152 0.3598
## age_group>80 years -0.0771 0.3673 -0.2100 0.8337 -0.7970 0.6427
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_age)
summary(i2)## % of total variance I2
## Level 1 5.825256 ---
## Level 2 38.467669 38.47
## Level 3 55.707075 55.71
## Total I2: 94.17%results_age <- summarize_moderator(mod_age, "age_group", data_alz)
# VIEW OUTPUT
results_age$RR## moderator_level RR lower upper
## 1 30-49 years 0.7994600 0.6046950 1.0569564
## 2 50-64 years 0.7356214 0.6005050 0.9011397
## 3 65-80 years 0.7737914 0.4388295 1.3644323
## 4 >80 years 0.8358283 0.5365543 1.3020282results_age$DESCRIPTIVES## # A tibble: 5 × 6
## age_group total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 30-49 years 526 152280 0.00345 4 6
## 2 50-64 years 6872 2195716 0.00313 7 24
## 3 65-80 years 3452 112530 0.0307 16 34
## 4 >80 years 404 4686 0.0862 2 2
## 5 <NA> 103 27174 0.00379 1 1STUDY QUALITY
data_alz$quality <- factor(data_alz$quality, levels = c(1,2,3),
labels = c("Poor", "Moderate", "Good"),ordered = T)
mod_quality <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ quality)
summary(mod_quality)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -36.7271 73.4543 83.4543 94.2487 84.4888
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1078 0.3283 30 no ID
## sigma^2.2 0.0535 0.2314 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 64) = 392.4879, p-val < .0001
##
## Test of Moderators (coefficients 2:3):
## QM(df = 2) = 4.1827, p-val = 0.1235
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2934 0.0797 -3.6826 0.0002 -0.4496 -0.1372 ***
## quality.L -0.2781 0.1377 -2.0188 0.0435 -0.5481 -0.0081 *
## quality.Q -0.0049 0.1283 -0.0379 0.9698 -0.2564 0.2466
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_quality)
summary(i2)## % of total variance I2
## Level 1 5.843429 ---
## Level 2 31.243614 31.24
## Level 3 62.912958 62.91
## Total I2: 94.16%results_quality <- summarize_moderator(mod_quality, "quality", data_alz)
# VIEW OUTPUT
results_quality$RR## moderator_level RR lower upper
## 1 Poor 0.7421063 0.5377059 1.0242061
## 2 Moderate 0.5646841 0.4010787 0.7950265
## 3 Good 0.7457237 0.6379133 0.8717547results_quality$DESCRIPTIVES## # A tibble: 3 × 6
## quality total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 Poor 2012 117606 0.0171 13 18
## 2 Moderate 6731 1088541 0.00618 12 31
## 3 Good 2614 1286239 0.00203 6 18MEETING PA GUIDELINES
mod_meeting <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ metting)
summary(mod_meeting)##
## Multivariate Meta-Analysis Model (k = 53; method: REML)
##
## logLik Deviance AIC BIC AICc
## -29.0929 58.1857 68.1857 77.7458 69.5494
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0727 0.2697 27 no ID
## sigma^2.2 0.0506 0.2250 53 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 50) = 207.3135, p-val < .0001
##
## Test of Moderators (coefficients 2:3):
## QM(df = 2) = 17.7471, p-val = 0.0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt 0.1610 0.1844 0.8735 0.3824 -0.2003 0.5224
## metting1 -0.3001 0.2088 -1.4375 0.1506 -0.7092 0.1091
## metting2 -0.6710 0.2019 -3.3233 0.0009 -1.0667 -0.2752 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_meeting)
summary(i2)## % of total variance I2
## Level 1 9.729965 ---
## Level 2 37.038663 37.04
## Level 3 53.231372 53.23
## Total I2: 90.27%results_meeting <- summarize_moderator(mod_meeting, "metting", data_alz)
results_meeting$RR## moderator_level RR lower upper
## 1 0 1.1747305 0.8184889 1.6860239
## 2 1 0.8701954 0.7133504 1.0615262
## 3 2 0.6005394 0.5022964 0.7179974results_meeting$DESCRIPTIVES## # A tibble: 4 × 6
## metting total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 0 846 15587 0.0543 4 5
## 2 1 3696 472605 0.00782 15 20
## 3 2 1078 42014 0.0257 18 28
## 4 <NA> 5737 1962180 0.00292 4 14DEMENTIA CRITERIA
data_alz$dem_criteria <- factor(data_alz$dementia_analysis, levels = c("DSM-III/IV/V", "Clinical evaluation", "Health records", "Cognitive test"),
ordered = T)
mod_criteria <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ dem_criteria )
summary(mod_criteria)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -37.4132 74.8264 86.8264 99.6853 88.3264
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0815 0.2855 30 no ID
## sigma^2.2 0.0624 0.2499 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 63) = 407.1581, p-val < .0001
##
## Test of Moderators (coefficients 2:4):
## QM(df = 3) = 2.3010, p-val = 0.5123
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2758 0.0980 -2.8136 0.0049 -0.4680 -0.0837 **
## dem_criteria.L 0.1013 0.2248 0.4506 0.6523 -0.3393 0.5418
## dem_criteria.Q 0.0749 0.1961 0.3823 0.7023 -0.3093 0.4592
## dem_criteria.C -0.2094 0.1624 -1.2894 0.1973 -0.5276 0.1089
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_criteria)
summary(i2)## % of total variance I2
## Level 1 6.503539 ---
## Level 2 40.551429 40.55
## Level 3 52.945032 52.95
## Total I2: 93.5%results_criteria <- summarize_moderator(mod_criteria, "dem_criteria", data_alz)
results_criteria$RR## moderator_level RR lower upper
## 1 DSM-III/IV/V 0.8180107 0.4998725 1.3386246
## 2 Clinical evaluation 0.7589426 0.6262707 0.9197204
## 3 Health records 0.6155769 0.3970061 0.9544813
## 4 Cognitive test 0.8398289 0.4705264 1.4989864results_criteria$DESCRIPTIVES## # A tibble: 4 × 6
## dem_criteria total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 DSM-III/IV/V 2837 106883 0.0265 14 32
## 2 Clinical evaluation 636 13231 0.0481 5 9
## 3 Health records 7640 2369478 0.00322 9 24
## 4 Cognitive test 244 2794 0.0873 2 2Follow-up
mod_followup <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ follow_up)
summary(mod_followup)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.5803 77.1606 87.1606 97.9550 88.1951
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0839 0.2896 30 no ID
## sigma^2.2 0.0646 0.2543 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 64) = 400.7601, p-val < .0001
##
## Test of Moderators (coefficients 2:3):
## QM(df = 2) = 0.2890, p-val = 0.8654
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1856 0.1573 -1.1798 0.2381 -0.4940 0.1227
## follow_up2 -0.0978 0.1844 -0.5306 0.5957 -0.4593 0.2636
## follow_up3 -0.0861 0.2179 -0.3950 0.6928 -0.5131 0.3410
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_followup)
summary(i2)## % of total variance I2
## Level 1 6.316036 ---
## Level 2 40.776429 40.78
## Level 3 52.907535 52.91
## Total I2: 93.68%results_followup <- summarize_moderator(mod_followup, "follow_up", data_alz)
results_followup$RR## moderator_level RR lower upper
## 1 1 0.8305956 0.6102030 1.1305895
## 2 2 0.7531729 0.6237293 0.9094801
## 3 3 0.7620945 0.5671412 1.0240625results_followup$DESCRIPTIVES## # A tibble: 3 × 6
## follow_up total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 1 1971 69864 0.0282 7 12
## 2 2 8498 2347924 0.00362 16 42
## 3 3 888 74598 0.0119 7 13Sex
data_alz$women_group <- cut(data_alz$percentage_women,
breaks = c(-Inf, 0.50, Inf),
labels = c("≤50%", ">50%"))
mod_women <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ women_group)
summary(mod_women)##
## Multivariate Meta-Analysis Model (k = 31; method: REML)
##
## logLik Deviance AIC BIC AICc
## -16.4518 32.9037 40.9037 46.3728 42.5703
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 30 no ID
## sigma^2.2 0.1277 0.3573 31 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 29) = 214.5691, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.0011, p-val = 0.9732
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2084 0.1996 -1.0442 0.2964 -0.5995 0.1828
## women_group>50% -0.0073 0.2156 -0.0336 0.9732 -0.4299 0.4154
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_women)
summary(i2)## % of total variance I2
## Level 1 6.789592e+00 ---
## Level 2 9.321041e+01 93.21
## Level 3 1.239778e-07 0
## Total I2: 93.21%results_women <- summarize_moderator(mod_women, "women_group", data_alz)
results_women$RR## moderator_level RR lower upper
## 1 ≤50% 0.8060180 0.6868486 0.9458634
## 2 >50% 0.8118859 0.5490590 1.2005243results_women$DESCRIPTIVES## # A tibble: 3 × 6
## women_group total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 ≤50% 455 49886 0.00912 5 5
## 2 >50% 10902 2442500 0.00446 25 26
## 3 <NA> 0 0 NaN 12 36Study design
data_alz$design <- factor(data_alz$design, ordered = T)
mod_design <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ design)
summary(mod_design)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.8546 77.7092 85.7092 94.4067 86.3758
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0784 0.2800 30 no ID
## sigma^2.2 0.0648 0.2546 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 65) = 400.3781, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.4540, p-val = 0.5005
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.3148 0.1072 -2.9354 0.0033 -0.5249 -0.1046 **
## design.L 0.1022 0.1517 0.6738 0.5005 -0.1951 0.3994
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_design)
summary(i2)## % of total variance I2
## Level 1 6.535831 ---
## Level 2 42.298255 42.3
## Level 3 51.165913 51.17
## Total I2: 93.46%results_design <- summarize_moderator(mod_design, "design", data_alz)
results_design$RR## moderator_level RR lower upper
## 1 Case-control study 0.7299567 0.5915879 0.9006891
## 2 Prospective cohort study 0.8084852 0.6642968 0.9839704results_design$DESCRIPTIVES## # A tibble: 2 × 6
## design total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 Case-control study 1668 81828 0.0204 3 7
## 2 Prospective cohort study 9689 2410558 0.00402 27 60Number of covariates
data_alz$covariates <- as.numeric(data_alz$`Total number of covariates`)
mod_covariates <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ covariates)
summary(mod_covariates)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.8930 77.7861 85.7861 94.4836 86.4527
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0779 0.2792 30 no ID
## sigma^2.2 0.0640 0.2530 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 65) = 418.2420, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.6381, p-val = 0.4244
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.3939 0.1812 -2.1735 0.0297 -0.7490 -0.0387 *
## covariates 0.0122 0.0153 0.7988 0.4244 -0.0177 0.0421
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1exp(mod_covariates$b)## [,1]
## intrcpt 0.6744379
## covariates 1.0122750exp(mod_covariates$ci.lb)## [1] 0.4728165 0.9824219exp(mod_covariates$ci.ub)## [1] 0.9620358 1.0430352i2 <- var.comp(mod_covariates)
summary(i2)## % of total variance I2
## Level 1 6.588355 ---
## Level 2 42.126291 42.13
## Level 3 51.285354 51.29
## Total I2: 93.41%DOMAINS
data_alz$Domain <- factor(data_alz$Domain, ordered = F)
data_alz$Domain <- relevel(data_alz$Domain, ref = "LTPA")
mod_domain <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
summary(mod_domain)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -35.2852 70.5704 84.5704 99.4603 86.6445
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0608 0.2465 30 no ID
## sigma^2.2 0.0675 0.2598 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 62) = 388.8464, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 8.8101, p-val = 0.0660
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2044 0.1112 -1.8378 0.0661 -0.4225 0.0136 .
## DomainHPA -0.0561 0.2233 -0.2514 0.8015 -0.4938 0.3816
## DomainNon-specific -0.1382 0.1401 -0.9867 0.3238 -0.4127 0.1363
## DomainOPA 0.3138 0.2108 1.4892 0.1364 -0.0992 0.7269
## DomainTPA 0.3950 0.1876 2.1058 0.0352 0.0274 0.7627 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_domain)
summary(i2)## % of total variance I2
## Level 1 7.243263 ---
## Level 2 48.806104 48.81
## Level 3 43.950633 43.95
## Total I2: 92.76%results_Domain <- summarize_moderator(mod_domain, "Domain", data_alz)
# VIEW OUTPUT
results_Domain$DESCRIPTIVES## # A tibble: 5 × 6
## Domain total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 LTPA 4465 1126097 0.00397 8 19
## 2 HPA 0 0 NaN 1 2
## 3 Non-specific 2903 403402 0.00720 21 38
## 4 OPA 33 3441 0.00959 2 3
## 5 TPA 3956 959446 0.00412 3 5data_leisure <- data_alz %>%
subset(leisure==1)
mod_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_leisure)##
## Multivariate Meta-Analysis Model (k = 19; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.1527 10.3053 16.3053 18.9764 18.0196
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0729 0.2700 8 no ID
## sigma^2.2 0.0447 0.2113 19 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 18) = 133.2295, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2322 0.1149 -2.0204 0.0433 -0.4575 -0.0069 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_leisure$b, mod_leisure$ci.lb, mod_leisure$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7927566 0.6328410 0.9930819data_work <- data_alz %>%
subset(work_pa==1)
mod_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_work)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0435 -2.0871 3.9129 -0.0076 27.9129
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0334 0.1828 2 no ID
## sigma^2.2 0.0000 0.0000 3 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 1.3244, p-val = 0.5157
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1542 0.1781 0.8658 0.3866 -0.1949 0.5034
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_work$b, mod_work$ci.lb, mod_work$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.1667740 0.8229053 1.6543357data_travel <- data_alz %>%
subset(travel==1)
mod_travel <- rma.mv(yi = logRR,
V = var,
data = data_travel,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_travel)##
## Multivariate Meta-Analysis Model (k = 5; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.9255 -1.8510 4.1490 2.3078 28.1490
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 3 no ID
## sigma^2.2 0.0000 0.0000 5 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 4) = 3.1737, p-val = 0.5292
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1423 0.0442 3.2195 0.0013 0.0557 0.2289 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_travel$b, mod_travel$ci.lb, mod_travel$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.152925 1.057250 1.257259data_household <- data_alz %>%
subset(household==1)
mod_household <- rma.mv(yi = logRR,
V = var,
data = data_household,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_household)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.6885 -3.3769 0.6231 -3.3769 12.6231
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0000 0.0000 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 0.0140, p-val = 0.9059
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2037 0.0517 -3.9387 <.0001 -0.3050 -0.1023 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_household$b, mod_household$ci.lb, mod_household$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8157446 0.7371261 0.9027482# data_bkp <- data
data_alz$cases[data_alz$Ind_ID==148] = 1561
data_alz$cases[data_alz$Ind_ID==150] = 1561
data_alz$cases[data_alz$Ind_ID==152] = 1561
data_alz$cases[data_alz$Ind_ID==154] = 1561
data_alz$PY[data_alz$Ind_ID==148] = 5352889
data_alz$PY[data_alz$Ind_ID==150] = 5352889
data_alz$PY[data_alz$Ind_ID==152] = 5352889
data_alz$PY[data_alz$Ind_ID==154] = 5352889
data_alz$cases[data_alz$Ind_ID==32] = 33
data_alz$PY[data_alz$Ind_ID==32] = 3441
data_alz$Domain <- case_when(
data_alz$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data_alz$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data_alz$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data_alz$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
results_desc <- data_alz %>%
group_by(Domain) %>%
summarise(
total_cases = sum(cases, na.rm = TRUE),
total_PY = sum(PY, na.rm = TRUE),
IR = total_cases / total_PY,
effect_sizes = n(),
studies = n_distinct(ID)
)
results_desc## # A tibble: 5 × 6
## Domain total_cases total_PY IR effect_sizes studies
## <chr> <dbl> <dbl> <dbl> <int> <int>
## 1 HPA 0 0 NaN 2 1
## 2 LTPA 4465 1126097 0.00397 19 8
## 3 Non-specific 2903 403402 0.00720 38 21
## 4 OPA 33 3441 0.00959 3 2
## 5 TPA 3989 962887 0.00414 5 3model_domain <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
summary(model_domain)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -35.2852 70.5704 84.5704 99.4603 86.6445
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0608 0.2465 30 no ID
## sigma^2.2 0.0675 0.2598 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 62) = 388.8464, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 8.8101, p-val = 0.0660
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2606 0.2339 -1.1142 0.2652 -0.7190 0.1978
## DomainLTPA 0.0561 0.2233 0.2514 0.8015 -0.3816 0.4938
## DomainNon-specific -0.0821 0.2489 -0.3297 0.7416 -0.5698 0.4057
## DomainOPA 0.3700 0.2635 1.4043 0.1602 -0.1464 0.8863
## DomainTPA 0.4512 0.2532 1.7818 0.0748 -0.0451 0.9474 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_leisure <- data_alz %>%
subset(leisure==1)
model_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_leisure)##
## Multivariate Meta-Analysis Model (k = 19; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.1527 10.3053 16.3053 18.9764 18.0196
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0729 0.2700 8 no ID
## sigma^2.2 0.0447 0.2113 19 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 18) = 133.2295, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2322 0.1149 -2.0204 0.0433 -0.4575 -0.0069 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1mod.model <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ leisure)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.1840 78.3680 86.3680 95.0656 87.0347
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0832 0.2884 30 no ID
## sigma^2.2 0.0639 0.2528 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 65) = 421.7458, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.2882, p-val = 0.5914
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2421 0.0794 -3.0481 0.0023 -0.3977 -0.0864 **
## leisure1 -0.0621 0.1157 -0.5368 0.5914 -0.2888 0.1646
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Domains - Work
data_work <- data_alz %>%
subset(work_pa==1)
model_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_work)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0435 -2.0871 3.9129 -0.0076 27.9129
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0334 0.1828 2 no ID
## sigma^2.2 0.0000 0.0000 3 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 1.3244, p-val = 0.5157
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1542 0.1781 0.8658 0.3866 -0.1949 0.5034
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1mod.model <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ work_pa)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.7438 77.4875 85.4875 94.1851 86.1542
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0708 0.2661 30 no ID
## sigma^2.2 0.0673 0.2595 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 65) = 432.8147, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 1.6147, p-val = 0.2038
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2655 0.0692 -3.8376 0.0001 -0.4011 -0.1299 ***
## work_pa1 0.2522 0.1985 1.2707 0.2038 -0.1368 0.6413
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Domains - Commuting
data_commuting <- data_alz %>%
subset(travel==1)
model_commuting <- rma.mv(yi = logRR,
V = var,
data = data_commuting,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_commuting)##
## Multivariate Meta-Analysis Model (k = 5; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.9255 -1.8510 4.1490 2.3078 28.1490
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 3 no ID
## sigma^2.2 0.0000 0.0000 5 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 4) = 3.1737, p-val = 0.5292
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1423 0.0442 3.2195 0.0013 0.0557 0.2289 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1mod.model <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ travel)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -37.0655 74.1310 82.1310 90.8285 82.7976
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0683 0.2613 30 no ID
## sigma^2.2 0.0623 0.2495 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 65) = 419.9990, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 4.8360, p-val = 0.0279
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2817 0.0683 -4.1255 <.0001 -0.4155 -0.1479 ***
## travel1 0.3759 0.1710 2.1991 0.0279 0.0409 0.7110 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Domains - Household
data_household <- data_alz %>%
subset(household==1)
model_household <- rma.mv(yi = logRR,
V = var,
data = data_household,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_household)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.6885 -3.3769 0.6231 -3.3769 12.6231
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0000 0.0000 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 0.0140, p-val = 0.9059
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2037 0.0517 -3.9387 <.0001 -0.3050 -0.1023 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1mod.model <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ household)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.1828 78.3657 86.3657 95.0632 87.0324
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0785 0.2802 30 no ID
## sigma^2.2 0.0624 0.2498 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 65) = 432.7582, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 1.0713, p-val = 0.3007
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2581 0.0704 -3.6649 0.0002 -0.3961 -0.1201 ***
## household1 -0.2113 0.2042 -1.0350 0.3007 -0.6115 0.1889
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1extract_meta_info <- function(model, domain) {
s <- summary(model)
tibble::tibble(
domain = domain,
k = model$k,
estimate = s$beta[1],
se = s$se[1],
ci_lb = s$ci.lb[1],
ci_ub = s$ci.ub[1],
pval = s$pval[1],
zval = s$zval[1],
Q = s$QE, # heterogeneity Q
Q_pval = s$QEp # heterogeneity p-value
)
}
results_all <- dplyr::bind_rows(
extract_meta_info(model_leisure, "Leisure"),
extract_meta_info(model_work, "Work"),
extract_meta_info(model_commuting, "Commuting"),
extract_meta_info(model_household, "Household")
)
results_all## # A tibble: 4 × 10
## domain k estimate se ci_lb ci_ub pval zval Q Q_pval
## <chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Leisure 19 -0.232 0.115 -0.458 -0.00694 4.33e-2 -2.02 1.33e+2 1.28e-19
## 2 Work 3 0.154 0.178 -0.195 0.503 3.87e-1 0.866 1.32e+0 5.16e- 1
## 3 Commut… 5 0.142 0.0442 0.0557 0.229 1.28e-3 3.22 3.17e+0 5.29e- 1
## 4 Househ… 2 -0.204 0.0517 -0.305 -0.102 8.19e-5 -3.94 1.40e-2 9.06e- 1Create a new column with RR and 95% CI formatted
results_all$RR_label <- sprintf("%.2f (%.2f–%.2f); ES=%.f",
exp(results_all$estimate),
exp(results_all$ci_lb),
exp(results_all$ci_ub),
results_all$k)
pval_category <- function(p) {
case_when(
p < 0.001 ~ "<0.001",
p < 0.01 ~ "<0.01",
p < 0.05 ~ "<0.05",
TRUE ~ ">0.05"
)
}
pval_symbol <- function(p) {
case_when(
p < 0.001 ~ "★★★",
p < 0.01 ~ "★★",
p < 0.05 ~ "★",
TRUE ~ "●"
)
}
results_all_alz <- results_all %>%
mutate(
pval_cat = pval_category(pval),
pval_shape = pval_symbol(pval)
)
library(ggplot2)
# png("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Moderation_domains_ad.tiff", units = "in", width = 14, height = 10, res=300)
forest_ad <- ggplot(results_all_alz, aes(x = exp(estimate),y=domain,
xmin=exp(ci_lb), xmax=exp(ci_ub), shape=pval_cat)) +
geom_point(position = position_dodge2(width = 0.9, padding = 0.6), size = 3) +
geom_linerange(position = position_dodge2(width = 0.9, padding = 0.6), size = 1) +
geom_vline(xintercept = 1, linetype = "dashed") +
geom_text(aes(label = RR_label), hjust = 0.5, vjust = -1,
size = 5, family = "arial") +
scale_y_discrete(name= "") +
scale_x_continuous(name = "Relative risk") +
scale_shape_discrete(name="P-value") +
theme_bw() +
theme(text = element_text(size = 20, family = "arial"), panel.grid = element_line(colour = "white"),
axis.text.y = element_text(size = 20),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
plot.margin = margin(0.5, 0.5, 0.5, 0.5, "cm"), axis.text.x = element_text(size = 20),
axis.title.x = element_text(size = 16))
forest_ad
# dev.off()VASCULAR DEMENTIA
## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data_vascular <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Vascular dementia studies", col_names = T)
data_vascular <- data_vascular %>%
subset(is.na(Ind_ID)==F)
data_vascular$non_leisure <- factor(data_vascular$`Only non-leisure-related PA (1= yes, 0=no)`)
data_vascular$work_pa <- factor(data_vascular$`Only work-related PA (1= yes, 0=no)`)
data_vascular$leisure <- factor(data_vascular$`Only leisure PA (1= yes, 0=no)`)
data_vascular$travel <- factor(data_vascular$`Only travel-related PA (1= yes, 0=no)`)
data_vascular$household <- factor(data_vascular$`Only household-related PA (1= yes, 0=no)`)
data_vascular$follow_up <- factor(data_vascular$`Follow-up length group (1= < 10 years, 2= ≥10 years)`)
data_vascular$metting <- factor(data_vascular$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data_vascular$design <- case_when(
data_vascular$Design == "Prospective cohort study" ~ "Prospective cohort study",
data_vascular$Design == "Longitudinal cohort study" ~ "Prospective cohort study",
data_vascular$Design == "Case-control study" ~ "Case-control study",
data_vascular$Design == "Case-control study nested in prospective cohort study" ~ "Case-control study",
data_vascular$Design == "Nested case-control studies" ~ "Case-control study",
data_vascular$Design == "Prospective" ~ "Prospective cohort study",
data_vascular$Design == "Prospective population-based study" ~ "Prospective cohort study",
data_vascular$Design == "Retrospective cohort study" ~ "Case-control study",
data_vascular$Design == "prospective cohort study" ~ "Prospective cohort study",
TRUE ~ "Non-specific"
)
datatable(
data_vascular,
extensions = 'Buttons', # Ativa a extensão de botões
options = list(
dom = 'Bfrtip', # Define onde os botões e elementos aparecem
buttons = c('copy', 'csv', 'excel', 'pdf', 'print') # Lista os formatos desejados
)
)#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
# If SE is missing, calculate from 95% CI:
# data$SE = (log(data$`RR Upper Limit (95%)`) - log(data$`RR lower limit (95%)`)) / (2 * 1.96)
data_vascular$logRR <- log(data_vascular$RR)
# if (is.null(data$SE) || all(is.na(data$SE))) {
# data$SE <- (log(data$`RR Upper Limit (95%)`) - log(data$`RR lower limit (95%)`)) / (2 * 1.96)
# }
data_vascular$SE <- data_vascular$`Standard error (SE)`
data_vascular$var <- data_vascular$SE^2
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model <- metagen(TE = logRR, seTE = SE, data = data_vascular, method.tau = "REML")
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.9632 13.9263 19.9263 23.8138 20.9698
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0852 0.2918 11 no ID
## sigma^2.2 0.0118 0.1087 28 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 27) = 76.3124, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4045 0.1078 -3.7519 0.0002 -0.6159 -0.1932 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6672791 0.5401648 0.8243065#---------------------------------------------
# 5. Forest plot
#---------------------------------------------
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Forestplot_overall_pooled_vascular.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
forest(meta_model,
slab = data_vascular$Publication,
xlab = "Relative Risk (RR)",
atransf = exp,
at = log(c(0.25, 1, 2.5)),
header = "Study",
cex = 1)
dev.off()## quartz_off_screen
## 2#---------------------------------------------
# 6. Funnel plot
#---------------------------------------------
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Funnel_overall_pooled_vascular.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
funnel(meta_model, yaxis = "sei", xlab = "Log RR", back = "white")
dev.off()## quartz_off_screen
## 2#---------------------------------------------
# 7. Egger’s test for small-study bias
#---------------------------------------------
# Load required package
meta_model$data %>%
mutate(y = logRR/SE, x = 1/SE) %>%
lm(y ~ x, data = .) %>%
summary()##
## Call:
## lm(formula = y ~ x, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.0508 -0.8869 0.0252 1.1631 2.5938
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.42657 0.65766 -2.169 0.0394 *
## x -0.03259 0.10399 -0.313 0.7565
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.576 on 26 degrees of freedom
## Multiple R-squared: 0.003763, Adjusted R-squared: -0.03455
## F-statistic: 0.09821 on 1 and 26 DF, p-value: 0.7565##############################################
#---------------------------------------------
# 8. Heterogeneity
#---------------------------------------------
i2 <- var.comp(meta_model)
summary(i2)## % of total variance I2
## Level 1 20.947440 ---
## Level 2 9.629279 9.63
## Level 3 69.423282 69.42
## Total I2: 79.05%##############################################
#---------------------------------------------
# 9. Comparing two and three-level models
#---------------------------------------------
l3.removed <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
sigma2 = c(0, NA))
anova(meta_model, l3.removed)##
## df AIC BIC AICc logLik LRT pval QE
## Full 3 19.9263 23.8138 20.9698 -6.9632 76.3124
## Reduced 2 26.8668 29.4585 27.3668 -11.4334 8.9405 0.0028 76.3124# Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot.MODERATION - VASCULAR DEMENTIA
#---------------------------------------------
# 5. Moderation
#---------------------------------------------
summarize_moderator <- function(model, varname, dataset) {
# ---- step A: build prediction dataset (1 row per level)
newdata <- data.frame(x = levels(dataset[[varname]]))
# ---- step B: build dummy matrix for moderator (NO intercept)
X <- model.matrix(~ x, newdata)[, -1, drop = FALSE]
# ---- step C: rename dummy columns to EXACT coefficient names
coef_names <- names(coef(model))[-1] # drop intercept
colnames(X) <- coef_names
# ---- step D: predict log RR, convert to RR and CI
pred <- predict(model, newmods = X)
df_rr <- data.frame(
moderator_level = newdata$x,
RR = exp(pred$pred),
lower = exp(pred$ci.lb),
upper = exp(pred$ci.ub)
)
# ---- step E: descriptive summary by moderator level
df_desc <- dataset %>%
group_by(.data[[varname]]) %>%
summarise(
total_cases = sum(cases, na.rm = TRUE),
total_PY = sum(PY, na.rm = TRUE),
IR = total_cases / total_PY,
studies = n_distinct(ID), # # of unique studies
effect_sizes = n() # # of estimates (rows)
)
list(RR = df_rr, DESCRIPTIVES = df_desc)
}Baseline age
data_vascular$age_group <- cut(data_vascular$age,
breaks = c(-Inf, 49, 64, Inf),
labels = c("30-49 years", "50-64 years",
"65-80 years"))
mod_age <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ age_group)
summary(mod_age)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.9122 11.8243 21.8243 27.9187 24.9822
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1099 0.3315 11 no ID
## sigma^2.2 0.0119 0.1091 28 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 25) = 72.0745, p-val < .0001
##
## Test of Moderators (coefficients 2:3):
## QM(df = 2) = 0.3325, p-val = 0.8468
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1372 0.6561 -0.2090 0.8344 -1.4231 1.1488
## age_group50-64 years -0.3377 0.6819 -0.4953 0.6204 -1.6742 0.9987
## age_group65-80 years -0.2422 0.6750 -0.3587 0.7198 -1.5652 1.0809
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_age)
summary(i2)## % of total variance I2
## Level 1 17.421091 ---
## Level 2 8.075393 8.08
## Level 3 74.503515 74.5
## Total I2: 82.58%results_age <- summarize_moderator(mod_age, "age_group", data_vascular)
# VIEW OUTPUT
results_age$RR## moderator_level RR lower upper
## 1 30-49 years 0.8718318 0.2409585 3.1544469
## 2 50-64 years 0.6219442 0.4322392 0.8949087
## 3 65-80 years 0.6843306 0.5013986 0.9340040results_age$DESCRIPTIVES## # A tibble: 3 × 6
## age_group total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 30-49 years 27 35200 0.000767 1 1
## 2 50-64 years 1249 6283754. 0.000199 4 15
## 3 65-80 years 631 254576. 0.00248 6 12STUDY QUALITY
data_vascular$quality <- factor(data_vascular$quality, levels = c(1,2,3),
labels = c("Poor", "Moderate", "Good"),ordered = T)
mod_quality <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ quality)
summary(mod_quality)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.7257 11.4514 21.4514 27.5458 24.6093
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1167 0.3416 11 no ID
## sigma^2.2 0.0122 0.1102 28 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 25) = 71.0444, p-val < .0001
##
## Test of Moderators (coefficients 2:3):
## QM(df = 2) = 0.8450, p-val = 0.6554
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.4286 0.1233 -3.4776 0.0005 -0.6702 -0.1871 ***
## quality.L -0.1887 0.2068 -0.9124 0.3615 -0.5940 0.2166
## quality.Q 0.0053 0.2200 0.0241 0.9807 -0.4258 0.4364
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_quality)
summary(i2)## % of total variance I2
## Level 1 16.629716 ---
## Level 2 7.864632 7.86
## Level 3 75.505652 75.51
## Total I2: 83.37%results_quality <- summarize_moderator(mod_quality, "quality", data_vascular)
# VIEW OUTPUT
results_quality$RR## moderator_level RR lower upper
## 1 Poor 0.6548671 0.4068319 1.0541229
## 2 Moderate 0.5393877 0.3271917 0.8892008
## 3 Good 0.6514002 0.5116020 0.8293991results_quality$DESCRIPTIVES## # A tibble: 3 × 6
## quality total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 Poor 645 355364 0.00182 5 8
## 2 Moderate 313 243997. 0.00128 3 7
## 3 Good 949 5974169. 0.000159 3 13MEETING PA GUIDELINES
mod_meeting <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ metting)
summary(mod_meeting)##
## Multivariate Meta-Analysis Model (k = 20; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.3655 12.7310 20.7310 24.2925 23.8079
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0803 0.2834 10 no ID
## sigma^2.2 0.0000 0.0000 20 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 18) = 36.9462, p-val = 0.0053
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 6.1731, p-val = 0.0130
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2461 0.1363 -1.8055 0.0710 -0.5133 0.0211 .
## metting2 -0.2759 0.1110 -2.4846 0.0130 -0.4935 -0.0583 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_meeting)
summary(i2)## % of total variance I2
## Level 1 3.676395e+01 ---
## Level 2 1.137066e-08 0
## Level 3 6.323605e+01 63.24
## Total I2: 63.24%results_meeting <- summarize_moderator(mod_meeting, "metting", data_vascular)
results_meeting$RR## moderator_level RR lower upper
## 1 1 0.7818289 0.5985194 1.0212810
## 2 2 0.5933242 0.4745420 0.7418387results_meeting$DESCRIPTIVES## # A tibble: 3 × 6
## metting total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 1 895 1123321. 0.000797 6 7
## 2 2 209 97320. 0.00215 9 13
## 3 <NA> 803 5352889 0.000150 1 8#DEMENTIA CRITERIA
data_vascular$dem_criteria <- factor(data_vascular$Dementia, levels = c("DSM-III/IV/V", "Clinical evaluation", "Health records"),
ordered = T)
mod_criteria <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ dem_criteria )
summary(mod_criteria)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.0978 12.1955 22.1955 28.2899 25.3534
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0866 0.2943 11 no ID
## sigma^2.2 0.0117 0.1083 28 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 25) = 51.9584, p-val = 0.0012
##
## Test of Moderators (coefficients 2:3):
## QM(df = 2) = 1.1234, p-val = 0.5702
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.4477 0.1198 -3.7367 0.0002 -0.6825 -0.2129 ***
## dem_criteria.L 0.1239 0.1680 0.7375 0.4608 -0.2053 0.4531
## dem_criteria.Q 0.1780 0.2406 0.7395 0.4596 -0.2937 0.6496
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_criteria)
summary(i2)## % of total variance I2
## Level 1 20.720988 ---
## Level 2 9.450913 9.45
## Level 3 69.828099 69.83
## Total I2: 79.28%results_criteria <- summarize_moderator(mod_criteria, "dem_criteria", data_vascular)
results_criteria$RR## moderator_level RR lower upper
## 1 DSM-III/IV/V 0.7233933 0.4872494 1.073984
## 2 Clinical evaluation 0.6391072 0.5053517 0.808265
## 3 Health records 0.7635941 0.4969827 1.173232results_criteria$DESCRIPTIVES## # A tibble: 3 × 6
## dem_criteria total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 DSM-III/IV/V 459 422281. 0.00109 4 7
## 2 Clinical evaluation 104 7699 0.0135 2 2
## 3 Health records 1344 6143550. 0.000219 5 19Follow-up duration
mod_followup <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ follow_up)
mod_followup##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1023 0.3199 11 no ID
## sigma^2.2 0.0119 0.1090 28 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 26) = 72.0878, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.0862, p-val = 0.7691
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.3787 0.1545 -2.4511 0.0142 -0.6816 -0.0759 *
## follow_up2 -0.0682 0.2325 -0.2935 0.7691 -0.5239 0.3874
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_followup)
summary(i2)## % of total variance I2
## Level 1 18.372381 ---
## Level 2 8.489313 8.49
## Level 3 73.138306 73.14
## Total I2: 81.63%results_followup <- summarize_moderator(mod_followup, "follow_up", data_vascular)
results_followup$RR## moderator_level RR lower upper
## 1 1 0.6847271 0.505816 0.9269205
## 2 2 0.6395607 0.455027 0.8989309results_followup$DESCRIPTIVES## # A tibble: 2 × 6
## follow_up total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 1 631 254576. 0.00248 6 12
## 2 2 1276 6318954. 0.000202 5 16Sex
data_vascular$women_group <- cut(data_vascular$percentage_women,
breaks = c(-Inf, 0.50, Inf),
labels = c("≤50%", ">50%"))
mod_women <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ women_group)
mod_women##
## Multivariate Meta-Analysis Model (k = 11; method: REML)
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0389 0.1973 11 no ID
## sigma^2.2 0.0389 0.1973 11 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 9) = 25.5617, p-val = 0.0024
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.5137, p-val = 0.4735
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.5621 0.3170 -1.7733 0.0762 -1.1834 0.0592 .
## women_group>50% 0.2424 0.3382 0.7168 0.4735 -0.4204 0.9051
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_women)
summary(i2)## % of total variance I2
## Level 1 31.26103 ---
## Level 2 34.36949 34.37
## Level 3 34.36949 34.37
## Total I2: 68.74%results_women <- summarize_moderator(mod_women, "women_group", data_vascular)
results_women$RR## moderator_level RR lower upper
## 1 ≤50% 0.7263352 0.5766248 0.9149151
## 2 >50% 0.5700000 0.3062365 1.0609448results_women$DESCRIPTIVES## # A tibble: 3 × 6
## women_group total_cases total_PY IR studies effect_sizes
## <fct> <dbl> <dbl> <dbl> <int> <int>
## 1 ≤50% 78 86700 0.000900 1 1
## 2 >50% 1829 6486830. 0.000282 10 10
## 3 <NA> 0 0 NaN 6 17Study design
data_vascular$design <- factor(data_vascular$design, ordered = T)
mod_design <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ design)
summary(mod_design)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.7236 13.4472 21.4472 26.4795 23.3519
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1028 0.3206 11 no ID
## sigma^2.2 0.0119 0.1092 28 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 26) = 74.1029, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.0017, p-val = 0.9673
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.4056 0.1420 -2.8561 0.0043 -0.6839 -0.1273 **
## design.L -0.0082 0.2008 -0.0410 0.9673 -0.4019 0.3854
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_design)
summary(i2)## % of total variance I2
## Level 1 18.302011 ---
## Level 2 8.491415 8.49
## Level 3 73.206574 73.21
## Total I2: 81.7%results_design <- summarize_moderator(mod_design, "design", data_vascular)
# VIEW OUTPUT
results_design$RR## moderator_level RR lower upper
## 1 Case-control study 0.6665763 0.5046236 0.8805057
## 2 Prospective cohort study 0.6611124 0.4779258 0.9145135results_design$DESCRIPTIVES## # A tibble: 2 × 6
## design total_cases total_PY IR studies effect_sizes
## <ord> <dbl> <dbl> <dbl> <int> <int>
## 1 Case-control study 310 304701 0.00102 2 4
## 2 Prospective cohort study 1597 6268829. 0.000255 9 24Number of covariates
data_vascular$covariates <- as.numeric(data_vascular$`Total number of covariates`)
mod_covariates <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ covariates)
summary(mod_covariates)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.6191 13.2382 21.2382 26.2706 23.1430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1002 0.3166 11 no ID
## sigma^2.2 0.0119 0.1090 28 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 26) = 71.9004, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.0006, p-val = 0.9800
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.4025 0.2631 -1.5298 0.1261 -0.9182 0.1132
## covariates -0.0006 0.0253 -0.0251 0.9800 -0.0502 0.0489
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_covariates)
summary(i2)## % of total variance I2
## Level 1 18.64805 ---
## Level 2 8.62610 8.63
## Level 3 72.72585 72.73
## Total I2: 81.35%DOMAINS
data_vascular$Domain <- case_when(
data_vascular$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data_vascular$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data_vascular$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data_vascular$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
mod_domain <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
summary(mod_domain)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -3.5014 7.0028 21.0028 28.9512 28.4694
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0136 0.1168 11 no ID
## sigma^2.2 0.0088 0.0937 28 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 23) = 35.3789, p-val = 0.0477
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 18.3566, p-val = 0.0011
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1036 0.1351 -0.7665 0.4434 -0.3684 0.1613
## DomainLTPA -0.1093 0.1321 -0.8273 0.4080 -0.3683 0.1497
## DomainNon-specific -0.5329 0.1674 -3.1833 0.0015 -0.8611 -0.2048 **
## DomainOPA 0.1116 0.1400 0.7974 0.4252 -0.1627 0.3860
## DomainTPA 0.1217 0.1472 0.8266 0.4084 -0.1668 0.4101
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(mod_domain)
summary(i2)## % of total variance I2
## Level 1 53.40860 ---
## Level 2 18.25045 18.25
## Level 3 28.34095 28.34
## Total I2: 46.59%data_leisure <- data_vascular %>%
subset(leisure==1)
mod_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_leisure)##
## Multivariate Meta-Analysis Model (k = 10; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.1022 -2.2045 3.7955 4.3872 8.5955
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0090 0.0949 4 no ID
## sigma^2.2 0.0077 0.0878 10 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 9) = 13.7534, p-val = 0.1314
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2175 0.0754 -2.8833 0.0039 -0.3653 -0.0696 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_leisure$b, mod_leisure$ci.lb, mod_leisure$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8045429 0.6939756 0.9327262data_work <- data_vascular %>%
subset(work_pa==1)
mod_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_work)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.2285 -0.4570 3.5430 -0.4570 15.5430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0267 0.1635 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 3.5898, p-val = 0.0581
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0506 0.1361 -0.3718 0.7101 -0.3175 0.2162
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_work$b, mod_work$ci.lb, mod_work$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9506435 0.7279947 1.2413868data_travel <- data_vascular %>%
subset(travel==1)
mod_travel <- rma.mv(yi = logRR,
V = var,
data = data_travel,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_travel)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0790 -2.1579 1.8421 -2.1579 13.8421
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0000 0.0000 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 0.2399, p-val = 0.6243
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0408 0.0850 -0.4794 0.6317 -0.2074 0.1259
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_travel$b, mod_travel$ci.lb, mod_travel$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9600545 0.8126631 1.1341781data_household <- data_vascular %>%
subset(household==1)
mod_household <- rma.mv(yi = logRR,
V = var,
data = data_household,
random = ~1| ID/Ind_ID,
method = "REML")
summary(mod_household)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.3706 -0.7412 3.2588 -0.7412 15.2588
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0165 0.1286 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 2.4563, p-val = 0.1171
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1646 0.1180 -1.3948 0.1631 -0.3959 0.0667
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(mod_household$b, mod_household$ci.lb, mod_household$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8482274 0.6730620 1.0689798# data_bkp <- data
data_vascular$cases[data_vascular$Ind_ID==148] = 1561
data_vascular$cases[data_vascular$Ind_ID==150] = 1561
data_vascular$cases[data_vascular$Ind_ID==152] = 1561
data_vascular$cases[data_vascular$Ind_ID==154] = 1561
data_vascular$PY[data_vascular$Ind_ID==148] = 5352889
data_vascular$PY[data_vascular$Ind_ID==150] = 5352889
data_vascular$PY[data_vascular$Ind_ID==152] = 5352889
data_vascular$PY[data_vascular$Ind_ID==154] = 5352889
results_desc <- data_vascular %>%
group_by(Domain) %>%
summarise(
total_cases = sum(cases, na.rm = TRUE),
total_PY = sum(PY, na.rm = TRUE),
IR = total_cases / total_PY,
effect_sizes = n(),
studies = n_distinct(ID)
)
results_desc## # A tibble: 5 × 6
## Domain total_cases total_PY IR effect_sizes studies
## <chr> <dbl> <dbl> <dbl> <int> <int>
## 1 HPA 0 0 NaN 2 1
## 2 LTPA 1549 5883355 0.000263 10 4
## 3 Non-specific 358 690175. 0.000519 12 7
## 4 OPA 0 0 NaN 2 1
## 5 TPA 0 0 NaN 2 1FORESTPLOT FOR MODERATION ANALYSIS
# ALL CAUSE
dt <- read.csv("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/data_allcause.csv")
colnames(dt)[ncol(dt)] <- "I\u00B2"
# Replace NA with blank or NA will be transformed to character
dt$se <- (log(dt$upper) - log(dt$RR)) / 1.96
# Add a blank column for the forest plot to display CI
# Adjust the column width with spaces; increase the number of spaces below
# to provide a larger area for drawing the CI
dt$` ` <- paste(rep(" ", 20), collapse = " ")
# Create a confidence interval column to display
dt$`HR (95% CI)` <- ifelse(is.na(dt$se), "",
sprintf("%.2f (%.2f to %.2f)",
dt$RR, dt$lower, dt$upper))
# Replace NA with blank or NA will be transformed to character
dt$Studies <- ifelse(is.na(dt$Studies), "", dt$Studies)
dt$ES <- ifelse(is.na(dt$ES), "", dt$ES)
dt$`Cases/Person-years` <- dt$Cases.Person.years
dt$`P value for moderation` <- dt$P.value.for.moderation
dt[, 14] <- ifelse(is.na(dt[, 14]), "", dt[, 8])
# build the plot first
library(forestploter)
p_all_cause <- forest(
dt[, c(1, 5:6, 13, 11:12, 14, 9)],
est = dt$RR,
lower = dt$lower,
upper = dt$upper,
ci_column = 5,
ref_line = 1,
xlim = c(0.6, 1.4),
ticks_at = c(0.6, 1.0, 1.4),
title = "All-cause dementia",
is_summary = c(rep(FALSE, nrow(dt) - 1), TRUE),
# --- Lancet visual style ---
colgap = unit(6, "mm"),
lwd.ci = 1,
lwd.ref = 0.8,
refline_gp = gpar(lty = 2), # dashed reference line
ci_Theight = 0.15, # square height
text_size = 8
)
p_all_cause <- edit_plot(
p_all_cause,
row = nrow(dt),
gp = gpar(fontface = "bold", cex = 1.05)
)
p_all_cause <- edit_plot(
p_all_cause,
which = "background",
gp = gpar(fill = "white", col = NA)
)
p_all_cause
# Get width and height
p_wh <- get_wh(plot = p_all_cause, unit = "in")
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/forestplot_allcause.tiff",
res = 300, width = p_wh[1], height = p_wh[2], units = "in", compression="lzw")
p_all_cause
dev.off()## quartz_off_screen
## 2# ALZHEIMER DISEASE
dt <- read.csv("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/data_alzheimer.csv")
colnames(dt)[ncol(dt)] <- "I\u00B2"
# Replace NA with blank or NA will be transformed to character
dt$se <- (log(dt$upper) - log(dt$RR)) / 1.96
# Add a blank column for the forest plot to display CI
# Adjust the column width with spaces; increase the number of spaces below
# to provide a larger area for drawing the CI
dt$` ` <- paste(rep(" ", 20), collapse = " ")
# Create a confidence interval column to display
dt$`HR (95% CI)` <- ifelse(is.na(dt$se), "",
sprintf("%.2f (%.2f to %.2f)",
dt$RR, dt$lower, dt$upper))
# Replace NA with blank or NA will be transformed to character
dt$Studies <- ifelse(is.na(dt$Studies), "", dt$Studies)
dt$ES <- ifelse(is.na(dt$ES), "", dt$ES)
dt$`Cases/Person-years` <- dt$Cases.Person.years
dt$`P value for moderation` <- dt$P.value.for.moderation
dt[, 14] <- ifelse(is.na(dt[, 14]), "", dt[, 8])
# build the plot first
library(forestploter)
p_alz <- forest(
dt[, c(1, 5:6, 13, 11:12, 14, 9)],
est = dt$RR,
lower = dt$lower,
upper = dt$upper,
ci_column = 5,
ref_line = 1,
xlim = c(0.6, 1.4),
ticks_at = c(0.6, 1.0, 1.4),
title = "Alzheimer's disease",
is_summary = c(rep(FALSE, nrow(dt) - 1), TRUE),
# --- Lancet visual style ---
colgap = unit(6, "mm"),
lwd.ci = 1,
lwd.ref = 0.8,
refline_gp = gpar(lty = 2), # dashed reference line
ci_Theight = 0.15, # square height
text_size = 8
)
p_alz <- edit_plot(
p_alz,
row = nrow(dt),
gp = gpar(fontface = "bold", cex = 1.05)
)
p_alz <- edit_plot(
p_alz,
which = "background",
gp = gpar(fill = "white", col = NA)
)
p_alz
# Get width and height
p_wh <- get_wh(plot = p_alz, unit = "in")
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/forestplot_alzheimer.tiff",
res = 300, width = p_wh[1], height = p_wh[2], units = "in", compression="lzw")
p_alz
dev.off()## quartz_off_screen
## 2# VASCULAR DEMENTIA
dt <- read.csv("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/data_vascular.csv")
colnames(dt)[ncol(dt)] <- "I\u00B2"
# Replace NA with blank or NA will be transformed to character
dt$se <- (log(dt$upper) - log(dt$RR)) / 1.96
# Add a blank column for the forest plot to display CI
# Adjust the column width with spaces; increase the number of spaces below
# to provide a larger area for drawing the CI
dt$` ` <- paste(rep(" ", 20), collapse = " ")
# Create a confidence interval column to display
dt$`HR (95% CI)` <- ifelse(is.na(dt$se), "",
sprintf("%.2f (%.2f to %.2f)",
dt$RR, dt$lower, dt$upper))
# Replace NA with blank or NA will be transformed to character
dt$Studies <- ifelse(is.na(dt$Studies), "", dt$Studies)
dt$ES <- ifelse(is.na(dt$ES), "", dt$ES)
dt$`Cases/Person-years` <- dt$Cases.Person.years
dt$`P value for moderation` <- dt$P.value.for.moderation
dt[, 14] <- ifelse(is.na(dt[, 14]), "", dt[, 8])
# build the plot first
library(forestploter)
p_vascular <- forest(
dt[, c(1, 5:6, 13, 11:12, 14, 9)],
est = dt$RR,
lower = dt$lower,
upper = dt$upper,
ci_column = 5,
ref_line = 1,
xlim = c(0.6, 1.4),
ticks_at = c(0.6, 1.0, 1.4),
title = "Vascular dementia",
is_summary = c(rep(FALSE, nrow(dt) - 1), TRUE),
# --- Lancet visual style ---
colgap = unit(6, "mm"),
lwd.ci = 1,
lwd.ref = 0.8,
refline_gp = gpar(lty = 2), # dashed reference line
ci_Theight = 0.15, # square height
text_size = 8
)
p_vascular <- edit_plot(
p_vascular,
row = nrow(dt),
gp = gpar(fontface = "bold", cex = 1.05)
)
p_vascular <- edit_plot(
p_vascular,
which = "background",
gp = gpar(fill = "white", col = NA)
)
# print
p_vascular
# Get width and height
p_wh <- get_wh(plot = p_vascular, unit = "in")
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/forestplot_vascular.tiff",
res = 300, width = p_wh[1], height = p_wh[2], units = "in", compression="lzw")
p_vascular
dev.off()## quartz_off_screen
## 2LEAVE-ONE-OUT
##############################################
#---------------------------------------------
# 12. Leave-one-out method
#---------------------------------------------
###########################################
# GENERAL
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$Domain <- case_when(
data$leisure == 1 ~ "LTPA",
data$work_pa == 1 ~ "OPA",
data$household == 1 ~ "HPA",
data$travel == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
ids <- unique(data$ID)
# Create lookup table for Publication by ID
pub_lookup <- data %>%
group_by(ID) %>%
summarise(Publication = first(Publication))
loo <- data.frame(
study = ids,
estimate = NA,
se = NA,
pval = NA
)
for (s in seq_along(ids)) {
# Remove one entire study
dat_i <- subset(data, ID != ids[s])
# Refit model
mod_i <- rma.mv(
yi = logRR,
V = var,
data = dat_i,
random = ~1 | ID/Ind_ID,
method = "REML"
)
# Extract results (intercept only)
loo$estimate[s] <- coef(mod_i)[1]
loo$se[s] <- summary(mod_i)$se[1]
loo$pval[s] <- summary(mod_i)$pval[1]
}
# Add publication label
loo <- loo %>%
left_join(pub_lookup, by = c("study" = "ID"))
# loo
loo_plot <- loo %>%
mutate(
ci_lb = estimate - 1.96*se,
ci_ub = estimate + 1.96*se)
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Leave_one_out_allcause.tiff", width=10, height=14, units="in", res=300, compression="lzw")
ggplot(loo_plot, aes(x = exp(estimate), y = Publication)) +
geom_point() +
geom_errorbarh(aes(xmin = exp(ci_lb), xmax = exp(ci_ub)), height = 0.15) +
geom_vline(xintercept = exp(coef(meta_model_3level)[1]), linetype = "dashed") +
geom_vline(xintercept = 1, linetype = "solid") +
xlab("Relative risk (LOO estimate)") +
ylab("Study") +
theme_classic() +
coord_cartesian(xlim = c(0.7, 1.05))
dev.off()## quartz_off_screen
## 2MODERATION
mod.model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mod = ~ Domain)
summary(mod.model)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -34.5480 69.0959 83.0959 104.4896 83.8476
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0627 0.2504 76 no ID
## sigma^2.2 0.0195 0.1395 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 157) = 1390.5776, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 15.8362, p-val = 0.0032
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2235 0.1240 -1.8020 0.0716 -0.4666 0.0196 .
## DomainLTPA -0.0356 0.1246 -0.2859 0.7750 -0.2799 0.2086
## DomainNon-specific -0.0389 0.1250 -0.3107 0.7560 -0.2839 0.2062
## DomainOPA 0.2249 0.1303 1.7264 0.0843 -0.0304 0.4802 .
## DomainTPA 0.2731 0.1408 1.9402 0.0524 -0.0028 0.5491 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1ids <- unique(data$ID)
loo <- data.frame(
study = ids,
estimate = NA,
se = NA,
pval = NA,
mods = NA
)
for (s in seq_along(ids)) {
# remove one entire study
dat_i <- subset(data, ID != ids[s])
# re-fit model using same formula as meta_model
mod_i <- rma.mv(
yi = logRR,
V = var,
data = dat_i,
mods = ~Domain,
random = ~1 | ID/Ind_ID,
method = "REML"
)
# extract results
loo$estimate_workpa[s] <- mod_i$QEp
}
data$logRR <- log(data$RR)
data$var <- data$SE^2
pub_lookup <- data %>%
group_by(ID) %>%
summarise(Publication = first(Publication))
ids <- unique(data$ID)
loo <- data.frame(
study = ids,
pval_domain = NA_real_
)
for (s in seq_along(ids)) {
# Remove one entire study
dat_i <- subset(data, ID != ids[s])
# Refit same model
mod_i <- rma.mv(
yi = logRR,
V = var,
data = dat_i,
mods = ~ Domain,
random = ~1 | ID/Ind_ID,
method = "REML"
)
# Extract p-value for the moderator (Domain)
loo$pval_domain[s] <- mod_i$QMp
}
loo <- loo %>%
left_join(pub_lookup, by = c("study" = "ID"))
loo <- loo %>%
mutate(PubLabel = paste0(study, " – ", Publication))
loo_plot <- loo %>%
mutate(
PubLabel = factor(PubLabel,
levels = PubLabel[order(pval_domain, decreasing = TRUE)]),
neglog_p = -log10(pval_domain)
)
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Leave_one_out_allcause_moderation.tiff", width=10, height=14, units="in", res=300, compression="lzw")
ggplot(loo_plot, aes(x = pval_domain, y = PubLabel)) +
geom_segment(aes(x = 0, xend = pval_domain, y = PubLabel, yend = PubLabel),
color = "grey70") +
geom_point(size = 3, color = "firebrick") +
geom_vline(xintercept = 0.05, linetype = "solid") +
labs(
x = "p-value for Domain moderator (leave-one-out)",
y = "Study (Publication)",
title = "Influence of individual studies on moderator significance"
) +
theme_classic() +
coord_cartesian(xlim = c(0, 0.07))
dev.off()## quartz_off_screen
## 2### FORESPLOT WORK + LEAVE-ONE-OUT
### FORESPLOT
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$Domain <- case_when(
data$leisure == 1 ~ "LTPA",
data$work_pa == 1 ~ "OPA",
data$household == 1 ~ "HPA",
data$travel == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data <- data %>%
subset(is.na(Ind_ID)==F & work_pa==1)
data_work <- data
library(dplyr)
library(ggplot2)
data_work$logRR <- log(data_work$RR)
data_work$var <- data_work$SE*data_work$SE
## 1. Study-level effects (work-related PA subset)
# assumes data_work has: ID, logRR, var (or SE)
data_work <- data_work %>%
mutate(
SE = ifelse(!is.na(SE), SE, sqrt(var)), # in case SE not stored
RR = exp(logRR),
CI_low = exp(logRR - 1.96 * SE),
CI_high = exp(logRR + 1.96 * SE),
Study = as.factor(ID) # or use a publication label if you have it
)
df_studies <- data_work %>%
dplyr::select(Study, RR, CI_low, CI_high)
## 2. Pooled effect from rma.mv model
model_work <- rma.mv(
yi = logRR,
V = var,
data = data_work,
random = ~1 | ID/Ind_ID,
method = "REML"
)
sum_work <- summary(model_work)
est_pooled <- as.numeric(coef(model_work)[1])
se_pooled <- as.numeric(sum_work$se[1])
RR_pooled <- exp(est_pooled)
RR_pooled_low <- exp(est_pooled - 1.96 * se_pooled)
RR_pooled_high<- exp(est_pooled + 1.96 * se_pooled)
df_pooled <- data.frame(
Study = factor("Pooled estimate"),
RR = RR_pooled,
CI_low = RR_pooled_low,
CI_high= RR_pooled_high
)
## 3. Combine individual + pooled rows
df_plot <- bind_rows(df_studies, df_pooled)
# order: studies first, pooled at bottom
df_plot$Study <- factor(df_plot$Study,
levels = rev(unique(df_plot$Study)))
df_plot$Study <- factor(df_plot$Study,
levels = c("Pooled estimate","28", "35", "66", "67",
"69","71"),
labels = c( "Pooled estimate",
"Copenhagen Male Study",
"CAIDE study",
"Copenhagen City Heart Study (Male)",
"Copenhagen City Heart Study (Female)",
"HUNT4 70+ study",
"UK Biobank"), ordered = T)
df_plot$label_row <- c("Copenhagen Male Study (Light)",
"Copenhagen Male Study (Vigorous)",
"CAIDE Study (Any physical work)",
"Copenhagen City Heart Study (Male, Light)",
"Copenhagen City Heart Study (Male, Moderate)",
"Copenhagen City Heart Study (Male, Heavy)",
"Copenhagen City Heart Study (Female, Light)",
"Copenhagen City Heart Study (Female, Moderate/Heavy)",
"HUNT4 70 + Study (High then Low)",
"HUNT4 70 + Study (Stable Moderate)",
"HUNT4 70 + Study (Stable high)",
"UK Biobank (Medium level)",
"UK Biobank (High level)",
"Pooled estimation")
df_plot$label_row <- factor(
df_plot$label_row,
levels = rev(df_plot$label_row), # ordem invertida automaticamente
ordered = TRUE
)
all_cause_full <- ggplot(df_plot, aes(x = RR, y = label_row)) +
geom_linerange(aes(xmin = CI_low, xmax = CI_high)) +
geom_point() +
geom_vline(xintercept = 1, linetype = "solid", color = "black") +
labs(
title = "",
x = "Relative Risk",
y = ""
) +
geom_vline(xintercept = 1.1831885, linetype = "dashed") +
theme(axis.line.x = element_line(colour = "black"),
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 14, colour = "black"),
plot.title = element_text(face = "bold"),
text = element_text(size = 16),
panel.background = element_rect(fill = "white")) +
coord_cartesian(xlim = c(0.6,3))
all_cause_full
### LEAVE-ONE-OUT
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$Domain <- case_when(
data$leisure == 1 ~ "LTPA",
data$work_pa == 1 ~ "OPA",
data$household == 1 ~ "HPA",
data$travel == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data <- data %>%
subset(is.na(Ind_ID)==F & work_pa==1)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
ids <- unique(data$ID)
# Create lookup table for Publication by ID
data_work <- data %>%
subset(work_pa==1)
model_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_work)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 6.3760 7.8307 9.3760
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0170 0.1303 5 no ID
## sigma^2.2 0.0308 0.1754 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1pub_lookup <- data %>%
group_by(ID) %>%
summarise(Publication = first(Publication))
loo <- data.frame(
study = ids,
estimate = NA,
se = NA,
pval = NA
)
for (s in seq_along(ids)) {
# Remove one entire study
dat_i <- subset(data, ID != ids[s])
# Refit model
mod_i <- rma.mv(
yi = logRR,
V = var,
data = dat_i,
random = ~1 | ID/Ind_ID,
method = "REML"
)
# Extract results (intercept only)
loo$estimate[s] <- coef(mod_i)[1]
loo$se[s] <- summary(mod_i)$se[1]
loo$pval[s] <- summary(mod_i)$pval[1]
}
# Add publication label
loo <- loo %>%
left_join(pub_lookup, by = c("study" = "ID"))
loo## study estimate se pval
## 1 28 0.17114603 0.11224061 0.12730556
## 2 35 0.17211697 0.09251334 0.06282107
## 3 67 0.22893545 0.11100830 0.03917657
## 4 69 0.06903237 0.04678818 0.14009879
## 5 71 0.23047347 0.10070700 0.02210524
## Publication
## 1 Nabe-Nielsen 2021 (Light)
## 2 Rovio 2007
## 3 Nabe-Nielsen 2024 (male)
## 4 Zotcheva 2023 (Increasing then decreasing trajectory OPA)
## 5 Zhu 2022(Medium tertile)loo_plot <- loo %>%
mutate(
ci_lb = estimate - 1.96*se,
ci_ub = estimate + 1.96*se)
loo_plot$study <- factor(loo_plot$study,
levels = c("28", "35", "66", "67",
"69","71"),
labels = c("Copenhagen Male Study",
"CAIDE study",
"Copenhagen City Heart Study (Male)",
"Copenhagen City Heart Study (Female)",
"HUNT4 70+ study",
"UK Biobank"), ordered = T)
all_cause_leave <- ggplot(loo_plot, aes(x = exp(estimate), y = study)) +
geom_point() +
geom_errorbarh(aes(xmin = exp(ci_lb), xmax = exp(ci_ub)), height = 0.15) +
geom_vline(xintercept = exp(coef(model_work)[1]), linetype = "dashed") +
geom_vline(xintercept = 1, linetype = "solid") +
xlab("Relative risk (LOO estimate)") +
ylab("") +
theme(axis.line.x = element_line(colour = "black"),
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 16, colour = "black"),
plot.title = element_text(face = "bold"),
text = element_text(size = 16),
panel.background = element_rect(fill = "white")) +
coord_cartesian(xlim = c(0.8,1.5))
all_cause_leave
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/leave_out_combined_work_2026.tiff", width=10, height=14, units="in", res=300, compression="lzw")
ggarrange(all_cause_full, all_cause_leave, nrow = 2)
dev.off()## quartz_off_screen
## 2### FORESPLOT WORK + LEAVE-ONE-OUT
### FORESPLOT
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$Domain <- case_when(
data$leisure == 1 ~ "LTPA",
data$work_pa == 1 ~ "OPA",
data$household == 1 ~ "HPA",
data$travel == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data <- data %>%
subset(is.na(Ind_ID)==F & leisure==1)
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
library(dplyr)
library(ggplot2)
data_leisure <- data
## 1. Study-level effects (work-related PA subset)
# assumes data_work has: ID, logRR, var (or SE)
data_leisure <- data_leisure %>%
mutate(
SE = ifelse(!is.na(SE), SE, sqrt(var)), # in case SE not stored
RR = exp(logRR),
CI_low = exp(logRR - 1.96 * SE),
CI_high = exp(logRR + 1.96 * SE),
Study = as.factor(Cohort_label) # or use a publication label if you have it
)
df_studies <- data_leisure %>%
dplyr::select(Study, RR, CI_low, CI_high)
## 2. Pooled effect from rma.mv model
model_leisure <- rma.mv(
yi = logRR,
V = var,
data = data_leisure,
random = ~1 | ID/Ind_ID,
method = "REML"
)
sum_leisure <- summary(model_leisure)
est_pooled <- as.numeric(coef(model_leisure)[1])
se_pooled <- as.numeric(sum_leisure$se[1])
RR_pooled <- exp(est_pooled)
RR_pooled_low <- exp(est_pooled - 1.96 * se_pooled)
RR_pooled_high<- exp(est_pooled + 1.96 * se_pooled)
df_pooled <- data.frame(
Study = factor("Pooled estimate"),
RR = RR_pooled,
CI_low = RR_pooled_low,
CI_high= RR_pooled_high
)
## 3. Combine individual + pooled rows
df_plot <- bind_rows(df_studies, df_pooled)
# order: studies first, pooled at bottom
df_plot$Study <- factor(df_plot$Study,
levels = rev(unique(df_plot$Study)))
# df_plot$label_row <- c("EPIDOS-Toulouse Cohort",
# "HARMONY study (Light PA)",
# "HARMONY study (Regular Exercise)",
# "HARMONY study (Hard training)",
# "Québec Nuage cohort",
# "VITA study",
# "Duke Twins Study of Memory in Aging",
# "Copenhagen City Heart Study (Female, Moderate/Heavy)",
# "HUNT4 70 + Study (High then Low)",
# "HUNT4 70 + Study (Stable Moderate)",
# "HUNT4 70 + Study (Stable high)",
# "UK Biobank (Medium level)",
# "UK Biobank (High level)",
# "Pooled estimation")
# df_plot$label_row <- factor(
# df_plot$label_row,
# levels = rev(df_plot$label_row), # ordem invertida automaticamente
# ordered = TRUE
#)
all_cause_full_leisure <- ggplot(df_plot, aes(x = RR, y = Study)) +
geom_linerange(aes(xmin = CI_low, xmax = CI_high)) +
geom_point() +
geom_vline(xintercept = 1, linetype = "solid", color = "black") +
labs(
title = "",
x = "Relative Risk",
y = ""
) +
geom_vline(xintercept = 0.8344354, linetype = "dashed") +
theme(axis.line.x = element_line(colour = "black"),
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 12, colour = "black"),
plot.title = element_text(face = "bold"),
text = element_text(size = 16),
panel.background = element_rect(fill = "white")) +
coord_cartesian(xlim = c(0.3,3))
all_cause_full_leisure
### LEAVE-ONE-OUT
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$Domain <- case_when(
data$leisure == 1 ~ "LTPA",
data$work_pa == 1 ~ "OPA",
data$household == 1 ~ "HPA",
data$travel == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data <- data %>%
subset(is.na(Ind_ID)==F & leisure==1)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
ids <- unique(data$ID)
# Create lookup table for Publication by ID
data_leisure <- data %>%
subset(leisure==1)
model_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
summary(model_leisure)##
## Multivariate Meta-Analysis Model (k = 42; method: REML)
##
## logLik Deviance AIC BIC AICc
## 7.0500 -14.1001 -8.1001 -2.9593 -7.4514
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0203 0.1426 20 no ID
## sigma^2.2 0.0040 0.0633 42 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 41) = 139.3871, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1988 0.0402 -4.9517 <.0001 -0.2775 -0.1201 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1pub_lookup <- data %>%
group_by(ID) %>%
summarise(Cohort_merged = first(Cohort_merged))
loo <- data.frame(
study = ids,
estimate = NA,
se = NA,
pval = NA
)
for (s in seq_along(ids)) {
# Remove one entire study
dat_i <- subset(data, ID != ids[s])
# Refit model
mod_i <- rma.mv(
yi = logRR,
V = var,
data = dat_i,
random = ~1 | ID/Ind_ID,
method = "REML"
)
# Extract results (intercept only)
loo$estimate[s] <- coef(mod_i)[1]
loo$se[s] <- summary(mod_i)$se[1]
loo$pval[s] <- summary(mod_i)$pval[1]
}
# Add publication label
loo <- loo %>%
left_join(pub_lookup, by = c("study" = "ID"))
loo## study estimate se pval
## 1 1 -0.1971236 0.04231816 3.190906e-06
## 2 2 -0.1855159 0.03876818 1.707637e-06
## 3 4 -0.2086201 0.04258608 9.643058e-07
## 4 12 -0.2032960 0.04329899 2.663903e-06
## 5 15 -0.2112846 0.04062222 1.979977e-07
## 6 18 -0.2052848 0.04241560 1.299427e-06
## 7 22 -0.2065274 0.04317115 1.719068e-06
## 8 27 -0.1967942 0.04228916 3.262872e-06
## 9 31 -0.1990360 0.04385052 5.653071e-06
## 10 33 -0.2107631 0.04047444 1.915945e-07
## 11 36 -0.2098710 0.04011366 1.677688e-07
## 12 37 -0.1913662 0.04053983 2.353241e-06
## 13 44 -0.1930595 0.04168859 3.639200e-06
## 14 48 -0.1976258 0.04070531 1.203648e-06
## 15 58 -0.2004792 0.04366092 4.395857e-06
## 16 63 -0.2037038 0.04416051 3.972712e-06
## 17 67 -0.2070399 0.04292926 1.415464e-06
## 18 70 -0.2022706 0.04194517 1.419388e-06
## 19 71 -0.1861914 0.04101950 5.649628e-06
## 20 75 -0.1702114 0.03126920 5.226695e-08
## Cohort_merged
## 1 EPIDOS-Toulouse Cohort
## 2 HARMONY study
## 3 VITA study
## 4 PAQUID study
## 5 MDCS cohort
## 6 KIHD study
## 7 EHCs
## 8 Copenhagen Male Study
## 9 ARIC study
## 10 Cardiovascular Health Cognition Study
## 11 Whitehall II cohort study
## 12 MYHAT study
## 13 CAIDE study
## 14 Kungsholmen Project
## 15 JAGES
## 16 KNHIS
## 17 Copenhagen City Heart Study (male)
## 18 MONICA study
## 19 UK Biobank (1)
## 20 KLoSAloo_plot <- loo %>%
mutate(
ci_lb = estimate - 1.96*se,
ci_ub = estimate + 1.96*se)
# loo_plot$study <- factor(loo_plot$study,
# levels = c("28", "35", "66", "67",
# "69","71"),
# labels = c("Copenhagen Male Study",
# "CAIDE study",
# "Copenhagen City Heart Study (Male)",
# "Copenhagen City Heart Study (Female)",
# "HUNT4 70+ study",
# "UK Biobank"), ordered = T)
all_cause_leave_leisure <- ggplot(loo_plot, aes(x = exp(estimate), y = Cohort_merged)) +
geom_point() +
geom_errorbarh(aes(xmin = exp(ci_lb), xmax = exp(ci_ub)), height = 0.15) +
geom_vline(xintercept = exp(coef(model_leisure)[1]), linetype = "dashed") +
geom_vline(xintercept = 1, linetype = "solid") +
xlab("Relative risk (LOO estimate)") +
ylab("") +
theme(axis.line.x = element_line(colour = "black"),
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 16, colour = "black"),
plot.title = element_text(face = "bold"),
text = element_text(size = 16),
panel.background = element_rect(fill = "white"))
all_cause_leave_leisure
# tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/leave_out_combined_leisure.tiff", width=10, height=14, units="in", res=300, compression="lzw")
ggarrange(all_cause_full_leisure, all_cause_leave_leisure, nrow = 2)
# dev.off()
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/leave_out_combined_leisure_work_2026.tiff", width=15, height=14, units="in", res=300, compression="lzw")
ggarrange(all_cause_full, all_cause_full_leisure,
all_cause_leave, all_cause_leave_leisure,
nrow = 2,ncol = 2, labels=c("Full analysis - OPA", "Full analysis - LTPA",
"LOO analysis - OPA", "LOO analysis - LTPA"),
label.y = c(1,1,1.05,1.05)
)
dev.off()## quartz_off_screen
## 2DOSE-RESPONSE ANALYSIS
library(dosresmeta)
library(ggpubr)
library(ggsci)
library(rms)#---------------------------------------------
# 13. Dose-response analysis
#---------------------------------------------
## Load dose-response dataset
data_ds <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dose_response_3_levels", col_names = T)
data_ds$se <- (log(data_ds$urr) - log(data_ds$lrr)) / (2 * 1.96)
data_ds$logrr <- log(data_ds$rr)
data_ds$dose <- data_ds$exposure
data_ds <- data_ds %>%
subset(is.na(id)==F)
## Linear trend estimation
## Fitting the model
lin <- dosresmeta(formula = logrr ~ dose, type = type, id = id,
se = se, cases = cases, n = n, data = data_ds)
summary(lin)## Call: dosresmeta(formula = logrr ~ dose, id = id, type = type, cases = cases,
## n = n, data = data_ds, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 12.6746 (df = 1), p-value = 0.0004
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## (Intercept) -0.0002 0.0001 -3.5601 0.0004 -0.0003 -0.0001 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev
## 0.0003
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 498.2837 (df = 33), p-value = 0.0000
## I-square statistic = 93.4%
##
## 34 studies, 34 values, 1 fixed and 1 random-effects parameters
## logLik AIC BIC
## 215.1105 -426.2210 -423.2280## Non-linear (quadratic) trend
data_quad <- data_ds %>%
group_by(id) %>%
filter(n() >= 3) %>% # keep studies with 3+ exposure levels
ungroup()
quadr <- dosresmeta(formula = logrr ~ dose + I(dose^2), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(quadr)## Call: dosresmeta(formula = logrr ~ dose + I(dose^2), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 13.8578 (df = 2), p-value = 0.0010
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## dose -0.0003 0.0001 -3.6568 0.0003 -0.0005 -0.0001 ***
## I(dose^2) 0.0000 0.0000 3.1369 0.0017 0.0000 0.0000 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## dose 0.0004 dose
## I(dose^2) 0.0000 -0.9726
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 546.1150 (df = 66), p-value = 0.0000
## I-square statistic = 87.9%
##
## 34 studies, 68 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 669.5725 -1329.1449 -1318.1967## Non-linear (splines) trend
k <- quantile(data_quad$dose, c(.1, .5, .9))
spline <- dosresmeta(formula = logrr ~ rcs(dose, k), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(spline)## Call: dosresmeta(formula = logrr ~ rcs(dose, k), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 12.3293 (df = 2), p-value = 0.0021
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## rcs(dose, k)dose -0.0003 0.0001 -3.3580 0.0008 -0.0005 -0.0001
## rcs(dose, k)dose' 0.0005 0.0002 2.8935 0.0038 0.0002 0.0008
##
## rcs(dose, k)dose ***
## rcs(dose, k)dose' **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## rcs(dose, k)dose 0.0005 rcs(dose, k)dose
## rcs(dose, k)dose' 0.0008 -0.9827
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 533.0653 (df = 66), p-value = 0.0000
## I-square statistic = 87.6%
##
## 34 studies, 68 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 373.5002 -737.0004 -726.0521lrtest(lin, quadr)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ dose + I(dose^2)
##
## L.R. Chisq d.f. P
## 908.9239 2.0000 0.0000lrtest(lin, spline)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ rcs(dose, k)
##
## L.R. Chisq d.f. P
## 316.7794 2.0000 0.0000# Generating prediction grid
# Set 200 MET-min/week as reference value
xref <- 200
# Set a grid of exposure values (adjust to your scale)
pred.lin <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(lin, newdata = ., expo = T)
pred.quad <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(quadr, newdata = ., expo = T)
pred.spl <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(spline, newdata = ., expo = T)
newd <- data.frame(
dose = seq(min(data_quad$dose), max(data_quad$dose), length = 200)
)
df.lin <- data.frame(
exposure = pred.lin$dose,
pred.lin = pred.lin$pred,
ci.lb.lin = pred.lin$ci.lb,
ci.ub.lin = pred.lin$ci.ub
)
df.quad <- data.frame(
exposure = pred.quad$dose,
pred.quadr = pred.quad$pred,
ci.lb.quadr = pred.quad$ci.lb,
ci.ub.quadr = pred.quad$ci.ub
)
df.spl <- data.frame(
exposure = pred.spl$`rcs(dose, k)dose`,
pred.spl = pred.spl$pred,
ci.lb.spl = pred.spl$ci.lb,
ci.ub.spl = pred.spl$ci.ub
)
df.all <- df.lin %>%
left_join(df.spl, by = "exposure") %>%
left_join(df.quad, by = "exposure")
df.overall <- df.all %>%
arrange(exposure) %>%
distinct(exposure, .keep_all = TRUE, .fromLast = TRUE)
library(ggplot2)
colors <- c("Linear" = "purple",
"Quadratic" = "blue",
"Spline" = "darkgoldenrod4")
fill <- c("Linear" = "purple",
"Quadratic walking" = "lightblue",
"Spline" = "darkgoldenrod1")
nonlinear <- grobTree(
textGrob(
bquote(
italic(p)[nonlinearity] < 0.001 ~ "; " ~
k == .(34) ~ "; " ~
ES == .(122) ~ "; " ~
I^2 == .(87.6) * "%"
),
gp = gpar(col = "black", fontsize = 14)
)
)
overall <- ggplot(df.overall, aes(x = exposure)) +
## --- Linear CI (semi-transparent) ---
geom_ribbon(aes(ymin = ci.lb.lin, ymax = ci.ub.lin, fill = "Linear"), alpha = 0.3) +
## --- Spline CI ---
geom_ribbon(aes(ymin = ci.lb.spl, ymax = ci.ub.spl, fill = "Spline"), alpha = 0.6) +
## --- Quadratic CI ---
geom_ribbon(aes(ymin = ci.lb.quadr, ymax = ci.ub.quadr, fill = "Quadratic"), alpha = 0.25) +
## --- Linear curve (dot-dash) ---
geom_line(aes(y = pred.lin, color="Linear"), linetype = "dotdash", size = 1.0) +
## --- Spline curve (solid) ---
geom_line(aes(y = pred.spl, color="Spline"), size = 1.4) +
## --- Quadratic curve (dashed) ---
geom_line(aes(y = pred.quadr, color="Quadratic"), linetype = "dashed", size = 1.0) +
## --- Add rug for distribution ---
geom_rug(
data = data_ds, # <--- IMPORTANT: this must be your raw point-level dose–response input
aes(x = exposure),
sides = "b",
alpha = 0.6,
size = 0.6
) +
labs(
x = "MET-minutes/week",
y = "Relative Risk"
) +
theme_bw(base_size = 14) +
coord_cartesian(ylim = c(0,1.05)) +
scale_fill_bmj(name="Models") +
scale_color_bmj(name="Models")+
geom_hline(yintercept = 1, colour = "black", linetype = "solid", linewidth = 0.2)
overall <- overall +
annotation_custom(nonlinear, xmin = -1200, ymin = -0.7)
overall
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/dose_response_combining_allcause.tiff", width=14, height=10, units="in", res=300, compression="lzw")
overall
dev.off()## quartz_off_screen
## 2LEISURE ANALYSIS
data_leisure <- data_ds %>%
subset(leisure==1)
## Linear trend estimation
## Fitting the model
lin <- dosresmeta(formula = logrr ~ dose, type = type, id = id,
se = se, cases = cases, n = n, data = data_leisure)
summary(lin)## Call: dosresmeta(formula = logrr ~ dose, id = id, type = type, cases = cases,
## n = n, data = data_leisure, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 9.6336 (df = 1), p-value = 0.0019
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## (Intercept) -0.0001 0.0000 -3.1038 0.0019 -0.0002 -0.0000 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev
## 0.0001
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 26.1070 (df = 11), p-value = 0.0063
## I-square statistic = 57.9%
##
## 12 studies, 12 values, 1 fixed and 1 random-effects parameters
## logLik AIC BIC
## 81.3244 -158.6487 -157.8529## Non-linear (quadratic) trend
data_quad <- data_leisure %>%
group_by(id) %>%
filter(n() >= 3) %>% # keep studies with 3+ exposure levels
ungroup()
quadr <- dosresmeta(formula = logrr ~ dose + I(dose^2), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(quadr)## Call: dosresmeta(formula = logrr ~ dose + I(dose^2), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 25.6740 (df = 2), p-value = 0.0000
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## dose -0.0002 0.0001 -4.7019 0.0000 -0.0003 -0.0001 ***
## I(dose^2) 0.0000 0.0000 3.6490 0.0003 0.0000 0.0000 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## dose 0.0001 dose
## I(dose^2) 0.0000 -1
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 35.1262 (df = 22), p-value = 0.0376
## I-square statistic = 37.4%
##
## 12 studies, 24 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 225.1024 -440.2048 -434.7496## Non-linear (splines) trend
k <- quantile(data_quad$dose, c(1., .5, .9))
spline <- dosresmeta(formula = logrr ~ rcs(dose, k), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(spline)## Call: dosresmeta(formula = logrr ~ rcs(dose, k), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 22.2586 (df = 2), p-value = 0.0000
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## rcs(dose, k)dose -0.0002 0.0000 -4.6312 0.0000 -0.0003 -0.0001
## rcs(dose, k)dose' 0.0005 0.0001 3.5444 0.0004 0.0002 0.0008
##
## rcs(dose, k)dose ***
## rcs(dose, k)dose' ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## rcs(dose, k)dose 0.0001 rcs(dose, k)dose
## rcs(dose, k)dose' 0.0002 -1
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 37.2620 (df = 22), p-value = 0.0221
## I-square statistic = 41.0%
##
## 12 studies, 24 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 100.4637 -190.9273 -185.4721lrtest(lin, quadr)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ dose + I(dose^2)
##
## L.R. Chisq d.f. P
## 287.5561 2.0000 0.0000lrtest(lin, spline)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ rcs(dose, k)
##
## L.R. Chisq d.f. P
## 3.827860e+01 2.000000e+00 4.874247e-09# Generating prediction grid
# Set 200 MET-min/week as reference value
xref <- 200
# Set a grid of exposure values (adjust to your scale)
pred.lin <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(lin, newdata = ., expo = T)
pred.quad <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(quadr, newdata = ., expo = T)
pred.spl <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(spline, newdata = ., expo = T)
newd <- data.frame(
dose = seq(min(data_quad$dose), max(data_quad$dose), length = 200)
)
df.lin <- data.frame(
exposure = pred.lin$dose,
pred.lin = pred.lin$pred,
ci.lb.lin = pred.lin$ci.lb,
ci.ub.lin = pred.lin$ci.ub
)
df.quad <- data.frame(
exposure = pred.quad$dose,
pred.quadr = pred.quad$pred,
ci.lb.quadr = pred.quad$ci.lb,
ci.ub.quadr = pred.quad$ci.ub
)
df.spl <- data.frame(
exposure = pred.spl$`rcs(dose, k)dose`,
pred.spl = pred.spl$pred,
ci.lb.spl = pred.spl$ci.lb,
ci.ub.spl = pred.spl$ci.ub
)
df.all <- df.lin %>%
left_join(df.spl, by = "exposure") %>%
left_join(df.quad, by = "exposure")## Warning in left_join(., df.spl, by = "exposure"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 1 of `x` matches multiple rows in `y`.
## ℹ Row 1 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.## Warning in left_join(., df.quad, by = "exposure"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 1 of `x` matches multiple rows in `y`.
## ℹ Row 1 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.df.leisure <- df.all %>%
arrange(exposure) %>%
distinct(exposure, .keep_all = TRUE, .fromLast = TRUE)
library(ggplot2)
colors <- c("Linear" = "purple",
"Quadratic" = "blue",
"Spline" = "darkgoldenrod4")
fill <- c("Linear" = "purple",
"Quadratic walking" = "lightblue",
"Spline" = "darkgoldenrod1")
nonlinear <- grobTree(
textGrob(
bquote(
italic(p)[nonlinearity] < 0.001 ~ "; " ~
k == .(12)~"; " ~
ES == .(42)~"; " ~
I^2 == .(57.9) * "%"
),
gp = gpar(col = "black", fontsize = 12)
)
)
leisure <- ggplot(df.leisure, aes(x = exposure)) +
# --- Linear CI (semi-transparent) ---
geom_ribbon(aes(ymin = ci.lb.lin, ymax = ci.ub.lin, fill = "Linear"), alpha = 0.3) +
# --- Spline CI ---
geom_ribbon(aes(ymin = ci.lb.spl, ymax = ci.ub.spl, fill = "Spline"), alpha = 0.6) +
# --- Quadratic CI ---
geom_ribbon(aes(ymin = ci.lb.quadr, ymax = ci.ub.quadr, fill = "Quadratic"), alpha = 0.25) +
# --- Linear curve (dot-dash) ---
geom_line(aes(y = pred.lin, color="Linear"), linetype = "dotdash", size = 1.0) +
# --- Spline curve (solid) ---
geom_line(aes(y = pred.spl, color="Spline"), size = 1.4) +
# --- Quadratic curve (dashed) ---
geom_line(aes(y = pred.quadr, color="Quadratic"), linetype = "dashed", size = 1.0) +
## --- Add rug for distribution ---
geom_rug(
data = data_leisure, # <--- IMPORTANT: this must be your raw point-level dose–response input
aes(x = exposure),
sides = "b",
alpha = 0.6,
size = 0.6
) +
labs(
x = "MET*minutes/week",
y = "Relative Risk",
) +
theme_bw(base_size = 14) +
coord_cartesian(ylim = c(0.15,1.4)) +
scale_fill_bmj(name="Models") +
scale_color_bmj(name="Models")+
geom_hline(yintercept = 1, colour = "black", linetype = "solid", linewidth = 0.2)
leisure <- leisure +
annotation_custom(nonlinear, xmin = -1500, ymin = -0.7)
leisure
WORK ANALYSIS
data_work <- data_ds %>%
subset(work==1)
## Linear trend estimation
## Fitting the model
lin <- dosresmeta(formula = logrr ~ dose, type = type, id = id,
se = se, cases = cases, n = n, data = data_work, intercept = F, center = T )
summary(lin)## Call: dosresmeta(formula = logrr ~ dose, id = id, type = type, cases = cases,
## n = n, data = data_work, intercept = F, center = T, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 2.5484 (df = 1), p-value = 0.1104
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## (Intercept) 0.0000 0.0000 1.5964 0.1104 -0.0000 0.0001
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev
## 0.0001
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 40.0865 (df = 4), p-value = 0.0000
## I-square statistic = 90.0%
##
## 5 studies, 5 values, 1 fixed and 1 random-effects parameters
## logLik AIC BIC
## 33.3864 -62.7727 -64.0001## Non-linear (quadratic) trend
data_quad <- data_work %>%
group_by(id) %>%
filter(n() >= 3) %>% # keep studies with 3+ exposure levels
ungroup()
quadr <- dosresmeta(formula = logrr ~ dose + I(dose^2), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(quadr)## Call: dosresmeta(formula = logrr ~ dose + I(dose^2), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 4.6675 (df = 2), p-value = 0.0969
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## dose 0.0001 0.0001 2.1024 0.0355 0.0000 0.0002 *
## I(dose^2) -0.0000 0.0000 -1.6686 0.0952 -0.0000 0.0000 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## dose 0.0001 dose
## I(dose^2) 0.0000 -0.8941
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 36.9056 (df = 8), p-value = 0.0000
## I-square statistic = 78.3%
##
## 5 studies, 10 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 98.8697 -187.7395 -187.3423lrtest(lin, quadr)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ dose + I(dose^2)
##
## L.R. Chisq d.f. P
## 130.9668 2.0000 0.0000## Non-linear (splines) trend
# spline <- dosresmeta(formula = logrr ~ rcs(dose,3), type = type, id = id,
# se = se, cases = cases, n = n, data = data_quad)
#Because work-related PA data included only four studies
# with few unique exposure categories, restricted cubic spline
# models could not be estimated; therefore,
# only linear and quadratic dose–response functions were fitted.
# Generating prediction grid
# Set 200 MET-min/week as reference value
xref <- 200
# Set a grid of exposure values (adjust to your scale)
pred.lin <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(lin, newdata = ., expo = T)
pred.quad <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(quadr, newdata = ., expo = T)
newd <- data.frame(
dose = seq(min(data_quad$dose), max(data_quad$dose), length = 200)
)
df.lin <- data.frame(
exposure = pred.lin$dose,
pred.lin = pred.lin$pred,
ci.lb.lin = pred.lin$ci.lb,
ci.ub.lin = pred.lin$ci.ub
)
df.quad <- data.frame(
exposure = pred.quad$dose,
pred.quadr = pred.quad$pred,
ci.lb.quadr = pred.quad$ci.lb,
ci.ub.quadr = pred.quad$ci.ub
)
df.all <- df.lin %>%
left_join(df.quad, by = "exposure")## Warning in left_join(., df.quad, by = "exposure"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 1 of `x` matches multiple rows in `y`.
## ℹ Row 1 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.df.work <- df.all %>%
arrange(exposure) %>%
distinct(exposure, .keep_all = TRUE, .fromLast = TRUE)
library(ggplot2)
colors <- c("Linear" = "purple",
"Quadratic" = "blue",
"Spline" = "darkgoldenrod4")
fill <- c("Linear" = "purple",
"Quadratic walking" = "lightblue",
"Spline" = "darkgoldenrod1")
nonlinear <- grobTree(
textGrob(
bquote(
italic(p)[nonlinearity] < 0.001 ~ "; " ~
k == .(5) ~ "; " ~
ES == .(17)~"; " ~
I^2 == .(90.0) * "%"
),
gp = gpar(col = "black", fontsize = 12)
)
)
work <- ggplot(df.all, aes(x = exposure)) +
# --- Linear CI (semi-transparent) ---
geom_ribbon(aes(ymin = ci.lb.lin, ymax = ci.ub.lin, fill = "Linear"), alpha = 0.3) +
# --- Quadratic CI ---
geom_ribbon(aes(ymin = ci.lb.quadr, ymax = ci.ub.quadr, fill = "Quadratic"), alpha = 0.25) +
# --- Linear curve (dot-dash) ---
geom_line(aes(y = pred.lin, color="Linear"), linetype = "dotdash", size = 1.0) +
# --- Quadratic curve (dashed) ---
geom_line(aes(y = pred.quadr, color="Quadratic"), linetype = "dashed", size = 1.0) +
## --- Add rug for distribution ---
geom_rug(
data = data_work, # <--- IMPORTANT: this must be your raw point-level dose–response input
aes(x = exposure),
sides = "b",
alpha = 0.6,
size = 0.6
) +
labs(
x = "MET*minutes/week",
y = "Relative Risk",
) +
theme_bw(base_size = 14) +
coord_cartesian(ylim = c(0.7,1.55)) +
scale_fill_bmj(name="Models") +
scale_color_bmj(name="Models")+
geom_hline(yintercept = 1, colour = "black", linetype = "solid", linewidth = 0.2)
work <- work +
annotation_custom(nonlinear, xmin = -1600, ymin = 0.15)
work
COMBINING DOSE CURVES
## quartz_off_screen
## 2DOSE-RESPONSE ANALYSIS - ALZHEIMER’S DISEASE
#---------------------------------------------
# 13. Dose-response analysis
#---------------------------------------------
## Load dose-response dataset
data_ds <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dose-response_AD_3OrMoreGroups", col_names = T)
data_ds$se <- (log(data_ds$urr) - log(data_ds$lrr)) / (2 * 1.96)
data_ds$logrr <- log(data_ds$rr)
data_ds$dose <- data_ds$exposure
data_ds <- data_ds %>%
subset(is.na(id)==F)
## Linear trend estimation
## Fitting the model
lin <- dosresmeta(formula = logrr ~ dose, type = type, id = id,
se = se, cases = cases, n = n, data = data_ds)
summary(lin)## Call: dosresmeta(formula = logrr ~ dose, id = id, type = type, cases = cases,
## n = n, data = data_ds, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 4.5806 (df = 1), p-value = 0.0323
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## (Intercept) -0.0002 0.0001 -2.1402 0.0323 -0.0003 -0.0000 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev
## 0.0003
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 70.5860 (df = 14), p-value = 0.0000
## I-square statistic = 80.2%
##
## 15 studies, 15 values, 1 fixed and 1 random-effects parameters
## logLik AIC BIC
## 91.9269 -179.8539 -178.5757## Non-linear (quadratic) trend
data_quad <- data_ds %>%
group_by(id) %>%
filter(n() >= 3) %>% # keep studies with 3+ exposure levels
ungroup()
quadr <- dosresmeta(formula = logrr ~ dose + I(dose^2), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(quadr)## Call: dosresmeta(formula = logrr ~ dose + I(dose^2), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 5.3530 (df = 2), p-value = 0.0688
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## dose -0.0003 0.0001 -2.3098 0.0209 -0.0005 -0.0000 *
## I(dose^2) 0.0000 0.0000 2.2871 0.0222 0.0000 0.0000 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## dose 0.0004 dose
## I(dose^2) 0.0000 -1
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 87.9230 (df = 28), p-value = 0.0000
## I-square statistic = 68.2%
##
## 15 studies, 30 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 290.6048 -571.2095 -564.5485## Non-linear (splines) trend
k <- quantile(data_quad$dose, c(.1, .5, .9))
spline <- dosresmeta(formula = logrr ~ rcs(dose, k), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(spline)## Call: dosresmeta(formula = logrr ~ rcs(dose, k), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 4.7130 (df = 2), p-value = 0.0948
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## rcs(dose, k)dose -0.0003 0.0001 -2.1709 0.0299 -0.0005 -0.0000
## rcs(dose, k)dose' 0.0006 0.0003 2.1606 0.0307 0.0001 0.0012
##
## rcs(dose, k)dose *
## rcs(dose, k)dose' *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## rcs(dose, k)dose 0.0004 rcs(dose, k)dose
## rcs(dose, k)dose' 0.0010 -1
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 80.4249 (df = 28), p-value = 0.0000
## I-square statistic = 65.2%
##
## 15 studies, 30 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 157.0965 -304.1930 -297.5320lrtest(lin, quadr)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ dose + I(dose^2)
##
## L.R. Chisq d.f. P
## 397.3557 2.0000 0.0000lrtest(lin, spline)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ rcs(dose, k)
##
## L.R. Chisq d.f. P
## 130.3392 2.0000 0.0000# lrtest(quadr, spline)
# Generating prediction grid
# Set 200 MET-min/week as reference value
xref <- 200
# Set a grid of exposure values (adjust to your scale)
pred.lin <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(lin, newdata = ., expo = T)
pred.quad <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(quadr, newdata = ., expo = T)
pred.spl <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(spline, newdata = ., expo = T)
newd <- data.frame(
dose = seq(min(data_quad$dose), max(data_quad$dose), length = 200)
)
df.lin <- data.frame(
exposure = pred.lin$dose,
pred.lin = pred.lin$pred,
ci.lb.lin = pred.lin$ci.lb,
ci.ub.lin = pred.lin$ci.ub
)
df.quad <- data.frame(
exposure = pred.quad$dose,
pred.quadr = pred.quad$pred,
ci.lb.quadr = pred.quad$ci.lb,
ci.ub.quadr = pred.quad$ci.ub
)
df.spl <- data.frame(
exposure = pred.spl$`rcs(dose, k)dose`,
pred.spl = pred.spl$pred,
ci.lb.spl = pred.spl$ci.lb,
ci.ub.spl = pred.spl$ci.ub
)
df.all <- df.lin %>%
left_join(df.spl, by = "exposure") %>%
left_join(df.quad, by = "exposure")
df.overall <- df.all %>%
arrange(exposure) %>%
distinct(exposure, .keep_all = TRUE, .fromLast = TRUE)
library(ggplot2)
colors <- c("Linear" = "purple",
"Quadratic" = "blue",
"Spline" = "darkgoldenrod4")
fill <- c("Linear" = "purple",
"Quadratic walking" = "lightblue",
"Spline" = "darkgoldenrod1")
nonlinear <- grobTree(
textGrob(
bquote(
italic(p)[nonlinearity] < 0.001 ~ "; " ~
k == .(15) ~ "; " ~
ES == .(52) ~ "; " ~
I^2 == .(65.2) * "%"
),
gp = gpar(col = "black", fontsize = 12)
)
)
overall_alz <- ggplot(df.overall, aes(x = exposure)) +
## --- Linear CI (semi-transparent) ---
geom_ribbon(aes(ymin = ci.lb.lin, ymax = ci.ub.lin, fill = "Linear"), alpha = 0.3) +
## --- Spline CI ---
geom_ribbon(aes(ymin = ci.lb.spl, ymax = ci.ub.spl, fill = "Spline"), alpha = 0.6) +
## --- Quadratic CI ---
geom_ribbon(aes(ymin = ci.lb.quadr, ymax = ci.ub.quadr, fill = "Quadratic"), alpha = 0.25) +
## --- Linear curve (dot-dash) ---
geom_line(aes(y = pred.lin, color="Linear"), linetype = "dotdash", size = 1.0) +
## --- Spline curve (solid) ---
geom_line(aes(y = pred.spl, color="Spline"), size = 1.4) +
## --- Quadratic curve (dashed) ---
geom_line(aes(y = pred.quadr, color="Quadratic"), linetype = "dashed", size = 1.0) +
## --- Add rug for distribution ---
geom_rug(
data = data_ds, # <--- IMPORTANT: this must be your raw point-level dose–response input
aes(x = exposure),
sides = "b",
alpha = 0.6,
size = 0.6
) +
labs(
x = "MET-minutes/week",
y = "Relative Risk"
) +
theme_bw(base_size = 14) +
coord_cartesian(ylim = c(0,1.05)) +
scale_fill_bmj(name="Models") +
scale_color_bmj(name="Models") +
geom_hline(yintercept = 1, colour = "black", linetype = "solid")
overall_alz <- overall_alz +
annotation_custom(nonlinear, xmin = -1300, ymin = -0.8)
overall_alz
DOSE-RESPONSE ANALYSIS - VASCULAR DEMENTIA
library(dosresmeta)
library(ggpubr)
library(ggsci)
library(rms)#---------------------------------------------
# 13. Dose-response analysis
#---------------------------------------------
## Load dose-response dataset
data_ds <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dose-response_VD_3OrMoreGroups", col_names = T)
data_ds$se <- (log(data_ds$urr) - log(data_ds$lrr)) / (2 * 1.96)
data_ds$logrr <- log(data_ds$rr)
data_ds$dose <- data_ds$exposure
data_ds <- data_ds %>%
subset(is.na(id)==F)
## Linear trend estimation
## Fitting the model
lin <- dosresmeta(formula = logrr ~ dose, type = type, id = id,
se = se, cases = cases, n = n, data = data_ds)
summary(lin)## Call: dosresmeta(formula = logrr ~ dose, id = id, type = type, cases = cases,
## n = n, data = data_ds, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 21.3637 (df = 1), p-value = 0.0000
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## (Intercept) -0.0001 0.0000 -4.6221 0.0000 -0.0001 -0.0000 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev
## 0.0000
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 20.2829 (df = 8), p-value = 0.0093
## I-square statistic = 60.6%
##
## 9 studies, 9 values, 1 fixed and 1 random-effects parameters
## logLik AIC BIC
## 55.8288 -107.6577 -107.4988## Non-linear (quadratic) trend
data_quad <- data_ds %>%
group_by(id) %>%
filter(n() >= 3) %>% # keep studies with 3+ exposure levels
ungroup()
quadr <- dosresmeta(formula = logrr ~ dose + I(dose^2), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(quadr)## Call: dosresmeta(formula = logrr ~ dose + I(dose^2), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 20.0645 (df = 2), p-value = 0.0000
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## dose -0.0003 0.0001 -2.3921 0.0168 -0.0005 -0.0000 *
## I(dose^2) 0.0000 0.0000 1.8031 0.0714 -0.0000 0.0000 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## dose 0.0002 dose
## I(dose^2) 0.0000 -1
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 22.6338 (df = 16), p-value = 0.1239
## I-square statistic = 29.3%
##
## 9 studies, 18 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 169.3024 -328.6048 -324.7418## Non-linear (splines) trend
k <- quantile(data_quad$dose, c(.1, .5, .9))
spline <- dosresmeta(formula = logrr ~ rcs(dose, k), type = type, id = id,
se = se, cases = cases, n = n, data = data_quad)
summary(spline)## Call: dosresmeta(formula = logrr ~ rcs(dose, k), id = id, type = type,
## cases = cases, n = n, data = data_quad, se = se)
##
## Two-stage random-effects meta-analysis
## Estimation method: REML
## Covariance approximation: Greenland & Longnecker
##
## Chi2 model: X2 = 19.2980 (df = 2), p-value = 0.0001
##
## Fixed-effects coefficients
## Estimate Std. Error z Pr(>|z|) 95%ci.lb 95%ci.ub
## rcs(dose, k)dose -0.0003 0.0001 -2.5056 0.0122 -0.0005 -0.0001
## rcs(dose, k)dose' 0.0004 0.0002 1.9607 0.0499 0.0000 0.0008
##
## rcs(dose, k)dose *
## rcs(dose, k)dose' *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Between-study random-effects (co)variance components
## Std. Dev Corr
## rcs(dose, k)dose 0.0002 rcs(dose, k)dose
## rcs(dose, k)dose' 0.0004 -1
##
## Univariate Cochran Q-test for residual heterogeneity:
## Q = 22.8446 (df = 16), p-value = 0.1180
## I-square statistic = 30.0%
##
## 9 studies, 18 values, 2 fixed and 3 random-effects parameters
## logLik AIC BIC
## 97.1549 -184.3099 -180.4469lrtest(lin, quadr)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ dose + I(dose^2)
##
## L.R. Chisq d.f. P
## 226.9471 2.0000 0.0000lrtest(lin, spline)##
## Model 1: logrr ~ dose
## Model 2: logrr ~ rcs(dose, k)
##
## L.R. Chisq d.f. P
## 82.6522 2.0000 0.0000# lrtest(quadr, spline)
# Generating prediction grid
# Set 200 MET-min/week as reference value
xref <- 200
# Set a grid of exposure values (adjust to your scale)
pred.lin <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(lin, newdata = ., expo = T)
pred.quad <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(quadr, newdata = ., expo = T)
pred.spl <- data.frame(dose = c(xref, seq(0, 5000, 100))) %>%
predict(spline, newdata = ., expo = T)
newd <- data.frame(
dose = seq(min(data_quad$dose), max(data_quad$dose), length = 200)
)
df.lin <- data.frame(
exposure = pred.lin$dose,
pred.lin = pred.lin$pred,
ci.lb.lin = pred.lin$ci.lb,
ci.ub.lin = pred.lin$ci.ub
)
df.quad <- data.frame(
exposure = pred.quad$dose,
pred.quadr = pred.quad$pred,
ci.lb.quadr = pred.quad$ci.lb,
ci.ub.quadr = pred.quad$ci.ub
)
df.spl <- data.frame(
exposure = pred.spl$`rcs(dose, k)dose`,
pred.spl = pred.spl$pred,
ci.lb.spl = pred.spl$ci.lb,
ci.ub.spl = pred.spl$ci.ub
)
df.all <- df.lin %>%
left_join(df.spl, by = "exposure") %>%
left_join(df.quad, by = "exposure")
df.overall <- df.all %>%
arrange(exposure) %>%
distinct(exposure, .keep_all = TRUE, .fromLast = TRUE)
library(ggplot2)
colors <- c("Linear" = "purple",
"Quadratic" = "blue",
"Spline" = "darkgoldenrod4")
fill <- c("Linear" = "purple",
"Quadratic walking" = "lightblue",
"Spline" = "darkgoldenrod1")
nonlinear <- grobTree(
textGrob(
bquote(
italic(p)[nonlinearity] < 0.001 ~ "; " ~
k == .(9) ~ "; " ~
ES == .(32) ~ "; " ~
I^2 == .(40.3) * "%"
),
gp = gpar(col = "black", fontsize = 12)
)
)
overall_vascular <- ggplot(df.overall, aes(x = exposure)) +
## --- Linear CI (semi-transparent) ---
geom_ribbon(aes(ymin = ci.lb.lin, ymax = ci.ub.lin, fill = "Linear"), alpha = 0.3) +
## --- Spline CI ---
geom_ribbon(aes(ymin = ci.lb.spl, ymax = ci.ub.spl, fill = "Spline"), alpha = 0.6) +
## --- Quadratic CI ---
geom_ribbon(aes(ymin = ci.lb.quadr, ymax = ci.ub.quadr, fill = "Quadratic"), alpha = 0.25) +
## --- Linear curve (dot-dash) ---
geom_line(aes(y = pred.lin, color="Linear"), linetype = "dotdash", size = 1.0) +
## --- Spline curve (solid) ---
geom_line(aes(y = pred.spl, color="Spline"), size = 1.4) +
## --- Quadratic curve (dashed) ---
geom_line(aes(y = pred.quadr, color="Quadratic"), linetype = "dashed", size = 1.0) +
## --- Add rug for distribution ---
geom_rug(
data = data_ds, # <--- IMPORTANT: this must be your raw point-level dose–response input
aes(x = exposure),
sides = "b",
alpha = 0.6,
size = 0.6
) +
labs(
x = "MET-minutes/week",
y = "Relative Risk"
) +
theme_bw(base_size = 14) +
coord_cartesian(ylim = c(0,1.05)) +
scale_fill_bmj(name="Models") +
scale_color_bmj(name="Models") +
geom_hline(yintercept = 1, colour = "black", linetype = "solid")
overall_vascular <- overall_vascular +
annotation_custom(nonlinear, xmin = -1300, ymin = -0.8)
overall_vascular
COMBINING DOSE CURVES - ALZHEIMER’S DISEASE AND VASCULAR DEMENTIA
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/dose_response_combining_vascular_alz.tiff", width=10, height=10, units="in", res=300, compression="lzw")## Warning in tiff("~/Desktop/Projetos/Domain-specific PA -
## meta-analysis/Meta-analysis/Analysis/dose_response_combining_vascular_alz.tiff",
## : compression is not supported for type = "quartz"ggarrange(overall_alz, overall_vascular, common.legend = T, nrow = 2, legend = "right",
labels = c("Alzheimer's disease", "Vascular dementia"), label.y = 1.05, label.x = c(0.029, 0)) +
theme(plot.margin = margin(0.75, 0.5, 0.5, 0.5, "cm"))
dev.off()## quartz_off_screen
## 2SENSITIVITY ANALYSIS
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)## New names:
## • `Dementia` -> `Dementia...12`
## • `` -> `...65`
## • `Dementia` -> `Dementia...66`data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$age_group <- factor(data$`Baseline age group (1=30-50 years, 2=50-65 years, 3=65-80 years, 4= 80+ years)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
meta_model_4level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.2887 80.5773 86.5773 95.8216 86.7302
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0737 0.2715 76 no ID
## sigma^2.2 0.0211 0.1453 162 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 161) = 1565.0918, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2423 0.0378 -6.4159 <.0001 -0.3163 -0.1683 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(meta_model_4level)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.2887 80.5773 88.5773 100.9030 88.8338
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 69 no Cohort
## sigma^2.2 0.0737 0.2715 76 no Cohort/ID
## sigma^2.3 0.0211 0.1453 162 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 161) = 1565.0918, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2423 0.0378 -6.4159 <.0001 -0.3163 -0.1683 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova.rma(meta_model_3level, meta_model_4level)##
## df AIC BIC AICc logLik LRT pval QE
## Full 4 88.5773 100.9030 88.8338 -40.2887 1565.0918
## Reduced 3 86.5773 95.8216 86.7302 -40.2887 0.0000 1.0000 1565.0918# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level$b, meta_model_4level$ci.lb, meta_model_4level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7848340 0.7288432 0.8451262#---------------------------------------------
# 5. Forest plot
#---------------------------------------------
data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
metafor::forest(meta_model_4level,
slab = data$Publication,
xlab = "Relative Risk (RR)",
atransf = exp,
at = log(c(0.25, 1, 2.5)),
header = "Study",
order = "obs",
cex = 0.5,
ilab = data$Domain, # <<< NEW COLUMN
ilab.xpos = -1.7 # <<< FINE-TUNE POSITION
)
# add column title
text(-1.7, max(meta_model$k)+31, "PA Domain", cex = 0.6, font = 2)
# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level$b, meta_model_4level$ci.lb, meta_model_4level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7848340 0.7288432 0.8451262# Moderation
meta_model_4level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| Cohort/ID/Ind_ID,
method = "REML",
mods = ~ Domain)
summary(meta_model_4level)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -34.5478 69.0957 85.0957 109.5456 86.0686
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0003 0.0161 69 no Cohort
## sigma^2.2 0.0624 0.2498 76 no Cohort/ID
## sigma^2.3 0.0195 0.1395 162 no Cohort/ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 157) = 1390.5776, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 15.8711, p-val = 0.0032
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2231 0.1241 -1.7986 0.0721 -0.4663 0.0200 .
## DomainLTPA -0.0359 0.1246 -0.2884 0.7731 -0.2802 0.2083
## DomainNon-specific -0.0392 0.1251 -0.3138 0.7536 -0.2844 0.2059
## DomainOPA 0.2248 0.1303 1.7252 0.0845 -0.0306 0.4801 .
## DomainTPA 0.2735 0.1408 1.9422 0.0521 -0.0025 0.5494 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_leisure <- data %>%
subset(leisure==1)
meta_model_4level_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
summary(meta_model_4level_leisure)##
## Multivariate Meta-Analysis Model (k = 42; method: REML)
##
## logLik Deviance AIC BIC AICc
## 7.0500 -14.1001 -6.1001 0.7542 -4.9889
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0102 0.1008 20 no Cohort
## sigma^2.2 0.0102 0.1008 20 no Cohort/ID
## sigma^2.3 0.0040 0.0633 42 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 41) = 139.3871, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1988 0.0402 -4.9517 <.0001 -0.2775 -0.1201 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level_leisure$b, meta_model_4level_leisure$ci.lb, meta_model_4level_leisure$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8196816 0.7576433 0.8867997data_work <- data %>%
subset(work_pa==1)
meta_model_4level_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
summary(meta_model_4level_work)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 8.3760 10.3156 14.0903
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0085 0.0922 5 no Cohort
## sigma^2.2 0.0085 0.0922 5 no Cohort/ID
## sigma^2.3 0.0308 0.1754 13 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level_work$b, meta_model_4level_work$ci.lb, meta_model_4level_work$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.196800 1.005628 1.424315library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Alzheimer_disease_studies", col_names = T)## New names:
## • `` -> `...8`data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
meta_model_4level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.3737 78.7474 84.7474 91.3163 85.1345
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0745 0.2730 30 no ID
## sigma^2.2 0.0649 0.2547 67 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 66) = 441.3006, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2606 0.0697 -3.7388 0.0002 -0.3972 -0.1240 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(meta_model_4level)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.3737 78.7474 86.7474 95.5060 87.4031
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 28 no Cohort
## sigma^2.2 0.0745 0.2730 30 no Cohort/ID
## sigma^2.3 0.0649 0.2547 67 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 66) = 441.3006, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2606 0.0697 -3.7388 0.0002 -0.3972 -0.1240 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova.rma(meta_model_3level, meta_model_4level)##
## df AIC BIC AICc logLik LRT pval QE
## Full 4 86.7474 95.5060 87.4031 -39.3737 441.3006
## Reduced 3 84.7474 91.3163 85.1345 -39.3737 0.0000 1.0000 441.3006# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level$b, meta_model_4level$ci.lb, meta_model_4level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7705857 0.6721862 0.8833895#---------------------------------------------
# 5. Forest plot
#---------------------------------------------
data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
metafor::forest(meta_model_4level,
slab = data$Publication,
xlab = "Relative Risk (RR)",
atransf = exp,
at = log(c(0.25, 1, 2.5)),
header = "Study",
order = "obs",
cex = 0.9,
ilab = data$Domain, # <<< NEW COLUMN
ilab.xpos = -1.7 # <<< FINE-TUNE POSITION
)
# add column title
text(-1.7, max(meta_model$k)+31, "PA Domain", cex = 0.6, font = 2)
# Moderation
meta_model_4level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| Cohort/ID/Ind_ID,
method = "REML",
mods = ~ Domain)
summary(meta_model_4level)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -35.2852 70.5704 86.5704 103.5875 89.2874
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 28 no Cohort
## sigma^2.2 0.0608 0.2465 30 no Cohort/ID
## sigma^2.3 0.0675 0.2598 67 no Cohort/ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 62) = 388.8464, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 8.8101, p-val = 0.0660
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2606 0.2339 -1.1142 0.2652 -0.7190 0.1978
## DomainLTPA 0.0561 0.2233 0.2514 0.8015 -0.3816 0.4938
## DomainNon-specific -0.0821 0.2489 -0.3297 0.7416 -0.5698 0.4057
## DomainOPA 0.3700 0.2635 1.4043 0.1602 -0.1464 0.8863
## DomainTPA 0.4512 0.2532 1.7818 0.0748 -0.0451 0.9474 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_leisure <- data %>%
subset(`Only leisure PA (1= yes, 0=no)`==1)
meta_model_4level_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
summary(meta_model_4level_leisure)##
## Multivariate Meta-Analysis Model (k = 19; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.1527 10.3053 18.3053 21.8668 21.3823
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0364 0.1909 8 no Cohort
## sigma^2.2 0.0364 0.1909 8 no Cohort/ID
## sigma^2.3 0.0447 0.2113 19 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 18) = 133.2295, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2322 0.1149 -2.0204 0.0433 -0.4575 -0.0069 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level_leisure$b, meta_model_4level_leisure$ci.lb, meta_model_4level_leisure$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7927566 0.6328410 0.9930820data_work <- data %>%
subset(work_pa==1)
meta_model_4level_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
summary(meta_model_4level_work)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0435 -2.0871 5.9129 0.6855 45.9129
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0167 0.1293 2 no Cohort
## sigma^2.2 0.0167 0.1293 2 no Cohort/ID
## sigma^2.3 0.0000 0.0000 3 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 1.3244, p-val = 0.5157
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1542 0.1781 0.8658 0.3866 -0.1949 0.5034
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level_work$b, meta_model_4level_work$ci.lb, meta_model_4level_work$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.1667730 0.8229068 1.6543296library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Vascular dementia studies", col_names = T)## New names:
## • `` -> `...61`data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
meta_model_4level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.9632 13.9263 19.9263 23.8138 20.9698
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0852 0.2918 11 no ID
## sigma^2.2 0.0118 0.1087 28 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 27) = 76.3124, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4045 0.1078 -3.7519 0.0002 -0.6159 -0.1932 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(meta_model_4level)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.9632 13.9263 21.9263 27.1097 23.7445
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 10 no Cohort
## sigma^2.2 0.0852 0.2918 11 no Cohort/ID
## sigma^2.3 0.0118 0.1087 28 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 27) = 76.3124, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4045 0.1078 -3.7519 0.0002 -0.6159 -0.1932 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova.rma(meta_model_3level, meta_model_4level)##
## df AIC BIC AICc logLik LRT pval QE
## Full 4 21.9263 27.1097 23.7445 -6.9632 76.3124
## Reduced 3 19.9263 23.8138 20.9698 -6.9632 0.0000 1.0000 76.3124# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level$b, meta_model_4level$ci.lb, meta_model_4level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6672791 0.5401648 0.8243065#---------------------------------------------
# 5. Forest plot
#---------------------------------------------
data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
metafor::forest(meta_model_4level,
slab = data$Publication,
xlab = "Relative Risk (RR)",
atransf = exp,
at = log(c(0.25, 1, 2.5)),
header = "Study",
order = "obs",
cex = 0.9,
ilab = data$Domain, # <<< NEW COLUMN
ilab.xpos = -1.7 # <<< FINE-TUNE POSITION
)
# add column title
text(-1.7, max(meta_model$k)+31, "PA Domain", cex = 0.6, font = 2)
# Moderation
meta_model_4level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| Cohort/ID/Ind_ID,
method = "REML",
mods = ~ Domain)
summary(meta_model_4level)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -3.2086 6.4172 22.4172 31.5012 32.7029
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0154 0.1242 10 no Cohort
## sigma^2.2 0.0000 0.0000 11 no Cohort/ID
## sigma^2.3 0.0084 0.0918 28 no Cohort/ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 23) = 35.3789, p-val = 0.0477
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 23.4649, p-val = 0.0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.0458 0.1342 -0.3413 0.7328 -0.3088 0.2172
## DomainLTPA -0.1397 0.1312 -1.0650 0.2869 -0.3969 0.1174
## DomainNon-specific -0.5883 0.1615 -3.6416 0.0003 -0.9049 -0.2717 ***
## DomainOPA 0.1115 0.1387 0.8039 0.4215 -0.1603 0.3833
## DomainTPA 0.1216 0.1459 0.8329 0.4049 -0.1645 0.4076
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_leisure <- data %>%
subset(leisure==1)
meta_model_4level_leisure <- rma.mv(yi = logRR,
V = var,
data = data_leisure,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")
summary(meta_model_4level_leisure)##
## Multivariate Meta-Analysis Model (k = 10; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.1022 -2.2045 5.7955 6.5844 15.7955
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0045 0.0671 4 no Cohort
## sigma^2.2 0.0045 0.0671 4 no Cohort/ID
## sigma^2.3 0.0077 0.0878 10 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 9) = 13.7534, p-val = 0.1314
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2175 0.0754 -2.8833 0.0039 -0.3653 -0.0696 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level_leisure$b, meta_model_4level_leisure$ci.lb, meta_model_4level_leisure$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8045429 0.6939756 0.9327262data_work <- data %>%
subset(work_pa==1)
meta_model_4level_work <- rma.mv(yi = logRR,
V = var,
data = data_work,
random = ~1| Cohort/ID/Ind_ID,
method = "REML")## Warning: Single-level factor(s) found in 'random' argument. Corresponding
## 'sigma2' value(s) fixed to 0.summary(meta_model_4level_work)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.2285 -0.4570 3.5430 -0.4570 15.5430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes Cohort
## sigma^2.2 0.0000 0.0000 1 yes Cohort/ID
## sigma^2.3 0.0267 0.1635 2 no Cohort/ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 3.5898, p-val = 0.0581
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0506 0.1361 -0.3718 0.7101 -0.3175 0.2162
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_4level_work$b, meta_model_4level_work$ci.lb, meta_model_4level_work$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9506435 0.7279947 1.2413868Sensitivity - Pooled analysis
## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data <- data %>%
subset(is.na(Ind_ID)==F)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
## Meta-analysis - UK Biobank, KNHIS, JAGES
# Including pooled estimated from UK Biobank, JAGES, KNHIS
library(meta)
library(dplyr)
library(tibble)
get_pooled_RR <- function(meta_model) {
pooled_rr <- exp(meta_model$TE.random)
pooled_low <- exp(meta_model$lower.random)
pooled_up <- exp(meta_model$upper.random)
tibble(
pooled_rr = pooled_rr,
pooled_low = pooled_low,
pooled_up = pooled_up
)
}
# UKB
data_ukb <- data %>% filter(UKB == 1)
meta_model_ukb <- metagen(TE = logRR, seTE = SE, data = data_ukb, method.tau = "REML")
# KNHIS
data_KNHIS <- data %>% filter(KNHIS == 1)
meta_model_KNHIS <- metagen(TE = logRR, seTE = SE, data = data_KNHIS, method.tau = "REML")
# JAGES
data_JAGES <- data %>% filter(JAGES == 1)
meta_model_JAGES <- metagen(TE = logRR, seTE = SE, data = data_JAGES, method.tau = "REML")
pooled_ukb <- get_pooled_RR(meta_model_ukb)
pooled_knhis <- get_pooled_RR(meta_model_KNHIS)
pooled_jages <- get_pooled_RR(meta_model_JAGES)
data_final <- data %>%
mutate(
RR = case_when(
!is.na(RR) ~ RR, # mantém valores individuais se já existirem
UKB == 1 ~ pooled_ukb$pooled_rr,
KNHIS == 1 ~ pooled_knhis$pooled_rr,
JAGES == 1 ~ pooled_jages$pooled_rr,
TRUE ~ NA_real_
),
`RR lower limit (95%)` = case_when(
!is.na(`RR lower limit (95%)`) ~ `RR lower limit (95%)`,
UKB == 1 ~ pooled_ukb$pooled_low,
KNHIS == 1 ~ pooled_knhis$pooled_low,
JAGES == 1 ~ pooled_jages$pooled_low,
TRUE ~ NA_real_
),
`RR Upper Limit (95%)` = case_when(
!is.na(`RR Upper Limit (95%)`) ~ `RR Upper Limit (95%)`,
UKB == 1 ~ pooled_ukb$pooled_up,
KNHIS == 1 ~ pooled_knhis$pooled_up,
JAGES == 1 ~ pooled_jages$pooled_up,
TRUE ~ NA_real_
)
)
data_final$SE[is.na(data_final$SE)==T] = (log(data_final$`RR Upper Limit (95%)`) - log(data_final$`RR lower limit (95%)`)) / (2 * 1.96)ALL-CAUSE DEMENTIA
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
# Only pooled estimates from UK Biobank, JAGES, and KNHIS
data_pooled <- data_final %>%
subset((Publication=="UK Biobank" | UKB==0) & (Publication=="JAGES" | JAGES==0) & (Publication=="KNHIS" | KNHIS==0)
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_pooled,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 133; method: REML)
##
## logLik Deviance AIC BIC AICc
## -32.6131 65.2262 71.2262 79.8746 71.4137
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0652 0.2554 67 no ID
## sigma^2.2 0.0127 0.1128 133 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 132) = 712.0037, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2395 0.0381 -6.2916 <.0001 -0.3141 -0.1649 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7870240 0.7304422 0.8479889meta_model <- rma.mv(yi = logRR,
V = var,
data = data_pooled,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 133; method: REML)
##
## logLik Deviance AIC BIC AICc
## -25.7366 51.4731 63.4731 80.6320 64.1617
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0482 0.2196 67 no ID
## sigma^2.2 0.0133 0.1153 133 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 129) = 612.8032, p-val < .0001
##
## Test of Moderators (coefficients 2:4):
## QM(df = 3) = 15.0757, p-val = 0.0018
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1776 0.0623 -2.8477 0.0044 -0.2998 -0.0554 **
## DomainNon-specific -0.1168 0.0752 -1.5526 0.1205 -0.2641 0.0306
## DomainOPA 0.2976 0.1024 2.9044 0.0037 0.0968 0.4983 **
## DomainTPA 0.4873 0.4152 1.1739 0.2404 -0.3263 1.3010
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1All-cause dementia - Leisure
# KNHIS
data_KNHIS <- data %>% filter(KNHIS == 1 & leisure==1)
meta_model_KNHIS <- metagen(TE = logRR, seTE = SE, data = data_KNHIS, method.tau = "REML")
pooled_knhis <- get_pooled_RR(meta_model_KNHIS)
data_final <- data %>%
mutate(
RR = case_when(
!is.na(RR) ~ RR, # mantém valores individuais se já existirem
KNHIS == 1 ~ pooled_knhis$pooled_rr,
TRUE ~ NA_real_
),
`RR lower limit (95%)` = case_when(
!is.na(`RR lower limit (95%)`) ~ `RR lower limit (95%)`,
KNHIS == 1 ~ pooled_knhis$pooled_low,
TRUE ~ NA_real_
),
`RR Upper Limit (95%)` = case_when(
!is.na(`RR Upper Limit (95%)`) ~ `RR Upper Limit (95%)`,
KNHIS == 1 ~ pooled_knhis$pooled_up,
TRUE ~ NA_real_
)
)
data_final$SE[is.na(data_final$SE)==T] = (log(data_final$`RR Upper Limit (95%)`) - log(data_final$`RR lower limit (95%)`)) / (2 * 1.96)
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
# Only pooled estimates from UK Biobank, JAGES, and KNHIS
data_pooled <- data_final %>%
subset((Publication=="JAGES" | JAGES==0) & is.na(RR)==F)
data_pooled_leisure <- data_pooled %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_pooled_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 39; method: REML)
##
## logLik Deviance AIC BIC AICc
## 4.4457 -8.8914 -2.8914 2.0213 -2.1855
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0228 0.1509 19 no ID
## sigma^2.2 0.0052 0.0718 39 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 38) = 138.6931, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2005 0.0437 -4.5917 <.0001 -0.2861 -0.1149 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8183385 0.7512228 0.8914505data_pooled_work <- data_pooled %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_pooled_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 6.3760 7.8307 9.3760
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0170 0.1303 5 no ID
## sigma^2.2 0.0308 0.1754 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.196800 1.005628 1.424315Pooled analysis - Alzheimer’s disease
## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Alzheimer_disease_studies", col_names = T)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data <- data %>%
subset(is.na(Ind_ID)==F)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
## Meta-analysis - UK Biobank, KNHIS, JAGES
# Including pooled estimated from UK Biobank, JAGES, KNHIS
library(meta)
library(dplyr)
library(tibble)
get_pooled_RR <- function(meta_model) {
pooled_rr <- exp(meta_model$TE.random)
pooled_low <- exp(meta_model$lower.random)
pooled_up <- exp(meta_model$upper.random)
tibble(
pooled_rr = pooled_rr,
pooled_low = pooled_low,
pooled_up = pooled_up
)
}
# UKB
data_ukb <- data %>% filter(UKB == 1)
meta_model_ukb <- metagen(TE = logRR, seTE = SE, data = data_ukb, method.tau = "REML")
pooled_ukb <- get_pooled_RR(meta_model_ukb)
data_final <- data %>%
mutate(
RR = case_when(
!is.na(RR) ~ RR, # mantém valores individuais se já existirem
UKB == 1 ~ pooled_ukb$pooled_rr,
TRUE ~ NA_real_
),
`Lower limit (RR)` = case_when(
!is.na(`Lower limit (RR)`) ~ `Lower limit (RR)`,
UKB == 1 ~ pooled_ukb$pooled_low,
TRUE ~ NA_real_
),
`Upper limit (RR)` = case_when(
!is.na(`Upper limit (RR)`) ~ `Upper limit (RR)`,
UKB == 1 ~ pooled_ukb$pooled_up,
TRUE ~ NA_real_
)
)
data_final$SE[is.na(data_final$SE)==T] = (log(data_final$`Upper limit (RR)`) - log(data_final$`Lower limit (RR)`)) / (2 * 1.96)
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
# Only pooled estimates from UK Biobank, JAGES, and KNHIS
data_pooled <- data_final %>%
subset((Publication=="UK Biobank" | UKB==0)
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_pooled,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 52; method: REML)
##
## logLik Deviance AIC BIC AICc
## -31.5401 63.0802 69.0802 74.8757 69.5909
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0005 0.0217 27 no ID
## sigma^2.2 0.1212 0.3481 52 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 51) = 321.8608, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2609 0.0603 -4.3242 <.0001 -0.3792 -0.1427 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7703476 0.6844273 0.8670540meta_model <- rma.mv(yi = logRR,
V = var,
data = data_pooled,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 52; method: REML)
##
## logLik Deviance AIC BIC AICc
## -26.3484 52.6968 64.6968 75.9240 66.7456
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0738 0.2717 27 no ID
## sigma^2.2 0.0514 0.2268 52 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 48) = 286.1978, p-val < .0001
##
## Test of Moderators (coefficients 2:4):
## QM(df = 3) = 11.8708, p-val = 0.0078
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2672 0.1275 -2.0958 0.0361 -0.5171 -0.0173 *
## DomainNon-specific -0.0154 0.1551 -0.0991 0.9210 -0.3195 0.2887
## DomainOPA 1.2627 0.5632 2.2419 0.0250 0.1588 2.3665 *
## DomainTPA 1.4301 0.4995 2.8632 0.0042 0.4512 2.4091 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_alz_leisure <- data %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_alz_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 19; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.1527 10.3053 16.3053 18.9764 18.0196
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0729 0.2700 8 no ID
## sigma^2.2 0.0447 0.2113 19 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 18) = 133.2295, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2322 0.1149 -2.0204 0.0433 -0.4575 -0.0069 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7927566 0.6328410 0.9930819data_alz_work <- data %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_alz_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0435 -2.0871 3.9129 -0.0076 27.9129
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0334 0.1828 2 no ID
## sigma^2.2 0.0000 0.0000 3 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 1.3244, p-val = 0.5157
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1542 0.1781 0.8658 0.3866 -0.1949 0.5034
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.1667740 0.8229053 1.6543357Pooled analysis - Vascular dementia
## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Vascular dementia studies", col_names = T)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data <- data %>%
subset(is.na(Ind_ID)==F)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
## Meta-analysis - UK Biobank, KNHIS, JAGES
# Including pooled estimated from UK Biobank, JAGES, KNHIS
library(meta)
library(dplyr)
library(tibble)
get_pooled_RR <- function(meta_model) {
pooled_rr <- exp(meta_model$TE.random)
pooled_low <- exp(meta_model$lower.random)
pooled_up <- exp(meta_model$upper.random)
tibble(
pooled_rr = pooled_rr,
pooled_low = pooled_low,
pooled_up = pooled_up
)
}
# UKB
data_ukb <- data %>% filter(UKB == 1)
meta_model_ukb <- metagen(TE = logRR, seTE = SE, data = data_ukb, method.tau = "REML")
pooled_ukb <- get_pooled_RR(meta_model_ukb)
data_final <- data %>%
mutate(
RR = case_when(
!is.na(RR) ~ RR, # mantém valores individuais se já existirem
UKB == 1 ~ pooled_ukb$pooled_rr,
TRUE ~ NA_real_
),
`Lower limit (RR)` = case_when(
!is.na(`Lower limit (RR)`) ~ `Lower limit (RR)`,
UKB == 1 ~ pooled_ukb$pooled_low,
TRUE ~ NA_real_
),
`Upper limit (RR)` = case_when(
!is.na(`Upper limit (RR)`) ~ `Upper limit (RR)`,
UKB == 1 ~ pooled_ukb$pooled_up,
TRUE ~ NA_real_
)
)
data_final$SE[is.na(data_final$SE)==T] = (log(data_final$`Upper limit (RR)`) - log(data_final$`Lower limit (RR)`)) / (2 * 1.96)
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
# Only pooled estimates from UK Biobank, JAGES, and KNHIS
data_pooled <- data_final %>%
subset((Publication=="UK Biobank" | UKB==0)
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_pooled,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 16; method: REML)
##
## logLik Deviance AIC BIC AICc
## -2.7087 5.4174 11.4174 13.5415 13.5992
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0531 0.2305 9 no ID
## sigma^2.2 0.0104 0.1021 16 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 15) = 33.4183, p-val = 0.0041
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3725 0.1023 -3.6402 0.0003 -0.5730 -0.1719 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6890372 0.5638325 0.8420448meta_model <- rma.mv(yi = logRR,
V = var,
data = data_pooled,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 16; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.2364 0.4728 8.4728 11.0290 12.9172
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0097 0.0987 9 no ID
## sigma^2.2 0.0110 0.1049 16 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 14) = 18.5040, p-val = 0.1848
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 8.2003, p-val = 0.0042
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1716 0.0938 -1.8304 0.0672 -0.3554 0.0122 .
## DomainNon-specific -0.3966 0.1385 -2.8636 0.0042 -0.6681 -0.1252 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Pooled Vascular - Leisure
data_vas_leisure <- data %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_vas_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 10; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.1022 -2.2045 3.7955 4.3872 8.5955
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0090 0.0949 4 no ID
## sigma^2.2 0.0077 0.0878 10 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 9) = 13.7534, p-val = 0.1314
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2175 0.0754 -2.8833 0.0039 -0.3653 -0.0696 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8045429 0.6939756 0.9327262data_vas_work <- data %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_vas_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.2285 -0.4570 3.5430 -0.4570 15.5430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0267 0.1635 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 3.5898, p-val = 0.0581
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0506 0.1361 -0.3718 0.7101 -0.3175 0.2162
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9506435 0.7279947 1.2413868Sensitivity - Study quality/Follow-up/Sample size ¶
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$age_group <- factor(data$`Baseline age group (1=30-50 years, 2=50-65 years, 3=65-80 years, 4= 80+ years)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SEALL-CAUSE DEMENTIA
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
data_overall <- data %>%
subset(ID!=71 | Ind_ID!=73)
data_overall <- data_overall %>%
subset(ID!=63 | Ind_ID!=65)
data_overall <- data_overall %>%
subset(ID!=52 | Ind_ID!=59)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.2887 80.5773 86.5773 95.8216 86.7302
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0737 0.2715 76 no ID
## sigma^2.2 0.0211 0.1453 162 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 161) = 1565.0918, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2423 0.0378 -6.4159 <.0001 -0.3163 -0.1683 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7848340 0.7288432 0.8451262data_overall$Domain <- case_when(
data_overall$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data_overall$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data_overall$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data_overall$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -34.5480 69.0959 83.0959 104.4896 83.8476
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0627 0.2504 76 no ID
## sigma^2.2 0.0195 0.1395 162 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 157) = 1390.5776, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 15.8362, p-val = 0.0032
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2235 0.1240 -1.8020 0.0716 -0.4666 0.0196 .
## DomainLTPA -0.0356 0.1246 -0.2859 0.7750 -0.2799 0.2086
## DomainNon-specific -0.0389 0.1250 -0.3107 0.7560 -0.2839 0.2062
## DomainOPA 0.2249 0.1303 1.7264 0.0843 -0.0304 0.4802 .
## DomainTPA 0.2731 0.1408 1.9402 0.0524 -0.0028 0.5491 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_overall_leisure <- data_overall %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 42; method: REML)
##
## logLik Deviance AIC BIC AICc
## 7.0500 -14.1001 -8.1001 -2.9593 -7.4514
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0203 0.1426 20 no ID
## sigma^2.2 0.0040 0.0633 42 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 41) = 139.3871, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1988 0.0402 -4.9517 <.0001 -0.2775 -0.1201 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8196816 0.7576433 0.8867997data_overall_work <- data_overall %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 6.3760 7.8307 9.3760
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0170 0.1303 5 no ID
## sigma^2.2 0.0308 0.1754 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.196800 1.005628 1.424315Sensitivity Alzheimer - Study quality/Follow-up/Sample size ¶
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Alzheimer_disease_studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SEALZHEIMER DISEASE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
data_overall <- data %>%
subset(ID!=28 | ID!=26 )
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.3737 78.7474 84.7474 91.3163 85.1345
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0745 0.2730 30 no ID
## sigma^2.2 0.0649 0.2547 67 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 66) = 441.3006, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2606 0.0697 -3.7388 0.0002 -0.3972 -0.1240 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7705857 0.6721862 0.8833895data_overall$Domain <- case_when(
data_overall$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data_overall$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data_overall$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data_overall$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -35.2852 70.5704 84.5704 99.4603 86.6445
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0608 0.2465 30 no ID
## sigma^2.2 0.0675 0.2598 67 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 62) = 388.8464, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 8.8101, p-val = 0.0660
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2606 0.2339 -1.1142 0.2652 -0.7190 0.1978
## DomainLTPA 0.0561 0.2233 0.2514 0.8015 -0.3816 0.4938
## DomainNon-specific -0.0821 0.2489 -0.3297 0.7416 -0.5698 0.4057
## DomainOPA 0.3700 0.2635 1.4043 0.1602 -0.1464 0.8863
## DomainTPA 0.4512 0.2532 1.7818 0.0748 -0.0451 0.9474 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_overall_leisure <- data_overall %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 19; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.1527 10.3053 16.3053 18.9764 18.0196
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0729 0.2700 8 no ID
## sigma^2.2 0.0447 0.2113 19 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 18) = 133.2295, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2322 0.1149 -2.0204 0.0433 -0.4575 -0.0069 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7927566 0.6328410 0.9930819data_overall_work <- data_overall %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0435 -2.0871 3.9129 -0.0076 27.9129
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0334 0.1828 2 no ID
## sigma^2.2 0.0000 0.0000 3 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 1.3244, p-val = 0.5157
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1542 0.1781 0.8658 0.3866 -0.1949 0.5034
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.1667740 0.8229053 1.6543357Sensitivity Vascular dementia - Study quality/Follow-up/Sample size ¶
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Vascular dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SEVASCULAR DEMENTIA
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
data_overall <- data %>%
subset(ID!=10)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 24; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.6536 1.3072 7.3072 10.7137 8.5703
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0478 0.2187 10 no ID
## sigma^2.2 0.0128 0.1130 24 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 23) = 59.6308, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3330 0.0913 -3.6454 0.0003 -0.5120 -0.1539 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7167950 0.5993032 0.8573207data_overall$Domain <- case_when(
data_overall$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data_overall$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data_overall$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data_overall$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 24; method: REML)
##
## logLik Deviance AIC BIC AICc
## 2.1031 -4.2062 9.7938 16.4049 19.9756
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0062 0.0790 10 no ID
## sigma^2.2 0.0095 0.0974 24 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 19) = 26.5661, p-val = 0.1152
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 16.3594, p-val = 0.0026
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1270 0.1227 -1.0351 0.3006 -0.3676 0.1135
## DomainLTPA -0.0919 0.1286 -0.7145 0.4749 -0.3440 0.1602
## DomainNon-specific -0.4451 0.1564 -2.8466 0.0044 -0.7516 -0.1386 **
## DomainOPA 0.1119 0.1425 0.7852 0.4323 -0.1674 0.3911
## DomainTPA 0.1219 0.1496 0.8148 0.4152 -0.1713 0.4150
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_overall_leisure <- data_overall %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 10; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.1022 -2.2045 3.7955 4.3872 8.5955
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0090 0.0949 4 no ID
## sigma^2.2 0.0077 0.0878 10 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 9) = 13.7534, p-val = 0.1314
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2175 0.0754 -2.8833 0.0039 -0.3653 -0.0696 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8045429 0.6939756 0.9327262data_overall_work <- data_overall %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.2285 -0.4570 3.5430 -0.4570 15.5430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0267 0.1635 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 3.5898, p-val = 0.0581
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0506 0.1361 -0.3718 0.7101 -0.3175 0.2162
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9506435 0.7279947 1.2413868Sensitivity - Excluding poor quality studies - ALL-CAUSE DEMENTIA
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$age_group <- factor(data$`Baseline age group (1=30-50 years, 2=50-65 years, 3=65-80 years, 4= 80+ years)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F & quality=="Good"| quality=="Moderate")
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 114; method: REML)
##
## logLik Deviance AIC BIC AICc
## -32.7149 65.4297 71.4297 79.6119 71.6499
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0997 0.3158 42 no ID
## sigma^2.2 0.0250 0.1581 114 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 113) = 1045.1492, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2197 0.0568 -3.8685 0.0001 -0.3310 -0.1084 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8027663 0.7182066 0.8972817data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 114; method: REML)
##
## logLik Deviance AIC BIC AICc
## -28.1937 56.3874 70.3874 89.2268 71.4963
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0854 0.2922 42 no ID
## sigma^2.2 0.0220 0.1484 114 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 109) = 819.5728, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 12.7803, p-val = 0.0124
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2291 0.1361 -1.6837 0.0922 -0.4958 0.0376 .
## DomainLTPA -0.0481 0.1349 -0.3564 0.7215 -0.3125 0.2163
## DomainNon-specific -0.0129 0.1364 -0.0944 0.9248 -0.2803 0.2545
## DomainOPA 0.2125 0.1383 1.5371 0.1243 -0.0585 0.4835
## DomainTPA 0.2727 0.1494 1.8252 0.0680 -0.0201 0.5655 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_overall_leisure <- data %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 27; method: REML)
##
## logLik Deviance AIC BIC AICc
## 8.4332 -16.8664 -10.8664 -7.0921 -9.7755
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0086 0.0926 11 no ID
## sigma^2.2 0.0042 0.0646 27 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 26) = 71.4285, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1967 0.0404 -4.8746 <.0001 -0.2758 -0.1176 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8214110 0.7589402 0.8890240data_overall_work <- data %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 6.3760 7.8307 9.3760
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0170 0.1303 5 no ID
## sigma^2.2 0.0308 0.1754 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.196800 1.005628 1.424315Sensitivity - Only good quality studies - Alzheimer’s disease
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Alzheimer_disease_studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F & quality==3| quality==2)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 49; method: REML)
##
## logLik Deviance AIC BIC AICc
## -22.4928 44.9857 50.9857 56.5993 51.5311
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0860 0.2933 18 no ID
## sigma^2.2 0.0421 0.2052 49 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 48) = 276.7617, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3202 0.0868 -3.6871 0.0002 -0.4904 -0.1500 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7260145 0.6123901 0.8607212data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 49; method: REML)
##
## logLik Deviance AIC BIC AICc
## -21.2935 42.5869 56.5869 69.0762 59.6980
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0794 0.2817 18 no ID
## sigma^2.2 0.0426 0.2065 49 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 44) = 210.5499, p-val < .0001
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 4.5163, p-val = 0.3406
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.4302 0.2165 -1.9871 0.0469 -0.8546 -0.0059 *
## DomainLTPA 0.1144 0.1859 0.6153 0.5383 -0.2499 0.4787
## DomainNon-specific 0.0741 0.2422 0.3059 0.7597 -0.4006 0.5488
## DomainOPA 0.2899 0.2195 1.3207 0.1866 -0.1403 0.7202
## DomainTPA 0.3796 0.2139 1.7746 0.0760 -0.0396 0.7989 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_overall_leisure <- data %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -4.3149 8.6297 14.6297 16.0845 17.6297
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1121 0.3348 5 no ID
## sigma^2.2 0.0544 0.2331 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 119.2036, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3488 0.1718 -2.0297 0.0424 -0.6856 -0.0120 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7055521 0.5038037 0.9880906data_overall_work <- data %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.6462 -3.2924 0.7076 -3.2924 12.7076
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0000 0.0000 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 0.0291, p-val = 0.8646
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.0874 0.0528 1.6538 0.0982 -0.0162 0.1909 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.091301 0.983958 1.210354Sensitivity - Only good quality studies - Vascular dementia
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Vascular dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F & quality==3| quality==2)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 20; method: REML)
##
## logLik Deviance AIC BIC AICc
## -3.9247 7.8494 13.8494 16.6827 15.4494
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0860 0.2933 6 no ID
## sigma^2.2 0.0104 0.1020 20 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 19) = 48.7185, p-val = 0.0002
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4831 0.1411 -3.4241 0.0006 -0.7597 -0.2066 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6168584 0.4678271 0.8133652data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML",
mods = ~ Domain)
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 20; method: REML)
##
## logLik Deviance AIC BIC AICc
## -1.4209 2.8418 16.8418 21.7981 32.8418
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 6 no ID
## sigma^2.2 0.0047 0.0689 20 no ID/Ind_ID
##
## Test for Residual Heterogeneity:
## QE(df = 15) = 19.5934, p-val = 0.1881
##
## Test of Moderators (coefficients 2:5):
## QM(df = 4) = 24.6447, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1611 0.0895 -1.7999 0.0719 -0.3366 0.0143 .
## DomainLTPA -0.1310 0.1155 -1.1339 0.2568 -0.3574 0.0954
## DomainNon-specific -0.4620 0.1344 -3.4377 0.0006 -0.7254 -0.1986 ***
## DomainOPA 0.1097 0.1247 0.8795 0.3791 -0.1347 0.3541
## DomainTPA 0.1201 0.1327 0.9051 0.3654 -0.1400 0.3803
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1data_overall_leisure <- data %>%
subset(leisure==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_leisure,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 5; method: REML)
##
## logLik Deviance AIC BIC AICc
## 2.2231 -4.4462 1.5538 -0.2873 25.5538
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 2 no ID
## sigma^2.2 0.0000 0.0000 5 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 4) = 2.8617, p-val = 0.5812
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2903 0.0641 -4.5310 <.0001 -0.4159 -0.1647 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7480077 0.6597234 0.8481062data_overall_work <- data %>%
subset(work_pa==1)
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_overall_work,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.2285 -0.4570 3.5430 -0.4570 15.5430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0267 0.1635 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 3.5898, p-val = 0.0581
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0506 0.1361 -0.3718 0.7101 -0.3175 0.2162
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model$b, meta_model$ci.lb, meta_model$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9506435 0.7279947 1.2413868## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$age_group <- factor(data$`Baseline age group (1=30-50 years, 2=50-65 years, 3=65-80 years, 4= 80+ years)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.2887 80.5773 86.5773 95.8216 86.7302
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0737 0.2715 76 no ID
## sigma^2.2 0.0211 0.1453 162 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 161) = 1565.0918, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2423 0.0378 -6.4159 <.0001 -0.3163 -0.1683 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7848340 0.7288432 0.8451262# Age
data_age_n <- data %>%
subset(`Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==0)
data_age_y <- data %>%
subset(`Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 7; method: REML)
##
## logLik Deviance AIC BIC AICc
## -3.0652 6.1304 12.1304 11.5056 24.1304
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0610 0.2470 7 no ID
## sigma^2.2 0.0610 0.2470 7 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 6) = 51.8007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.5206 0.1536 -3.3902 0.0007 -0.8216 -0.2196 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 12.96468 ---
## Level 2 43.51766 43.52
## Level 3 43.51766 43.52
## Total I2: 87.04%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.5941377 0.4397100 0.8028011meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 155; method: REML)
##
## logLik Deviance AIC BIC AICc
## -35.1927 70.3854 76.3854 85.4963 76.5454
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0703 0.2651 69 no ID
## sigma^2.2 0.0208 0.1442 155 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 154) = 1512.2035, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2207 0.0385 -5.7316 <.0001 -0.2962 -0.1452 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 1.621454 ---
## Level 2 22.448992 22.45
## Level 3 75.929554 75.93
## Total I2: 98.38%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8019483 0.7436498 0.8648171# Education
data_education_n <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==0)
data_education_y <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 23; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.9988 -1.9976 4.0024 7.2756 5.3358
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0548 0.2340 15 no ID
## sigma^2.2 0.0024 0.0493 23 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 22) = 447.3119, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2212 0.0711 -3.1129 0.0019 -0.3605 -0.0819 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 0.5469921 ---
## Level 2 4.2343929 4.23
## Level 3 95.2186151 95.22
## Total I2: 99.45%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8015320 0.6973122 0.9213284meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 139; method: REML)
##
## logLik Deviance AIC BIC AICc
## -38.7249 77.4499 83.4499 92.2317 83.6290
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0797 0.2824 61 no ID
## sigma^2.2 0.0247 0.1572 139 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 138) = 1085.8299, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2464 0.0437 -5.6434 <.0001 -0.3320 -0.1608 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 5.145491 ---
## Level 2 22.435264 22.44
## Level 3 72.419245 72.42
## Total I2: 94.85%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7815939 0.7174854 0.8514305# Education
data_chronic_n <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==0)
data_chronic_y <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 44; method: REML)
##
## logLik Deviance AIC BIC AICc
## -7.7915 15.5830 21.5830 26.8666 22.1984
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0497 0.2229 27 no ID
## sigma^2.2 0.0106 0.1028 44 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 43) = 132.6737, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2344 0.0571 -4.1083 <.0001 -0.3462 -0.1226 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 19.43687 ---
## Level 2 14.11586 14.12
## Level 3 66.44727 66.45
## Total I2: 80.56%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7910628 0.7073748 0.8846518meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 118; method: REML)
##
## logLik Deviance AIC BIC AICc
## -31.2998 62.5995 68.5995 76.8860 68.8119
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0853 0.2920 49 no ID
## sigma^2.2 0.0234 0.1529 118 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 117) = 1432.1742, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2420 0.0484 -5.0013 <.0001 -0.3368 -0.1471 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 1.065154 ---
## Level 2 21.287410 21.29
## Level 3 77.647436 77.65
## Total I2: 98.93%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7850722 0.7140449 0.8631648# Education
data_apoe_n <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==0)
data_apoe_y <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 122; method: REML)
##
## logLik Deviance AIC BIC AICc
## -28.5126 57.0251 63.0251 71.4125 63.2302
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0815 0.2855 56 no ID
## sigma^2.2 0.0229 0.1514 122 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 121) = 1429.9393, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2493 0.0458 -5.4386 <.0001 -0.3391 -0.1594 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 1.150602 ---
## Level 2 21.683426 21.68
## Level 3 77.165972 77.17
## Total I2: 98.85%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7793683 0.7124083 0.8526221meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 39; method: REML)
##
## logLik Deviance AIC BIC AICc
## -7.3031 14.6063 20.6063 25.5190 21.3122
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0301 0.1736 19 no ID
## sigma^2.2 0.0077 0.0876 39 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 38) = 108.4999, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1805 0.0528 -3.4221 0.0006 -0.2839 -0.0771 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 24.29838 ---
## Level 2 15.35733 15.36
## Level 3 60.34429 60.34
## Total I2: 75.7%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8348198 0.7528117 0.9257614## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Alzheimer_disease_studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.3737 78.7474 84.7474 91.3163 85.1345
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0745 0.2730 30 no ID
## sigma^2.2 0.0649 0.2547 67 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 66) = 441.3006, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2606 0.0697 -3.7388 0.0002 -0.3972 -0.1240 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7705857 0.6721862 0.8833895# Age
data_age_n <- data %>%
subset(`Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==0)
data_age_y <- data %>%
subset(`Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==1)
summary(data_age_n$RR)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.94 0.94 0.94 0.94 0.94 0.94summary(data_age_n$`Lower limit (RR)`)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.47 0.47 0.47 0.47 0.47 0.47summary(data_age_n$`Upper limit (RR)`)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.77 1.77 1.77 1.77 1.77 1.77table(data_age_n$Publication)##
## Sattler 2011
## 1# meta_model_3level <- rma.mv(yi = logRR,
# V = var,
# data = data_age_n,
# random = ~1| ID/Ind_ID,
# method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
# summary(meta_model_3level)
# i2 <- var.comp(meta_model_3level)
# summary(i2)
# # Back-transform pooled effect to RR
# pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
# names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
# pooled_RR
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 66; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.0639 78.1277 84.1277 90.6509 84.5212
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0767 0.2769 29 no ID
## sigma^2.2 0.0654 0.2557 66 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 65) = 441.3002, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2645 0.0710 -3.7227 0.0002 -0.4037 -0.1252 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 6.503003 ---
## Level 2 43.021346 43.02
## Level 3 50.475650 50.48
## Total I2: 93.5%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7676157 0.6678404 0.8822975# Education
data_education_n <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==0)
data_education_y <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 8; method: REML)
##
## logLik Deviance AIC BIC AICc
## -2.7397 5.4794 11.4794 11.3172 19.4794
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.4418 0.6647 5 no ID
## sigma^2.2 0.0073 0.0857 8 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 7) = 142.2551, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3834 0.3071 -1.2482 0.2120 -0.9854 0.2186
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 0.9227048 ---
## Level 2 1.6213113 1.62
## Level 3 97.4559840 97.46
## Total I2: 99.08%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6815610 0.3733046 1.2443602meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 59; method: REML)
##
## logLik Deviance AIC BIC AICc
## -33.0973 66.1945 72.1945 78.3759 72.6390
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0478 0.2186 25 no ID
## sigma^2.2 0.0624 0.2497 59 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 58) = 288.7393, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2456 0.0679 -3.6195 0.0003 -0.3786 -0.1126 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 13.54883 ---
## Level 2 48.94463 48.94
## Level 3 37.50654 37.51
## Total I2: 86.45%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7822140 0.6847964 0.8934900# Education
data_chronic_n <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==0)
data_chronic_y <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 11; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.7041 -1.4083 4.5917 5.4995 8.5917
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 9 no ID
## sigma^2.2 0.0140 0.1182 11 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 10) = 15.6072, p-val = 0.1114
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0727 0.0658 -1.1049 0.2692 -0.2018 0.0563
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 5.994366e+01 ---
## Level 2 4.005634e+01 40.06
## Level 3 1.930477e-08 0
## Total I2: 40.06%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9298389 0.8172717 1.0579106meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 56; method: REML)
##
## logLik Deviance AIC BIC AICc
## -35.1791 70.3582 76.3582 82.3802 76.8288
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0961 0.3101 21 no ID
## sigma^2.2 0.0711 0.2666 56 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 55) = 381.9858, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3303 0.0871 -3.7930 0.0001 -0.5009 -0.1596 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 7.560947 ---
## Level 2 39.287061 39.29
## Level 3 53.151992 53.15
## Total I2: 92.44%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7187326 0.6059698 0.8524789# Education
data_apoe_n <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==0)
data_apoe_y <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 39; method: REML)
##
## logLik Deviance AIC BIC AICc
## -19.5869 39.1738 45.1738 50.0866 45.8797
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1932 0.4395 16 no ID
## sigma^2.2 0.0436 0.2088 39 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 38) = 300.3647, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2918 0.1279 -2.2813 0.0225 -0.5425 -0.0411 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 5.038941 ---
## Level 2 17.483028 17.48
## Level 3 77.478031 77.48
## Total I2: 94.96%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7469343 0.5813195 0.9597318meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -14.5140 29.0279 35.0279 38.9154 36.0714
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 14 no ID
## sigma^2.2 0.0663 0.2574 28 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 27) = 113.5038, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2095 0.0684 -3.0604 0.0022 -0.3436 -0.0753 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 1.572786e+01 ---
## Level 2 8.427214e+01 84.27
## Level 3 4.068589e-08 0
## Total I2: 84.27%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8110232 0.7092101 0.9274525## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Vascular dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.9632 13.9263 19.9263 23.8138 20.9698
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0852 0.2918 11 no ID
## sigma^2.2 0.0118 0.1087 28 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 27) = 76.3124, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4045 0.1078 -3.7519 0.0002 -0.6159 -0.1932 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6672791 0.5401648 0.8243065# Age
data_age_n <- data %>%
subset(`Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==0)
data_age_y <- data %>%
subset(`Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==1)
summary(data_age_n$RR)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## summary(data_age_n$`Lower limit (RR)`)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## summary(data_age_n$`Upper limit (RR)`)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## table(data_age_n$Publication)## < table of extent 0 ># meta_model_3level <- rma.mv(yi = logRR,
# V = var,
# data = data_age_n,
# random = ~1| ID/Ind_ID,
# method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
# summary(meta_model_3level)
# i2 <- var.comp(meta_model_3level)
# summary(i2)
# # Back-transform pooled effect to RR
# pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
# names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
# pooled_RR
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.9632 13.9263 19.9263 23.8138 20.9698
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0852 0.2918 11 no ID
## sigma^2.2 0.0118 0.1087 28 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 27) = 76.3124, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4045 0.1078 -3.7519 0.0002 -0.6159 -0.1932 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 20.947440 ---
## Level 2 9.629279 9.63
## Level 3 69.423282 69.42
## Total I2: 79.05%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6672791 0.5401648 0.8243065# Education
data_education_n <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==0)
data_education_y <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 5; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.5847 -1.1694 4.8306 2.9895 28.8306
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 3 no ID
## sigma^2.2 0.0000 0.0000 5 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 4) = 1.9867, p-val = 0.7382
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2414 0.1006 -2.4001 0.0164 -0.4384 -0.0443 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 1.000000e+02 ---
## Level 2 9.562075e-11 0
## Level 3 7.414248e-09 0
## Total I2: 0%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7855627 0.6450364 0.9567039meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 23; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.9710 11.9419 17.9419 21.2151 19.2753
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1210 0.3479 8 no ID
## sigma^2.2 0.0127 0.1128 23 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 22) = 74.3193, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4635 0.1391 -3.3322 0.0009 -0.7361 -0.1909 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 14.789538 ---
## Level 2 8.100963 8.1
## Level 3 77.109499 77.11
## Total I2: 85.21%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6290756 0.4789612 0.8262383# Chronic diseases
data_chronic_n <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==0)
data_chronic_y <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 4; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.5988 1.1976 7.1976 4.4934 31.1976
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.4105 0.6407 2 no ID
## sigma^2.2 0.0000 0.0000 4 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 3) = 21.2935, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3767 0.4645 -0.8111 0.4173 -1.2870 0.5336
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 1.012586e+01 ---
## Level 2 1.005072e-09 0
## Level 3 8.987414e+01 89.87
## Total I2: 89.87%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6861028 0.2760853 1.7050420meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 24; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.0691 10.1382 16.1382 19.5447 17.4013
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0461 0.2146 9 no ID
## sigma^2.2 0.0125 0.1116 24 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 23) = 53.3951, p-val = 0.0003
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3966 0.0980 -4.0458 <.0001 -0.5888 -0.2045 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 29.23231 ---
## Level 2 15.05974 15.06
## Level 3 55.70795 55.71
## Total I2: 70.77%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6725801 0.5550021 0.8150671# APOE e4
data_apoe_n <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==0)
data_apoe_y <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_n,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 23; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.7530 11.5061 17.5061 20.7792 18.8394
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0861 0.2934 8 no ID
## sigma^2.2 0.0135 0.1161 23 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 22) = 63.2885, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4338 0.1276 -3.3987 0.0007 -0.6840 -0.1836 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 19.08541 ---
## Level 2 10.95996 10.96
## Level 3 69.95463 69.95
## Total I2: 80.91%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.6480449 0.5046171 0.8322395meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_y,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 5; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.7065 1.4130 7.4130 5.5718 31.4130
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1329 0.3645 3 no ID
## sigma^2.2 0.0000 0.0000 5 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 4) = 12.8011, p-val = 0.0123
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.3451 0.2354 -1.4661 0.1426 -0.8065 0.1163
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 2.687834e+01 ---
## Level 2 2.643313e-09 0
## Level 3 7.312166e+01 73.12
## Total I2: 73.12%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7081280 0.4464112 1.1232809SENSITIVITY ANALYSIS - COVARIATES
## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$age_group <- factor(data$`Baseline age group (1=30-50 years, 2=50-65 years, 3=65-80 years, 4= 80+ years)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
data_age <- data %>%
subset(is.na(Ind_ID)==F & `Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==1)
# Age
data_age_l <- data_age %>%
subset(leisure==1)
data_age_w <- data_age %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 38; method: REML)
##
## logLik Deviance AIC BIC AICc
## 11.9289 -23.8578 -17.8578 -13.0250 -17.1305
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0098 0.0990 16 no ID
## sigma^2.2 0.0032 0.0569 38 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 37) = 100.5657, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1675 0.0343 -4.8891 <.0001 -0.2346 -0.1003 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 36.80272 ---
## Level 2 15.69095 15.69
## Level 3 47.50632 47.51
## Total I2: 63.2%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8458074 0.7908893 0.9045388meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 6.3760 7.8307 9.3760
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0170 0.1303 5 no ID
## sigma^2.2 0.0308 0.1754 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 14.40088 ---
## Level 2 55.14999 55.15
## Level 3 30.44913 30.45
## Total I2: 85.6%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.196800 1.005628 1.424315# Education
data_education <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==1)
data_education_l <- data_education %>%
subset(leisure==1)
data_education_w <- data_education %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 32; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.7517 -1.5033 4.4967 8.7986 5.3855
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0312 0.1767 15 no ID
## sigma^2.2 0.0052 0.0722 32 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 31) = 111.9784, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2127 0.0548 -3.8791 0.0001 -0.3202 -0.1052 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 19.69778 ---
## Level 2 11.48044 11.48
## Level 3 68.82178 68.82
## Total I2: 80.3%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8083775 0.7259970 0.9001060meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 13; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.1880 0.3760 6.3760 7.8307 9.3760
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0170 0.1303 5 no ID
## sigma^2.2 0.0308 0.1754 13 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 12) = 79.9007, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1797 0.0888 2.0232 0.0431 0.0056 0.3537 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 14.40088 ---
## Level 2 55.14999 55.15
## Level 3 30.44913 30.45
## Total I2: 85.6%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.196800 1.005628 1.424315# Chronic dieases
data_chronic <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==1)
data_chronic_l <- data_chronic %>%
subset(leisure==1)
data_chronic_w <- data_chronic %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 26; method: REML)
##
## logLik Deviance AIC BIC AICc
## 10.0579 -20.1157 -14.1157 -10.4591 -12.9729
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0120 0.1096 12 no ID
## sigma^2.2 0.0022 0.0471 26 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 25) = 75.2417, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1779 0.0420 -4.2308 <.0001 -0.2603 -0.0955 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 30.48300 ---
## Level 2 10.84112 10.84
## Level 3 58.67588 58.68
## Total I2: 69.52%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8370354 0.7708221 0.9089364meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 6; method: REML)
##
## logLik Deviance AIC BIC AICc
## -1.3901 2.7801 8.7801 7.6085 32.7801
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0240 0.1548 3 no ID
## sigma^2.2 0.0696 0.2639 6 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 5) = 74.3302, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.2233 0.1576 1.4166 0.1566 -0.0856 0.5322
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 4.911091 ---
## Level 2 70.737456 70.74
## Level 3 24.351454 24.35
## Total I2: 95.09%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.2501425 0.9179288 1.7025899# APOE
data_apoe <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==1)
data_apoe_l <- data_apoe %>%
subset(leisure==1)
data_apoe_w <- data_apoe %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 8; method: REML)
##
## logLik Deviance AIC BIC AICc
## 2.9559 -5.9118 0.0882 -0.0741 8.0882
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0200 0.1415 3 no ID
## sigma^2.2 0.0037 0.0605 8 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 7) = 14.6768, p-val = 0.0404
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1740 0.0963 -1.8069 0.0708 -0.3628 0.0147 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 34.37868 ---
## Level 2 10.13439 10.13
## Level 3 55.48693 55.49
## Total I2: 65.62%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8402757 0.6957315 1.0148502table(data_apoe_w$Publication)##
## Rovio 2007
## 1table(data_apoe_w$RR)##
## 1.45
## 1table(data_apoe_w$`RR lower limit (95%)`)##
## 0.66
## 1table(data_apoe_w$`RR Upper Limit (95%)`)##
## 3.17
## 1## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Alzheimer_disease_studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
# Age
data_age <- data %>%
subset(`Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==1)
data_age_l <- data_age %>%
subset(leisure==1)
data_age_w <- data_age %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 19; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.1527 10.3053 16.3053 18.9764 18.0196
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0729 0.2700 8 no ID
## sigma^2.2 0.0447 0.2113 19 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 18) = 133.2295, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2322 0.1149 -2.0204 0.0433 -0.4575 -0.0069 *
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 7.66007 ---
## Level 2 35.08355 35.08
## Level 3 57.25637 57.26
## Total I2: 92.34%# # Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7927566 0.6328410 0.9930819meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0435 -2.0871 3.9129 -0.0076 27.9129
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0334 0.1828 2 no ID
## sigma^2.2 0.0000 0.0000 3 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 1.3244, p-val = 0.5157
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1542 0.1781 0.8658 0.3866 -0.1949 0.5034
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 2.487567e+01 ---
## Level 2 4.153316e-09 0
## Level 3 7.512433e+01 75.12
## Total I2: 75.12%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.1667740 0.8229053 1.6543357# Education
data_education <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==1)
data_education_l <- data_education %>%
subset(leisure==1)
data_education_w <- data_education %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 14; method: REML)
##
## logLik Deviance AIC BIC AICc
## -5.4398 10.8796 16.8796 18.5745 19.5463
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.1082 0.3290 6 no ID
## sigma^2.2 0.0616 0.2482 14 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 13) = 121.3068, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2737 0.1591 -1.7207 0.0853 -0.5855 0.0381 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 6.924185 ---
## Level 2 33.764872 33.76
## Level 3 59.310943 59.31
## Total I2: 93.08%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7605594 0.5568527 1.0387857meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0435 -2.0871 3.9129 -0.0076 27.9129
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0334 0.1828 2 no ID
## sigma^2.2 0.0000 0.0000 3 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 1.3244, p-val = 0.5157
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1542 0.1781 0.8658 0.3866 -0.1949 0.5034
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 2.487567e+01 ---
## Level 2 4.153316e-09 0
## Level 3 7.512433e+01 75.12
## Total I2: 75.12%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.1667740 0.8229053 1.6543357# Chronic diseases
data_chronic <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==1)
data_chronic_l <- data_chronic %>%
subset(leisure==1)
data_chronic_w <- data_chronic %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 16; method: REML)
##
## logLik Deviance AIC BIC AICc
## -4.8796 9.7591 15.7591 17.8833 17.9409
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0923 0.3039 7 no ID
## sigma^2.2 0.0475 0.2179 16 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 15) = 130.6977, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2514 0.1352 -1.8588 0.0631 -0.5165 0.0137 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 5.769138 ---
## Level 2 31.998753 32
## Level 3 62.232109 62.23
## Total I2: 94.23%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7777179 0.5966276 1.0137733meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.0435 -2.0871 3.9129 -0.0076 27.9129
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0334 0.1828 2 no ID
## sigma^2.2 0.0000 0.0000 3 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 1.3244, p-val = 0.5157
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.1542 0.1781 0.8658 0.3866 -0.1949 0.5034
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 2.487567e+01 ---
## Level 2 4.153316e-09 0
## Level 3 7.512433e+01 75.12
## Total I2: 75.12%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.1667740 0.8229053 1.6543357# APOE
data_apoe <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==1)
data_apoe_l <- data_apoe %>%
subset(leisure==1)
data_apoe_w <- data_apoe %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 4; method: REML)
##
## logLik Deviance AIC BIC AICc
## -0.8778 1.7556 7.7556 5.0515 31.7556
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.3642 0.6035 2 no ID
## sigma^2.2 0.0094 0.0971 4 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 3) = 22.6354, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.5682 0.4413 -1.2877 0.1979 -1.4331 0.2966
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 8.063676 ---
## Level 2 2.320875 2.32
## Level 3 89.615449 89.62
## Total I2: 91.94%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.5665401 0.2385785 1.3453339table(data_apoe_w$Publication)##
## Rovio 2005
## 1## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Vascular dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$SE <- data$`Standard error (SE)`
data$var <- data$SE*data$SE
# Age
data_age <- data %>%
subset(`Age used a covariate or included in the model or the cohort is a birth cohort (1= yes, 0=no)`==1)
data_age_l <- data_age %>%
subset(leisure==1)
data_age_w <- data_age %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 10; method: REML)
##
## logLik Deviance AIC BIC AICc
## 1.1022 -2.2045 3.7955 4.3872 8.5955
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0090 0.0949 4 no ID
## sigma^2.2 0.0077 0.0878 10 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 9) = 13.7534, p-val = 0.1314
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2175 0.0754 -2.8833 0.0039 -0.3653 -0.0696 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 58.99349 ---
## Level 2 18.90445 18.9
## Level 3 22.10206 22.1
## Total I2: 41.01%# # Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8045429 0.6939756 0.9327262meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_age_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.2285 -0.4570 3.5430 -0.4570 15.5430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0267 0.1635 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 3.5898, p-val = 0.0581
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0506 0.1361 -0.3718 0.7101 -0.3175 0.2162
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 27.85669 ---
## Level 2 72.14331 72.14
## Level 3 0.00000 0
## Total I2: 72.14%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9506435 0.7279947 1.2413868# Education
data_education <- data %>%
subset(`Education used as a covariate or the cohort has the same education (1= yes, 0=no)`==1)
data_education_l <- data_education %>%
subset(leisure==1)
data_education_w <- data_education %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 7; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.4460 -0.8920 5.1080 4.4833 17.1080
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0252 0.1587 3 no ID
## sigma^2.2 0.0113 0.1063 7 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 6) = 11.8176, p-val = 0.0662
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.1884 0.1166 -1.6156 0.1062 -0.4170 0.0402
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 36.84358 ---
## Level 2 19.55626 19.56
## Level 3 43.60016 43.6
## Total I2: 63.16%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.8282489 0.6589927 1.0409768meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_education_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.2285 -0.4570 3.5430 -0.4570 15.5430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0267 0.1635 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 3.5898, p-val = 0.0581
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0506 0.1361 -0.3718 0.7101 -0.3175 0.2162
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 27.85669 ---
## Level 2 72.14331 72.14
## Level 3 0.00000 0
## Total I2: 72.14%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9506435 0.7279947 1.2413868# Chronic diseases
data_chronic <- data %>%
subset(`Chronic disease used as a covariate (1= yes, 0=no)`==1)
data_chronic_l <- data_chronic %>%
subset(leisure==1)
data_chronic_w <- data_chronic %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 7; method: REML)
##
## logLik Deviance AIC BIC AICc
## 2.6304 -5.2608 0.7392 0.1145 12.7392
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 3 no ID
## sigma^2.2 0.0024 0.0493 7 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 6) = 6.7909, p-val = 0.3406
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2877 0.0548 -5.2498 <.0001 -0.3951 -0.1803 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 8.858686e+01 ---
## Level 2 1.141314e+01 11.41
## Level 3 1.342524e-08 0
## Total I2: 11.41%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.7500091 0.6736330 0.8350446meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_chronic_w,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 2; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.2285 -0.4570 3.5430 -0.4570 15.5430
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0267 0.1635 2 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 1) = 3.5898, p-val = 0.0581
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.0506 0.1361 -0.3718 0.7101 -0.3175 0.2162
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 27.85669 ---
## Level 2 72.14331 72.14
## Level 3 0.00000 0
## Total I2: 72.14%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 0.9506435 0.7279947 1.2413868# APOE
data_apoe <- data %>%
subset(`ApoE ε4 status used as a covariate (1= yes, 0=no)`==1)
data_apoe_l <- data_apoe %>%
subset(leisure==1)
data_apoe_w <- data_apoe %>%
subset(work_pa==1)
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data_apoe_l,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 3; method: REML)
##
## logLik Deviance AIC BIC AICc
## 0.6026 -1.2051 2.7949 0.1812 14.7949
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0000 0.0000 1 yes ID
## sigma^2.2 0.0000 0.0000 3 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 2) = 0.7223, p-val = 0.6969
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## 0.0868 0.1418 0.6121 0.5404 -0.1911 0.3647
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1i2 <- var.comp(meta_model_3level)
summary(i2)## % of total variance I2
## Level 1 1.000000e+02 ---
## Level 2 1.225466e-08 0
## Level 3 0.000000e+00 0
## Total I2: 0%# Back-transform pooled effect to RR
pooled_RR <- exp(c(meta_model_3level$b, meta_model_3level$ci.lb, meta_model_3level$ci.ub))
names(pooled_RR) <- c("Pooled RR", "95% CI lower", "95% CI upper")
pooled_RR## Pooled RR 95% CI lower 95% CI upper
## 1.0906699 0.8260526 1.4400546table(data_apoe_w$Publication)## < table of extent 0 >data <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Dementia studies", col_names = T)
data$non_leisure <- factor(data$`Only non-leisure-related PA (1= yes, 0=no)`)
data$work_pa <- factor(data$`Only work-related PA (1= yes, 0=no)`)
data$leisure <- factor(data$`Only leisure PA (1= yes, 0=no)`)
data$travel <- factor(data$`Only travel-related PA (1= yes, 0=no)`)
data$household <- factor(data$`Only household-related PA (1= yes, 0=no)`)
data$age_group <- factor(data$`Baseline age group (1=30-50 years, 2=50-65 years, 3=65-80 years, 4= 80+ years)`)
data$follow_up <- factor(data$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data$metting <- factor(data$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
table(data$metting)##
## 1 2
## 50 58data <- data %>%
subset(is.na(Ind_ID)==F)
# Structure
# head(data)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data$logRR <- log(data$RR)
data$var <- data$SE*data$SE
data$Domain <- case_when(
data$`Only leisure PA (1= yes, 0=no)` == 1 ~ "LTPA",
data$`Only work-related PA (1= yes, 0=no)` == 1 ~ "OPA",
data$`Only household-related PA (1= yes, 0=no)` == 1 ~ "HPA",
data$`Only travel-related PA (1= yes, 0=no)` == 1 ~ "TPA",
TRUE ~ "Non-specific"
)
data$design <- case_when(
data$Design == "Prospective cohort study" ~ "Prospective cohort study",
data$Design == "Longitudinal cohort study" ~ "Prospective cohort study",
data$Design == "Case-control study" ~ "Case-control study",
data$Design == "Case-control study nested in prospective cohort study" ~ "Case-control study",
data$Design == "Nested case-control studies" ~ "Case-control study",
data$Design == "Prospective" ~ "Prospective cohort study",
data$Design == "Prospective population-based study" ~ "Prospective cohort study",
data$Design == "Retrospective cohort study" ~ "Case-control study",
data$Design == "prospective cohort study" ~ "Prospective cohort study",
TRUE ~ "Non-specific"
)
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model_3level <- rma.mv(yi = logRR,
V = var,
data = data,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model_3level)##
## Multivariate Meta-Analysis Model (k = 162; method: REML)
##
## logLik Deviance AIC BIC AICc
## -40.2887 80.5773 86.5773 95.8216 86.7302
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0737 0.2715 76 no ID
## sigma^2.2 0.0211 0.1453 162 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 161) = 1565.0918, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2423 0.0378 -6.4159 <.0001 -0.3163 -0.1683 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Prepare data
egger_df <- meta_model_3level$data %>%
mutate(
y = logRR / SE,
x = 1 / SE
)
# Fit Egger regression
egger_lm <- lm(y ~ x, data = egger_df)
egger_sum <- summary(egger_lm)
# Extract intercept beta and p-value
beta_intercept <- round(egger_sum$coefficients[1, 1], 3)
p_intercept <- signif(egger_sum$coefficients[1, 4], 3)
# Plot
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Egger_allcause.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
ggplot(egger_df, aes(x = x, y = y)) +
geom_point(size = 2, alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE, linewidth = 1) +
labs(
x = expression(1 / SE),
y = expression(log(RR) / SE),
title = "Egger regression plot",
subtitle = bquote(
"Intercept:" ~ beta == .(beta_intercept) ~ "," ~ italic(p) == .(p_intercept)
)
) +
theme_classic(base_size = 14)
dev.off()## quartz_off_screen
## 2# Leave-one-out Egger test (exclude largest study)
library(dplyr)
# Identify largest study by precision
largest_id <- meta_model_3level$data %>%
mutate(precision = 1 / SE) %>%
arrange(desc(precision)) %>%
slice(1) %>%
pull(ID)
# Re-run Egger regression excluding largest study
egger_loo_df <- meta_model_3level$data %>%
filter(ID != largest_id) %>%
mutate(
y = logRR / SE,
x = 1 / SE
)
egger_loo <- lm(y ~ x, data = egger_loo_df)
summary(egger_loo)##
## Call:
## lm(formula = y ~ x, data = egger_loo_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11.806 -1.127 0.045 1.224 11.715
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.51197 0.26299 -1.947 0.0533 .
## x -0.12140 0.01133 -10.714 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.905 on 159 degrees of freedom
## Multiple R-squared: 0.4192, Adjusted R-squared: 0.4156
## F-statistic: 114.8 on 1 and 159 DF, p-value: < 2.2e-16# Contour-enhanced funnel plot
library(metafor)
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Counter_funnel_allcause.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
funnel(
meta_model_3level,
yaxis = "sei",
xlab = "Log RR",
level=c(90, 95, 99),
refline=0, legend=TRUE
)
# legend(
# "topright",
# legend = c("p ≥ 0.10", "0.05 ≤ p < 0.10", "p < 0.05"),
# fill = c("white", "gray80", "gray60"),
# border = "black",
# bty = "n"
# )
dev.off()## quartz_off_screen
## 2# PET-PEESE
pet <- rma(
yi = logRR,
sei = SE,
mods = ~ SE,
data = meta_model_3level$data,
method = "REML"
)
# PEESE model
peese <- rma(
yi = logRR,
sei = SE,
mods = ~ I(SE^2),
data = meta_model_3level$data,
method = "REML"
)
summary(pet)##
## Mixed-Effects Model (k = 162; tau^2 estimator: REML)
##
## logLik deviance AIC BIC AICc
## -64.8380 129.6759 135.6759 144.9015 135.8298
##
## tau^2 (estimated amount of residual heterogeneity): 0.0877 (SE = 0.0127)
## tau (square root of estimated tau^2 value): 0.2961
## I^2 (residual heterogeneity / unaccounted variability): 98.23%
## H^2 (unaccounted variability / sampling variability): 56.41
## R^2 (amount of heterogeneity accounted for): 8.28%
##
## Test for Residual Heterogeneity:
## QE(df = 160) = 1485.0384, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 7.2529, p-val = 0.0071
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1262 0.0465 -2.7116 0.0067 -0.2173 -0.0350 **
## SE -0.7064 0.2623 -2.6931 0.0071 -1.2205 -0.1923 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(peese)##
## Mixed-Effects Model (k = 162; tau^2 estimator: REML)
##
## logLik deviance AIC BIC AICc
## -67.3136 134.6271 140.6271 149.8527 140.7810
##
## tau^2 (estimated amount of residual heterogeneity): 0.0940 (SE = 0.0135)
## tau (square root of estimated tau^2 value): 0.3066
## I^2 (residual heterogeneity / unaccounted variability): 98.38%
## H^2 (unaccounted variability / sampling variability): 61.87
## R^2 (amount of heterogeneity accounted for): 1.69%
##
## Test for Residual Heterogeneity:
## QE(df = 160) = 1513.8514, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 1.0804, p-val = 0.2986
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2138 0.0315 -6.7942 <.0001 -0.2755 -0.1521 ***
## I(SE^2) -0.4732 0.4552 -1.0394 0.2986 -1.3655 0.4191
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1## ALZHEIMER'S DISEASE
## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data_alz <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Alzheimer_disease_studies", col_names = T)
data_alz$non_leisure <- factor(data_alz$`Only non-leisure-related PA (1= yes, 0=no)`)
data_alz$work_pa <- factor(data_alz$`Only work-related PA (1= yes, 0=no)`)
data_alz$leisure <- factor(data_alz$`Only leisure PA (1= yes, 0=no)`)
data_alz$travel <- factor(data_alz$`Only travel-related PA (1= yes, 0=no)`)
data_alz$household <- factor(data_alz$`Only household-related PA (1= yes, 0=no)`)
data_alz$age_group <- factor(data_alz$`Baseline age group (1=30-60 years, 2=70-79 years, 3=80+ years)`)
data_alz$follow_up <- factor(data_alz$`Follow-up length group (1= < 5 years, 2= 5-20 years, 3= at least 20 years)`)
data_alz$metting <- factor(data_alz$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data_alz <- data_alz %>%
subset(is.na(Ind_ID)==F)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data_alz$logRR <- log(data_alz$RR)
data_alz$SE <- data_alz$`Standard error (SE)`
data_alz$var <- data_alz$SE^2
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_alz,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 67; method: REML)
##
## logLik Deviance AIC BIC AICc
## -39.3737 78.7474 84.7474 91.3163 85.1345
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0745 0.2730 30 no ID
## sigma^2.2 0.0649 0.2547 67 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 66) = 441.3006, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.2606 0.0697 -3.7388 0.0002 -0.3972 -0.1240 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Prepare data
egger_df <- meta_model$data %>%
mutate(
y = logRR / SE,
x = 1 / SE
)
# Fit Egger regression
egger_lm <- lm(y ~ x, data = egger_df)
egger_sum <- summary(egger_lm)
egger_sum##
## Call:
## lm(formula = y ~ x, data = egger_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.931 -1.325 0.607 1.572 4.473
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.39233 0.38370 -3.629 0.000561 ***
## x 0.02329 0.03330 0.699 0.486918
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.376 on 65 degrees of freedom
## Multiple R-squared: 0.007465, Adjusted R-squared: -0.007805
## F-statistic: 0.4889 on 1 and 65 DF, p-value: 0.4869# Extract intercept beta and p-value
beta_intercept <- round(egger_sum$coefficients[1, 1], 3)
p_intercept <- signif(egger_sum$coefficients[1, 4], 3)
# Plot
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Egger_alz.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
ggplot(egger_df, aes(x = x, y = y)) +
geom_point(size = 2, alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE, linewidth = 1) +
labs(
x = expression(1 / SE),
y = expression(log(RR) / SE),
title = "Egger regression plot",
subtitle = bquote(
"Intercept:" ~ beta == .(beta_intercept) ~ "," ~ italic(p) == .(p_intercept)
)
) +
theme_classic(base_size = 14)
dev.off()## quartz_off_screen
## 2# Leave-one-out Egger test (exclude largest study)
library(dplyr)
# Identify largest study by precision
largest_id <- meta_model$data %>%
mutate(precision = 1 / SE) %>%
arrange(desc(precision)) %>%
slice(1) %>%
pull(ID)
# Re-run Egger regression excluding largest study
egger_loo_df <- meta_model$data %>%
filter(ID != largest_id) %>%
mutate(
y = logRR / SE,
x = 1 / SE
)
egger_loo <- lm(y ~ x, data = egger_loo_df)
summary(egger_loo)##
## Call:
## lm(formula = y ~ x, data = egger_loo_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.9274 -1.3437 0.4466 1.4590 4.7896
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.11476 0.49707 -2.243 0.0284 *
## x -0.02114 0.06048 -0.349 0.7279
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.38 on 64 degrees of freedom
## Multiple R-squared: 0.001905, Adjusted R-squared: -0.01369
## F-statistic: 0.1221 on 1 and 64 DF, p-value: 0.7279# Contour-enhanced funnel plot
library(metafor)
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Counter_funnel_alz.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
funnel(
meta_model,
yaxis = "sei",
xlab = "Log RR",
level=c(90, 95, 99),
refline = 0, legend = T
)
# legend(
# "topright",
# legend = c("p ≥ 0.10", "0.05 ≤ p < 0.10", "p < 0.05"),
# fill = c("white", "gray80", "gray60"),
# border = "black",
# bty = "n"
# )
dev.off()## quartz_off_screen
## 2# PET-PEESE
pet <- rma(
yi = logRR,
sei = SE,
mods = ~ SE,
data = meta_model$data,
method = "REML"
)
# PEESE model
peese <- rma(
yi = logRR,
sei = SE,
mods = ~ I(SE^2),
data = meta_model$data,
method = "REML"
)
summary(pet)##
## Mixed-Effects Model (k = 67; tau^2 estimator: REML)
##
## logLik deviance AIC BIC AICc
## -42.2616 84.5233 90.5233 97.0465 90.9167
##
## tau^2 (estimated amount of residual heterogeneity): 0.1287 (SE = 0.0306)
## tau (square root of estimated tau^2 value): 0.3588
## I^2 (residual heterogeneity / unaccounted variability): 91.84%
## H^2 (unaccounted variability / sampling variability): 12.25
## R^2 (amount of heterogeneity accounted for): 4.10%
##
## Test for Residual Heterogeneity:
## QE(df = 65) = 366.9636, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 1.0333, p-val = 0.3094
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1697 0.0863 -1.9678 0.0491 -0.3388 -0.0007 *
## SE -0.3677 0.3617 -1.0165 0.3094 -1.0765 0.3412
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(peese)##
## Mixed-Effects Model (k = 67; tau^2 estimator: REML)
##
## logLik deviance AIC BIC AICc
## -42.5576 85.1153 91.1153 97.6384 91.5087
##
## tau^2 (estimated amount of residual heterogeneity): 0.1353 (SE = 0.0318)
## tau (square root of estimated tau^2 value): 0.3679
## I^2 (residual heterogeneity / unaccounted variability): 93.05%
## H^2 (unaccounted variability / sampling variability): 14.38
## R^2 (amount of heterogeneity accounted for): 0.00%
##
## Test for Residual Heterogeneity:
## QE(df = 65) = 417.9984, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 0.0069, p-val = 0.9336
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.2372 0.0623 -3.8072 0.0001 -0.3594 -0.1151 ***
## I(SE^2) -0.0456 0.5480 -0.0833 0.9336 -1.1197 1.0284
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1### VASCULAR DEMENTIA
## ALZHEIMER'S DISEASE
## Loading datasets
#---------------------------------------------
# 1. Load your dataset
#---------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(meta)
library(dmetar)
data_vascular <- read_excel("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Data/Data_extraction_2026.xlsx",
sheet = "Vascular dementia studies", col_names = T)
data_vascular$non_leisure <- factor(data_vascular$`Only non-leisure-related PA (1= yes, 0=no)`)
data_vascular$work_pa <- factor(data_vascular$`Only work-related PA (1= yes, 0=no)`)
data_vascular$leisure <- factor(data_vascular$`Only leisure PA (1= yes, 0=no)`)
data_vascular$travel <- factor(data_vascular$`Only travel-related PA (1= yes, 0=no)`)
data_vascular$household <- factor(data_vascular$`Only household-related PA (1= yes, 0=no)`)
data_vascular$metting <- factor(data_vascular$`Physical activity recommendation (1= does not meet, 2= meets, missing value = not applicable)`)
data_vascular <- data_vascular %>%
subset(is.na(Ind_ID)==F)
#---------------------------------------------
# 2. Compute log-transformed RR and SE
#---------------------------------------------
data_vascular$SE = (log(data_vascular$`Upper limit (RR)`) - log(data_vascular$`Lower limit (RR)`)) / (2 * 1.96)
data_vascular$logRR <- log(data_vascular$RR)
data_vascular$SE <- data_vascular$`Standard error (SE)`
data_vascular$var <- data_vascular$SE^2
#---------------------------------------------
# 3. Run random-effects meta-analysis
#---------------------------------------------
meta_model <- rma.mv(yi = logRR,
V = var,
data = data_vascular,
random = ~1| ID/Ind_ID,
method = "REML")
#---------------------------------------------
# 4. Print results
#---------------------------------------------
summary(meta_model)##
## Multivariate Meta-Analysis Model (k = 28; method: REML)
##
## logLik Deviance AIC BIC AICc
## -6.9632 13.9263 19.9263 23.8138 20.9698
##
## Variance Components:
##
## estim sqrt nlvls fixed factor
## sigma^2.1 0.0852 0.2918 11 no ID
## sigma^2.2 0.0118 0.1087 28 no ID/Ind_ID
##
## Test for Heterogeneity:
## Q(df = 27) = 76.3124, p-val < .0001
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## -0.4045 0.1078 -3.7519 0.0002 -0.6159 -0.1932 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1library(dmetar)
i2 <- var.comp(meta_model)
summary(i2)## % of total variance I2
## Level 1 20.947440 ---
## Level 2 9.629279 9.63
## Level 3 69.423282 69.42
## Total I2: 79.05%# Prepare data
egger_df <- meta_model$data %>%
mutate(
y = logRR / SE,
x = 1 / SE
)
# Fit Egger regression
egger_lm <- lm(y ~ x, data = egger_df)
egger_sum <- summary(egger_lm)
egger_sum##
## Call:
## lm(formula = y ~ x, data = egger_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.0508 -0.8869 0.0252 1.1631 2.5938
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.42657 0.65766 -2.169 0.0394 *
## x -0.03259 0.10399 -0.313 0.7565
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.576 on 26 degrees of freedom
## Multiple R-squared: 0.003763, Adjusted R-squared: -0.03455
## F-statistic: 0.09821 on 1 and 26 DF, p-value: 0.7565# Extract intercept beta and p-value
beta_intercept <- round(egger_sum$coefficients[1, 1], 3)
p_intercept <- signif(egger_sum$coefficients[1, 4], 3)
# Plot
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Egger_vascular.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
ggplot(egger_df, aes(x = x, y = y)) +
geom_point(size = 2, alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE, linewidth = 1) +
labs(
x = expression(1 / SE),
y = expression(log(RR) / SE),
title = "Egger regression plot",
subtitle = bquote(
"Intercept:" ~ beta == .(beta_intercept) ~ "," ~ italic(p) == .(p_intercept)
)
) +
theme_classic(base_size = 14)
dev.off()## quartz_off_screen
## 2# Leave-one-out Egger test (exclude largest study)
library(dplyr)
# Identify largest study by precision
largest_id <- meta_model$data %>%
mutate(precision = 1 / SE) %>%
arrange(desc(precision)) %>%
slice(1) %>%
pull(ID)
# Re-run Egger regression excluding largest study
egger_loo_df <- meta_model$data %>%
filter(ID != largest_id) %>%
mutate(
y = logRR / SE,
x = 1 / SE
)
egger_loo <- lm(y ~ x, data = egger_loo_df)
summary(egger_loo)##
## Call:
## lm(formula = y ~ x, data = egger_loo_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.3749 -0.8541 0.0758 1.0132 2.6878
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.7327 0.7940 -0.923 0.368
## x -0.2350 0.1673 -1.405 0.177
##
## Residual standard error: 1.579 on 18 degrees of freedom
## Multiple R-squared: 0.09885, Adjusted R-squared: 0.04879
## F-statistic: 1.974 on 1 and 18 DF, p-value: 0.177# Contour-enhanced funnel plot
library(metafor)
tiff("~/Desktop/Projetos/Domain-specific PA - meta-analysis/Meta-analysis/Analysis/Counter_funnel_vascular.tiff",
units = "in", width = 12, height = 10, res = 300, compression = "lzw")
funnel(
meta_model,
yaxis = "sei",
xlab = "Log RR",
level=c(90, 95, 99),
refline = 0, legend = T
)
# legend(
# "topright",
# legend = c("p ≥ 0.10", "0.05 ≤ p < 0.10", "p < 0.05"),
# fill = c("white", "gray80", "gray60"),
# border = "black",
# bty = "n"
# )
dev.off()## quartz_off_screen
## 2# PET-PEESE
pet <- rma(
yi = logRR,
sei = SE,
mods = ~ SE,
data = meta_model$data,
method = "REML"
)
# PEESE model
peese <- rma(
yi = logRR,
sei = SE,
mods = ~ I(SE^2),
data = meta_model$data,
method = "REML"
)
summary(pet)##
## Mixed-Effects Model (k = 28; tau^2 estimator: REML)
##
## logLik deviance AIC BIC AICc
## -7.2716 14.5432 20.5432 24.3175 21.6341
##
## tau^2 (estimated amount of residual heterogeneity): 0.0396 (SE = 0.0200)
## tau (square root of estimated tau^2 value): 0.1991
## I^2 (residual heterogeneity / unaccounted variability): 61.08%
## H^2 (unaccounted variability / sampling variability): 2.57
## R^2 (amount of heterogeneity accounted for): 13.66%
##
## Test for Residual Heterogeneity:
## QE(df = 26) = 64.6184, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 8.0866, p-val = 0.0045
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.0171 0.1057 -0.1619 0.8714 -0.2243 0.1901
## SE -1.4913 0.5244 -2.8437 0.0045 -2.5192 -0.4635 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(peese)##
## Mixed-Effects Model (k = 28; tau^2 estimator: REML)
##
## logLik deviance AIC BIC AICc
## -6.4029 12.8057 18.8057 22.5800 19.8966
##
## tau^2 (estimated amount of residual heterogeneity): 0.0382 (SE = 0.0194)
## tau (square root of estimated tau^2 value): 0.1953
## I^2 (residual heterogeneity / unaccounted variability): 60.41%
## H^2 (unaccounted variability / sampling variability): 2.53
## R^2 (amount of heterogeneity accounted for): 16.87%
##
## Test for Residual Heterogeneity:
## QE(df = 26) = 63.5460, p-val < .0001
##
## Test of Moderators (coefficient 2):
## QM(df = 1) = 9.5743, p-val = 0.0020
##
## Model Results:
##
## estimate se zval pval ci.lb ci.ub
## intrcpt -0.1716 0.0627 -2.7388 0.0062 -0.2944 -0.0488 **
## I(SE^2) -2.5786 0.8333 -3.0942 0.0020 -4.2119 -0.9452 **
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1