Revision 3029b5c1950544c9d60307f9ae18f41982db2abe authored by didacvp on 28 December 2020, 12:14:46 UTC, committed by GitHub on 28 December 2020, 12:14:46 UTC
1 parent 15058a5
BrainAge_VidalPineiro_UKB_Tests.Rmd
---
title"BrainAge_VidalPineiro_Tests(early life v. aging) (XGB & LASSO)"
author: "dvp"
date: "11/2/2020"
output:
html_document: default
pdf_document: default
---
# Setup
```{r setup, include=FALSE}
#install.packages("~/R/imported_packages/3.6.0/itsadug_2.3.tar.gz", repos = NULL, type = "source")
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(magrittr)
library(lme4)
library(mgcv)
library(GGally)
library(itsadug)
library(lavaan)
library(reshape2)
library(lmerTest)
data_folder=file.path("./data/BrainAge",paste0("noExcl_scaled"))
options(bitmapType = "cairo")
# update non-MRI data
raw_folder="./data-raw/BrainAge/UKB/tabulated_data"
```
# Loading data and common Preproc
load data
```{r load}
load(file.path(data_folder, "ResultsBrainAge_XGB_LASSO.Rda"))
df.update = read.csv(file.path(raw_folder, "ID_all_earlylife.csv"))
df.update = df.update[,!names(df.update) %in% names(df.Test)[-1]]
df.Test %<>% left_join(., df.update)
tmp = df.Test %>% group_by(eid) %>% summarise(AgeBsl = min(age, na.rm = T))
# compute age at Bsl
df.Test = left_join(df.Test, tmp) %>%
mutate(Time = age - AgeBsl,
BAc = age + BAG_corr_gam, # BA (corrected) # we use GAM_corrected as default
LASSO.BAc = age + LASSO.BAG_corr_gam, # BA (corrected) # we use GAM_corrected as default
Center = UK_Biobank_assessment_centre_c_54.3.0,
BirthWeight_unf = if_else(is.na(Birth_weight_c_20022.1.0),
Birth_weight_c_20022.0.0,
Birth_weight_c_20022.1.0),
MultipleBirth = if_else(is.na(Part_of_a_multiple_birth_c_1777.1.0),
Part_of_a_multiple_birth_c_1777.0.0,
Part_of_a_multiple_birth_c_1777.1.0),
BirthWeightNormal = if_else(BirthWeight_unf < 2.5 | BirthWeight_unf > 4.5,NaN, BirthWeight_unf))
```
# 1) Aging Hypothesis
###Prepare data
```{r pivot_wider}
# Select Variables of Interest
tmp = df.Test %>%
dplyr::select(eid,
age,
wave,
AgeBsl,
sex,
Center.Newcastle,
eICV,
LASSO.BAG_corr_gam,
BAG_corr_gam)
df.Test.long = pivot_wider(tmp,
names_from = wave,
values_from = c(age, LASSO.BAG_corr_gam, BAG_corr_gam,eICV)) %>%
mutate(Time = age_2 - age_1,
eICV = .5*(eICV_1 + eICV_2),
LASSO.BAG_change_T = (LASSO.BAG_corr_gam_2 - LASSO.BAG_corr_gam_1)/(Time),
BAG_change_T = (BAG_corr_gam_2 - BAG_corr_gam_1)/(Time),
LASSO.BAG_mean = .5*(LASSO.BAG_corr_gam_2 + LASSO.BAG_corr_gam_1),
BAG_mean = .5*(BAG_corr_gam_2 + BAG_corr_gam_1))
```
### a) Correlation between T1 and T2 delta
```{r BrainAging with Time}
cor(df.Test.long$BAG_corr_gam_2,df.Test.long$BAG_corr_gam_1)
#cor(df.Test.long$LASSO.BAG_corr_gam_2,df.Test.long$LASSO.BAG_corr_gam_1) # Same for LASSO if wanted
#cor(df.Test$BAG_corr_gam,df.Test$LASSO.BAG_corr_gam) # correlation between LASSO and XGB
ggplot(df.Test.long, aes(BAG_corr_gam_2, BAG_corr_gam_1)) +
geom_point() +
geom_smooth(method = "lm", color = "blue") +
geom_smooth(color = "red") +
geom_abline(intercept = 0,
slope = 1,
colour = "grey60",
linetype = 4)
```
### b) mean Brain aging GAP (GAP) predicts brain aging?
```{r Brain aging to aging2}
#Does the Brain Aging GAP predict Aging?
## BAG (Brain Age Gap bias-corrected at tp1 predicts less Brain Aging Change with time)
lm.pred = lm(BAG_change_T ~ BAG_mean + AgeBsl + sex + scale(eICV) + Center.Newcastle, data = df.Test.long)
summary(lm.pred)
lm.pred.LASSO = lm(LASSO.BAG_change_T ~ LASSO.BAG_mean + AgeBsl + sex + scale(eICV) + Center.Newcastle, data = df.Test.long)
summary(lm.pred.LASSO)
```
```{r Plot Figure 2a-b. Brain Age to Brain Aging}
colorscale <- c('#edf8fb','#ccece6','#99d8c9','#66c2a4','#2ca25f','#006d2c')
#colorscale = c('#edf8fb','#bfd3e6','#9ebcda','#8c96c6','#8856a7','#810f7c')
#"#66a61e" "#1b9e77"
# UKB - Extreme Bossting
gs = ggplot(data = df.Test.long,
mapping = aes(x = BAG_mean,
y = BAG_change_T)) +
geom_point(shape = 21, color = "black", fill = "#66a61e", size = 4, stroke = 1.5) +
geom_smooth(method = "lm",
color = "#1b9e77",
size = 3) +
theme_classic() +
theme(legend.position = 'none',
axis.text = element_text(size = 16),
axis.title = element_text(size = 20),
plot.title = element_text(size = 20, hjust = 0.5, vjust = 0)) +
ylab(expression(paste(Delta,"Brain Age Delta"))) +
xlab("Brain Age Delta (mean)") +
ggtitle("UKB - XGB")
ggsave("figures/BrainAge_XGB.png",
dpi = 500,
plot = gs,
width = 10,
height = 10,
units = "cm")
# UKB - LASSO
gs = ggplot(data = df.Test.long,
mapping = aes(x = LASSO.BAG_mean,
y = LASSO.BAG_change_T)) +
geom_point(shape = 21, color = "black", fill = "#66a61e", size = 4, stroke = 1.5) +
geom_smooth(method = "lm",
color = "#1b9e77",
size = 3) +
theme_classic() +
theme(legend.position = 'none',
axis.text = element_text(size = 16),
axis.title = element_text(size = 20),
plot.title = element_text(size = 20, hjust = 0.5, vjust = 0)) +
ylab(expression(paste(Delta,"Brain Age Delta"))) +
xlab("Brain Age Delta (mean)") +
ggtitle("UKB - LASSO")
ggsave("figures/BrainAge_LASSO.png",
dpi = 500,
plot = gs,
width = 10,
height = 10,
units = "cm")
```
# 2) Early life
### a) main test
```{r lme BirthWeight Normal}
# info with birth weight in the test sample
sum(!is.na(df.Test$BirthWeightNormal))/2
sum(!is.na(df.Test$BirthWeight_unf))/2
lm.main = lmer(BAG_corr_gam ~ Time*BirthWeightNormal + AgeBsl + sex + scale(eICV) + Center.Newcastle + (1 | eid), data = df.Test, REML = T)
summary(lm.main)
lm.no_mb = lmer(BAG_corr_gam ~ Time*BirthWeightNormal + AgeBsl + sex + scale(eICV) + Center.Newcastle + (1 | eid), data = df.Test %>% filter(MultipleBirth == 0), REML = T)
summary(lm.no_mb)
lm.LASSO = lmer(LASSO.BAG_corr_gam ~ Time*BirthWeightNormal + AgeBsl + sex + scale(eICV) + Center.Newcastle + (1 | eid), data = df.Test, REML = T)
summary(lm.LASSO)
# UKB - Extreme Bossting
gs = ggplot(data = df.Test %>% filter(wave == 1),
mapping = aes(x = BirthWeightNormal,
y = BAG_corr_gam)) +
geom_point(shape = 21, color = "black", fill = '#810f7c', size = 4, stroke = 1.5) +
geom_smooth(method = "lm",
color = '#8856a7',
size = 3) +
theme_classic() +
theme(legend.position = 'none',
axis.text = element_text(size = 16),
axis.title = element_text(size = 20),
plot.title = element_text(size = 20, hjust = 0.5, vjust = 0)) +
ylab("Brain Age Delta") +
xlab("Birth Weight") +
ggtitle("UKB - XGB")
ggsave("figures/BirthWeight_XGB.png",
dpi = 500,
plot = gs,
width = 10,
height = 10,
units = "cm")
# UKB - LASSO
gs = ggplot(data = df.Test %>% filter(wave == 1),
mapping = aes(x = BirthWeightNormal,
y = LASSO.BAG_corr_gam)) +
geom_point(shape = 21, color = "black", fill = '#810f7c', size = 4, stroke = 1.5) +
geom_smooth(method = "lm",
color = '#8856a7',
size = 3) +
theme_classic() +
theme(legend.position = 'none',
axis.text = element_text(size = 16),
axis.title = element_text(size = 20),
plot.title = element_text(size = 20, hjust = 0.5, vjust = 0)) +
ylab("Brain Age Delta") +
xlab("Birth Weight") +
ggtitle("UKB - LASSO")
ggsave("figures/BirthWeight_LASSO.png",
dpi = 500,
plot = gs,
width = 10,
height = 10,
units = "cm")
```
### b) robust birt weight
```{r Birth Weight grid}
BW.range = df.Test$BirthWeight_unf %>% range(., na.rm = T)
lpf = seq(round(BW.range[1],1), 2.7, by = .025)
hpf = seq(4.2, signif(BW.range[2],2), by = .025)
# horrible code :(
if (!file.exists(file.path(data_folder, "ResultsBirthWeightGrid.Rda"))) {
df.grid = NULL
for (i in lpf) {
for (j in hpf) {
tmp = lmer(BAG_corr_gam ~ Time*BirthWeight_unf + AgeBsl + sex + scale(eICV) + Center.Newcastle + (1 | eid),
data = df.Test %>% filter(BirthWeight_unf > i & BirthWeight_unf < j),
REML = T)
tmp.2 = summary(tmp)$coefficients
df.grxd = rbind(df.grid, c(tmp.2[rownames(tmp.2) == "BirthWeight_unf",],lpf=i,hpf=j))
}
}
df.grid %<>% as.data.frame()
names(df.grid)[5] = "p.value"
df.grid %<>% mutate(Estimate.filt = if_else(p.value <.05, Estimate, NaN))
save(df.grid, file = file.path(data_folder, "ResultsBirthWeightGrid.Rda"))
} else {
load(file.path(data_folder, "ResultsBirthWeightGrid.Rda"))
}
gs = ggplot(df.grid, aes(x =lpf, y =hpf)) +
geom_raster(mapping = aes(fill = Estimate))+
scale_fill_viridis_c(limits = c(min(df.grid$Estimate),0)) +
scale_x_continuous(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0)) +
theme_classic() +
theme(axis.text = element_text(size = 16),
axis.title = element_text(size = 20),
plot.title = element_text(size = 20, hjust = 0.5, vjust = 0)) +
xlab("min Birth Weight") +
ylab("max Birth Weight")
ggsave("figures/BirthWeight_grid.png",
dpi = 500,
plot = gs,
width = 10,
height = 10,
units = "cm")
```
Computing file changes ...