ADNI Multiband | PET Analysis
Motivation:
This project is designed to relate multishell imaging derived from diffusion spectrum imaging to positron emission tomography. We suspect that the finer resolution e.g., the modeling of neurites with the NODDI model will map closely onto PET derived measures of neurofibrillary tangles (Tau) and plagues (Amyloid). This notbook presents two approaches. First, after identifying the PET scans that occur closest in time to the multishell data, we present simple corelations between sets of regions across individuals. The correlations are corrected for multiple comparisons using the FDR correction method. We also present a two-table PLS analysis for each comparison allowing us to see the regions that covary by modality with the overall component. This last analysis generates a component or “LV” score which can be used to predict behaviour, we used the summary factor scores of executive function and memory provided with the ADNI dataset.
Finally, we use mediation and path modelling (from the psych package in R) to examine the unique contributions of the multishell data beyond PET derived measures for predicting behaviour.
Overall, we find that the orientation dispersion index is more closely relate to amyloid burden than tau, and that fISO seems to map onto tau more, particularly in regions traditionally noted to be vulnerable to Alzheimer’s disease. fISO was also a robust preditor of memory and executive function.
Merging and Matching:
Clean up the dates using the lubridate package (dates are entered in two formats, we want one)
Merge the neuropsychological data to the cortical thickness data (everyone should have a volume)
##
## Attaching package: 'data.table'
## The following object is masked from 'package:purrr':
##
## transpose
## The following objects are masked from 'package:reshape2':
##
## dcast, melt
## The following objects are masked from 'package:lubridate':
##
## hour, isoweek, mday, minute, month, quarter, second, wday, week,
## yday, year
## The following objects are masked from 'package:dplyr':
##
## between, first, last
Demographic data
(for all individuals with both multishell and PET data, N = 68)
AD |
CN |
MCI |
Overall |
|||||
|---|---|---|---|---|---|---|---|---|
| F (n=3) |
M (n=2) |
F (n=28) |
M (n=11) |
F (n=8) |
M (n=16) |
F (n=39) |
M (n=29) |
|
| MB_age | ||||||||
| Mean (SD) | 75.3 (6.30) | 81.6 (3.11) | 74.4 (8.36) | 74.3 (8.40) | 72.7 (7.61) | 74.2 (5.85) | 74.2 (7.94) | 74.7 (6.89) |
| Median [Min, Max] | 75.0 [69.1, 81.7] | 81.6 [79.4, 83.8] | 73.3 [62.0, 90.3] | 76.5 [65.3, 90.2] | 72.7 [60.3, 86.4] | 73.7 [65.2, 91.3] | 74.0 [60.3, 90.3] | 73.9 [65.2, 91.3] |
| ADNI_EF | ||||||||
| Mean (SD) | -1.36 (1.12) | -0.864 (0.00919) | 1.03 (0.859) | 1.21 (0.758) | 0.395 (1.31) | 0.694 (0.827) | 0.716 (1.16) | 0.781 (0.917) |
| Median [Min, Max] | -1.86 [-2.14, -0.0780] | -0.864 [-0.870, -0.857] | 0.964 [-0.532, 2.99] | 1.21 [-0.657, 2.40] | 0.375 [-2.03, 2.00] | 0.705 [-0.658, 2.40] | 0.814 [-2.14, 2.99] | 1.01 [-0.870, 2.40] |
| ADNI_MEM | ||||||||
| Mean (SD) | -1.18 (0.742) | -1.11 (0.0940) | 0.946 (0.535) | 0.577 (0.398) | 0.734 (0.764) | 0.377 (0.551) | 0.739 (0.813) | 0.351 (0.626) |
| Median [Min, Max] | -1.59 [-1.63, -0.321] | -1.11 [-1.17, -1.04] | 0.937 [0.0340, 1.99] | 0.588 [-0.247, 1.25] | 1.05 [-0.472, 1.56] | 0.414 [-0.456, 1.26] | 0.933 [-1.63, 1.99] | 0.499 [-1.17, 1.26] |
## Warning in melt(fISO2, id.vars = c("RID"), variable.name = "ROI", value.name
## = "fISO"): The melt generic in data.table has been passed a tbl_df and will
## attempt to redirect to the relevant reshape2 method; please note that reshape2
## is deprecated, and this redirection is now deprecated as well. To continue using
## melt methods from reshape2 while both libraries are attached, e.g. melt.list,
## you can prepend the namespace like reshape2::melt(fISO2). In the next version,
## this warning will become an error.
## Warning in melt(ODI2, id.vars = c("RID"), variable.name = "ROI", value.name
## = "ODI"): The melt generic in data.table has been passed a tbl_df and will
## attempt to redirect to the relevant reshape2 method; please note that reshape2
## is deprecated, and this redirection is now deprecated as well. To continue using
## melt methods from reshape2 while both libraries are attached, e.g. melt.list,
## you can prepend the namespace like reshape2::melt(ODI2). In the next version,
## this warning will become an error.
## Warning in melt(MB_AMY_PVC_AMY, id.vars = c("RID"), variable.name = "ROI", :
## The melt generic in data.table has been passed a spec_tbl_df and will attempt
## to redirect to the relevant reshape2 method; please note that reshape2 is
## deprecated, and this redirection is now deprecated as well. To continue using
## melt methods from reshape2 while both libraries are attached, e.g. melt.list,
## you can prepend the namespace like reshape2::melt(MB_AMY_PVC_AMY). In the next
## version, this warning will become an error.
## Warning in melt(MB_TAU_PVC_TAU, id.vars = c("RID"), variable.name = "ROI", :
## The melt generic in data.table has been passed a spec_tbl_df and will attempt
## to redirect to the relevant reshape2 method; please note that reshape2 is
## deprecated, and this redirection is now deprecated as well. To continue using
## melt methods from reshape2 while both libraries are attached, e.g. melt.list,
## you can prepend the namespace like reshape2::melt(MB_TAU_PVC_TAU). In the next
## version, this warning will become an error.
## Warning in melt(CT, id.vars = c("RID"), variable.name = "ROI", value.name =
## "CT"): The melt generic in data.table has been passed a spec_tbl_df and will
## attempt to redirect to the relevant reshape2 method; please note that reshape2
## is deprecated, and this redirection is now deprecated as well. To continue using
## melt methods from reshape2 while both libraries are attached, e.g. melt.list,
## you can prepend the namespace like reshape2::melt(CT). In the next version, this
## warning will become an error.
fISO & Tau
Correlations
correlation values shown are with corrected p-values
Note that the regions correlate most highly in the temporal, subcortical, and posterior cingulate regions. These map on to the pathway of Alzheimer’s dementia quite nicely.
PLS Modeling
LV1, significance = 0.002, explained variance is 87.04%
ODI & Tau
Correlations
correlation values shown are with corrected p-values
PLS Modeling
LV1, significance = 0.021, explained variance is 72.64%
For the above analysis, ODI seems to map onto attention regions similar to the frontoparietal network, while Tau continues to trace the temporal regions consistent with the progression of AD.
fISO & Amyloid
Correlations
correlation values shown are with corrected p-values
PLS Modeling
LV1, significance = 0.029, explained variance is 86.99%
ODI & Amyloid
Correlations
correlation values shown are with corrected p-values
PLS Modeling
LV1, significance = 0.017, explained variance is 90.1%
ODI and amyloid seem to be quite strongly correlated, and more widely distributed across the cortex than either fISO or Tau which appear to be much more regionally (and perhaps diagnostically) specific.
Mediation Analysis
We need to think about this a bit more since there are multiple ways this could be modelled. Nonetheless, a fISO seems to be more closely related to Tau, ODI to amyloid, and Tau and fISO explain the most in terms of behavioural performance.
“Regarding the mediation/modeling, I think the idea was to try different causal models such as how much each Tau or Amyloid explain cognition alone and then adding the other measures one after another to see if the model improves (e.g. for Tau adding 1) Amy, then 2) Amy and fISO, then 3) Amy, fISO and CT and see if adding variables improve the fit). Right? But I agree, we 3 should have a brief meeting in person to discuss the models we want to try.”
source(here::here("final","functions.R"))
fISO_TAU_CT <- subset(All_Long_Tau, select = c("RID", "ROI","fISO","TAU","CT")) %>%
melt(., id.vars=c("RID", "ROI"))## Warning in melt(., id.vars = c("RID", "ROI")): The melt generic in data.table
## has been passed a data.frame and will attempt to redirect to the relevant
## reshape2 method; please note that reshape2 is deprecated, and this redirection
## is now deprecated as well. To continue using melt methods from reshape2 while
## both libraries are attached, e.g. melt.list, you can prepend the namespace like
## reshape2::melt(.). In the next version, this warning will become an error.
fISO_L <- subset(fISO_TAU_CT, variable =="fISO")
fISO_Tau_Wide <- dcast(fISO_TAU_CT, RID ~ ROI + variable)## Warning in dcast(fISO_TAU_CT, RID ~ ROI + variable): The dcast generic
## in data.table has been passed a data.frame and will attempt to redirect
## to the reshape2::dcast; please note that reshape2 is deprecated, and this
## redirection is now deprecated as well. Please do this redirection yourself like
## reshape2::dcast(fISO_TAU_CT). In the next version, this warning will become an
## error.
#remove the empty columns (e.g., ROIs which don't have values)
emptycols <- sapply(fISO_Tau_Wide, function (k) all(is.na(k)))
fISO_Tau_Wide <- fISO_Tau_Wide[!emptycols]
#also remove brain-stem, accumbens and cerebellum
#fISO_Tau_Wide <- fISO_Tau_Wide %>% dplyr::select(-BRAIN_STEM_fISO, -BRAIN_STEM_TAU, -ACCUMBENS_LEFT_fISO, -ACCUMBENS_LEFT_TAU, -ACCUMBENS_RIGHT_fISO, -ACCUMBENS_RIGHT_TAU, -CEREBELLUM_LEFT_fISO, -CEREBELLUM_RIGHT_fISO,-BRAIN_STEM_ODI, -ACCUMBENS_LEFT_ODI, -ACCUMBENS_RIGHT_ODI, -CEREBELLUM_LEFT_ODI, -CEREBELLUM_RIGHT_ODI)
#... and the empty rows (participants who don't have values)
fISO_Tau_Wide <- fISO_Tau_Wide[complete.cases(fISO_Tau_Wide), ]
ID_Vars <- fISO_Tau_Wide %>% dplyr::select(RID)
#now create separate matrices for each | Note these do not have to have the same dimensions
fISO <- fISO_Tau_Wide %>% dplyr:: select(ends_with("_fISO"))%>%
rename_at(vars(ends_with("_fISO")), funs(str_replace(., "_fISO", "")))
fISO_w_ID <- cbind(ID_Vars, fISO)
ODI <- fISO_Tau_Wide %>% dplyr:: select(ends_with("_ODI"))%>%
rename_at(vars(ends_with("_ODI")), funs(str_replace(., "_ODI", "")))
ODI_w_ID <- cbind(ID_Vars, ODI)
Amy <- fISO_Tau_Wide %>% dplyr:: select(ends_with("_AMY"))%>%
rename_at(vars(ends_with("_AMY")), funs(str_replace(., "_AMY", "")))
Amy_w_ID <- cbind(ID_Vars, Amy)
Tau <- fISO_Tau_Wide %>% dplyr:: select(ends_with("_TAU"))%>%
rename_at(vars(ends_with("_TAU")), funs(str_replace(., "_TAU", "")))
Tau_w_ID <- cbind(ID_Vars, Tau)
CT <- fISO_Tau_Wide %>% dplyr:: select(ends_with("_CT"))%>%
rename_at(vars(ends_with("_CT")), funs(str_replace(., "_CT", "")))
CT_w_ID <- cbind(ID_Vars, CT)CT_data <- sapply( CT, as.numeric )
fISO_data <- sapply( fISO, as.numeric )
TAU_data <- sapply( Tau, as.numeric )
#ODI_data <- sapply(ODI, as.numeric)
#AMY_data <-sapply(Amy, as.numeric)fISO.pca = PCA(fISO_data, scale.unit=TRUE, ncp=2, graph=F)
CT.pca = PCA(CT_data, scale.unit=TRUE, ncp=2, graph=F)
Tau.pca = PCA(TAU_data, scale.unit=TRUE, ncp=2, graph=F)
#Amy.pca = PCA(AMY_data, scale.unit=TRUE, ncp=2, graph=F)
#ODI.pca = PCA(ODI_data, scale.unit=TRUE, ncp=2, graph=F)
NP <- subset(All_Long, select = c("RID", "ADNI_MEM","ADNI_EF")) %>%
distinct(., RID,ADNI_MEM, .keep_all= TRUE) %>%
merge(ID_Vars, all.y = TRUE)
##########################################################
# Extract the principal component scores #
##########################################################
fISO_PC <- fISO.pca$ind$coord[,1]
Tau_PC <- Tau.pca$ind$coord[,1]
#Amy_PC <- Amy.pca$ind$coord[,1]
CT_PC <- CT.pca$ind$coord[,1]
#ODI_PC <-ODI.pca$ind$coord[,1]
PC_ID <- CT_w_ID$RID
PCs <- as.data.frame(cbind(PC_ID,NP$ADNI_MEM, NP$ADNI_EF, fISO_PC, Tau_PC, CT_PC))
colnames(PCs) <- c("RID", "MEMORY","Executive_Function", "fISO_PC", "Tau_PC", "CT_PC")
PCs$Tau_PC_Log <- log10(PCs$Tau_PC + 7)
library(psych)
mod4.4 <- psych::mediate(Executive_Function ~ Tau_PC + (CT_PC) + (fISO_PC), data =PCs)##
## Mediation/Moderation Analysis
## Call: psych::mediate(y = Executive_Function ~ Tau_PC + (CT_PC) + (fISO_PC),
## data = PCs)
##
## The DV (Y) was Executive_Function . The IV (X) was Tau_PC . The mediating variable(s) = CT_PC fISO_PC .
##
## Total effect(c) of Tau_PC on Executive_Function = -0.09 S.E. = 0.02 t = -4.57 df= 53 with p = 2.9e-05
## Direct effect (c') of Tau_PC on Executive_Function removing CT_PC fISO_PC = -0.08 S.E. = 0.11 t = 8.75 df= 50 with p = 1.2e-11
## Indirect effect (ab) of Tau_PC on Executive_Function through CT_PC fISO_PC = -0.01
## Mean bootstrapped indirect effect = -0.01 with standard error = 0.01 Lower CI = -0.04 Upper CI = 0.01
## R = 0.62 R2 = 0.39 F = 10.46 on 3 and 50 DF p-value: 3.11e-06
##
## To see the longer output, specify short = FALSE in the print statement or ask for the summary
##
## Mediation/Moderation Analysis
## Call: psych::mediate(y = Executive_Function ~ Tau_PC + (fISO_PC), data = PCs)
##
## The DV (Y) was Executive_Function . The IV (X) was Tau_PC . The mediating variable(s) = fISO_PC .
##
## Total effect(c) of Tau_PC on Executive_Function = -0.09 S.E. = 0.02 t = -4.57 df= 53 with p = 2.9e-05
## Direct effect (c') of Tau_PC on Executive_Function removing fISO_PC = -0.07 S.E. = 0.11 t = 8.74 df= 51 with p = 1e-11
## Indirect effect (ab) of Tau_PC on Executive_Function through fISO_PC = -0.02
## Mean bootstrapped indirect effect = -0.02 with standard error = 0.01 Lower CI = -0.04 Upper CI = 0
## R = 0.61 R2 = 0.37 F = 15.09 on 2 and 51 DF p-value: 3.73e-07
##
## To see the longer output, specify short = FALSE in the print statement or ask for the summary
Now to test a general additive linear model (from the JAMOVI package)
PCs_New <- PCs
PCs_New$Tau_PC <- c(scale(PCs_New$Tau_PC,scale = TRUE, center = TRUE))
PCs_New$CT_PC <- c(scale(PCs_New$CT_PC,scale = TRUE, center = TRUE))
PCs_New$fISO_PC <- c(scale(PCs_New$fISO_PC,scale = TRUE, center = TRUE))
AA <- lm(Executive_Function ~ Tau_PC + fISO_PC +Tau_PC:fISO_PC + CT_PC , data =PCs_New)
summary(AA)##
## Call:
## lm(formula = Executive_Function ~ Tau_PC + fISO_PC + Tau_PC:fISO_PC +
## CT_PC, data = PCs_New)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.36449 -0.61896 -0.03576 0.62263 1.69364
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.94944 0.11392 8.334 5.92e-11 ***
## Tau_PC -0.37590 0.15161 -2.479 0.01665 *
## fISO_PC -0.40578 0.14404 -2.817 0.00697 **
## CT_PC -0.16740 0.15037 -1.113 0.27104
## Tau_PC:fISO_PC -0.06448 0.10701 -0.603 0.54956
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7817 on 49 degrees of freedom
## Multiple R-squared: 0.3901, Adjusted R-squared: 0.3403
## F-statistic: 7.835 on 4 and 49 DF, p-value: 5.788e-05
##
## Call:
## lm(formula = MEMORY ~ Tau_PC + fISO_PC + Tau_PC:fISO_PC + CT_PC,
## data = PCs_New)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.04051 -0.43967 -0.06592 0.32256 1.30726
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.68944 0.08294 8.312 6.39e-11 ***
## Tau_PC -0.04316 0.11038 -0.391 0.6975
## fISO_PC -0.27336 0.10487 -2.607 0.0121 *
## CT_PC -0.04670 0.10948 -0.427 0.6716
## Tau_PC:fISO_PC -0.19631 0.07791 -2.520 0.0150 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5691 on 49 degrees of freedom
## Multiple R-squared: 0.3747, Adjusted R-squared: 0.3236
## F-statistic: 7.34 on 4 and 49 DF, p-value: 0.0001028
##Now looking at JUST Tau, fISO, and CT (should have 54 subjects)
source(here::here("final","functions.R"))
fISO_TAU_CT <- subset(All_Long, select = c("RID", "ROI","fISO","TAU","CT")) %>%
melt(., id.vars=c("RID", "ROI"))## Warning in melt(., id.vars = c("RID", "ROI")): The melt generic in data.table
## has been passed a data.frame and will attempt to redirect to the relevant
## reshape2 method; please note that reshape2 is deprecated, and this redirection
## is now deprecated as well. To continue using melt methods from reshape2 while
## both libraries are attached, e.g. melt.list, you can prepend the namespace like
## reshape2::melt(.). In the next version, this warning will become an error.
fISO_L <- subset(fISO_TAU_CT, variable =="fISO")
fISO_Tau_Wide <- dcast(fISO_TAU_CT, RID ~ ROI + variable)## Warning in dcast(fISO_TAU_CT, RID ~ ROI + variable): The dcast generic
## in data.table has been passed a data.frame and will attempt to redirect
## to the reshape2::dcast; please note that reshape2 is deprecated, and this
## redirection is now deprecated as well. Please do this redirection yourself like
## reshape2::dcast(fISO_TAU_CT). In the next version, this warning will become an
## error.
#remove the empty columns (e.g., ROIs which don't have values)
emptycols <- sapply(fISO_Tau_Wide, function (k) all(is.na(k)))
fISO_Tau_Wide <- fISO_Tau_Wide[!emptycols]
#also remove brain-stem, accumbens and cerebellum
#fISO_Tau_Wide <- fISO_Tau_Wide %>% dplyr::select(-BRAIN_STEM_fISO, -BRAIN_STEM_TAU, -ACCUMBENS_LEFT_fISO, -ACCUMBENS_LEFT_TAU, -ACCUMBENS_RIGHT_fISO, -ACCUMBENS_RIGHT_TAU, -CEREBELLUM_LEFT_fISO, -CEREBELLUM_RIGHT_fISO)
#... and the empty rows (participants who don't have values)
fISO_Tau_Wide <- fISO_Tau_Wide[complete.cases(fISO_Tau_Wide), ]
ID_Vars <- fISO_Tau_Wide %>% dplyr::select(RID)
#now create separate matrices for each | Note these do not have to have the same dimensions
fISO <- fISO_Tau_Wide %>% dplyr:: select(ends_with("_fISO"))%>%
rename_at(vars(ends_with("_fISO")), funs(str_replace(., "_fISO", "")))
fISO_w_ID <- cbind(ID_Vars, fISO)
Tau <- fISO_Tau_Wide %>% dplyr:: select(ends_with("_TAU"))%>%
rename_at(vars(ends_with("_TAU")), funs(str_replace(., "_TAU", "")))
Tau_w_ID <- cbind(ID_Vars, Tau)
CT <- fISO_Tau_Wide %>% dplyr:: select(ends_with("_CT"))%>%
rename_at(vars(ends_with("_CT")), funs(str_replace(., "_CT", "")))
CT_w_ID <- cbind(ID_Vars, CT)
CT_data <- sapply( CT, as.numeric )
fISO_data <- sapply( fISO, as.numeric )
TAU_data <- sapply( Tau, as.numeric )PCAs for fISO and Tau (and CT)
fISO.pca = PCA(fISO_data, scale.unit=TRUE, ncp=2, graph=F)
CT.pca = PCA(CT_data, scale.unit=TRUE, ncp=2, graph=F)
Tau.pca = PCA(TAU_data, scale.unit=TRUE, ncp=2, graph=F)
NP <- subset(All_Long, select = c("RID", "ADNI_MEM","ADNI_EF")) %>%
distinct(., RID,ADNI_MEM, .keep_all= TRUE) %>%
merge(ID_Vars, all.y = TRUE)
##########################################################
# Extract the principal component scores #
##########################################################
fISO_PC <- fISO.pca$ind$coord[,1]
Tau_PC <- Tau.pca$ind$coord[,1]
CT_PC <- CT.pca$ind$coord[,1]
PC_ID <- CT_w_ID$RID
PCs <- as.data.frame(cbind(PC_ID,NP$ADNI_MEM, NP$ADNI_EF, fISO_PC, Tau_PC, CT_PC))
colnames(PCs) <- c("RID", "MEMORY","Executive_Function", "fISO_PC", "Tau_PC", "CT_PC")
library(psych)
mod4.4 <- psych::mediate(Executive_Function ~ Tau_PC + (CT_PC), data =PCs)##
## Mediation/Moderation Analysis
## Call: psych::mediate(y = Executive_Function ~ Tau_PC + (CT_PC), data = PCs)
##
## The DV (Y) was Executive_Function . The IV (X) was Tau_PC . The mediating variable(s) = CT_PC .
##
## Total effect(c) of Tau_PC on Executive_Function = -0.09 S.E. = 0.02 t = -4.57 df= 53 with p = 2.9e-05
## Direct effect (c') of Tau_PC on Executive_Function removing CT_PC = -0.08 S.E. = 0.11 t = 8.22 df= 51 with p = 6.7e-11
## Indirect effect (ab) of Tau_PC on Executive_Function through CT_PC = -0.01
## Mean bootstrapped indirect effect = -0.01 with standard error = 0.01 Lower CI = -0.03 Upper CI = 0.02
## R = 0.54 R2 = 0.29 F = 10.38 on 2 and 51 DF p-value: 1.93e-05
##
## To see the longer output, specify short = FALSE in the print statement or ask for the summary
##
## Mediation/Moderation Analysis
## Call: psych::mediate(y = Executive_Function ~ Tau_PC + (fISO_PC), data = PCs)
##
## The DV (Y) was Executive_Function . The IV (X) was Tau_PC . The mediating variable(s) = fISO_PC .
##
## Total effect(c) of Tau_PC on Executive_Function = -0.09 S.E. = 0.02 t = -4.57 df= 53 with p = 2.9e-05
## Direct effect (c') of Tau_PC on Executive_Function removing fISO_PC = -0.07 S.E. = 0.11 t = 8.74 df= 51 with p = 1e-11
## Indirect effect (ab) of Tau_PC on Executive_Function through fISO_PC = -0.02
## Mean bootstrapped indirect effect = -0.02 with standard error = 0.01 Lower CI = -0.04 Upper CI = 0
## R = 0.61 R2 = 0.37 F = 15.09 on 2 and 51 DF p-value: 3.73e-07
##
## To see the longer output, specify short = FALSE in the print statement or ask for the summary
##Now looking at JUST AMYLOID, fISO, and CT (should have 54 subjects)
source(here::here("final","functions.R"))
fISO_AMY_CT <- subset(All_Long_Amy, select = c("RID", "ROI","fISO","AMY","CT")) %>%
melt(., id.vars=c("RID", "ROI"))## Warning in melt(., id.vars = c("RID", "ROI")): The melt generic in data.table
## has been passed a data.frame and will attempt to redirect to the relevant
## reshape2 method; please note that reshape2 is deprecated, and this redirection
## is now deprecated as well. To continue using melt methods from reshape2 while
## both libraries are attached, e.g. melt.list, you can prepend the namespace like
## reshape2::melt(.). In the next version, this warning will become an error.
fISO_L <- subset(fISO_AMY_CT, variable =="fISO")
fISO_AMY_Wide <- dcast(fISO_AMY_CT, RID ~ ROI + variable)## Warning in dcast(fISO_AMY_CT, RID ~ ROI + variable): The dcast generic
## in data.table has been passed a data.frame and will attempt to redirect
## to the reshape2::dcast; please note that reshape2 is deprecated, and this
## redirection is now deprecated as well. Please do this redirection yourself like
## reshape2::dcast(fISO_AMY_CT). In the next version, this warning will become an
## error.
#remove the empty columns (e.g., ROIs which don't have values)
emptycols <- sapply(fISO_AMY_Wide, function (k) all(is.na(k)))
fISO_AMY_Wide <- fISO_AMY_Wide[!emptycols]
#also remove brain-stem, accumbens and cerebellum
#fISO_AMY_Wide <- fISO_AMY_Wide %>% dplyr::select(-BRAIN_STEM_fISO, -BRAIN_STEM_AMY, -ACCUMBENS_LEFT_fISO, -ACCUMBENS_LEFT_AMY, -ACCUMBENS_RIGHT_fISO, -ACCUMBENS_RIGHT_AMY, -CEREBELLUM_LEFT_fISO, -CEREBELLUM_RIGHT_fISO)
#... and the empty rows (participants who don't have values)
fISO_AMY_Wide <- fISO_AMY_Wide[complete.cases(fISO_AMY_Wide), ]
ID_Vars <- fISO_AMY_Wide %>% dplyr::select(RID)
#now create separate matrices for each | Note these do not have to have the same dimensions
fISO <- fISO_AMY_Wide %>% dplyr:: select(ends_with("_fISO"))%>%
rename_at(vars(ends_with("_fISO")), funs(str_replace(., "_fISO", "")))
fISO_w_ID <- cbind(ID_Vars, fISO)
AMY <- fISO_AMY_Wide %>% dplyr:: select(ends_with("_AMY"))%>%
rename_at(vars(ends_with("_AMY")), funs(str_replace(., "_AMY", "")))
AMY_w_ID <- cbind(ID_Vars, AMY)
CT <- fISO_AMY_Wide %>% dplyr:: select(ends_with("_CT"))%>%
rename_at(vars(ends_with("_CT")), funs(str_replace(., "_CT", "")))
CT_w_ID <- cbind(ID_Vars, CT)
CT_data <- sapply( CT, as.numeric )
fISO_data <- sapply( fISO, as.numeric )
AMY_data <- sapply( AMY, as.numeric )PCAs for fISO and AMY (and CT)
fISO.pca = PCA(fISO_data, scale.unit=TRUE, ncp=2, graph=F)
CT.pca = PCA(CT_data, scale.unit=TRUE, ncp=2, graph=F)
AMY.pca = PCA(AMY_data, scale.unit=TRUE, ncp=2, graph=F)
NP <- subset(All_Long_Amy, select = c("RID", "ADNI_MEM","ADNI_EF")) %>%
distinct(., RID,ADNI_MEM, .keep_all= TRUE) %>%
merge(ID_Vars, all.y = TRUE)
##########################################################
# Extract the principal component scores #
##########################################################
fISO_PC <- fISO.pca$ind$coord[,1]
AMY_PC <- AMY.pca$ind$coord[,1]
CT_PC <- CT.pca$ind$coord[,1]
PC_ID <- CT_w_ID$RID
PCs <- as.data.frame(cbind(PC_ID,NP$ADNI_MEM, NP$ADNI_EF, fISO_PC, AMY_PC, CT_PC))
colnames(PCs) <- c("RID", "MEMORY","Executive_Function", "fISO_PC", "AMY_PC", "CT_PC")
library(psych)
mod4.4 <- psych::mediate(Executive_Function ~ AMY_PC + (CT_PC), data =PCs)##
## Mediation/Moderation Analysis
## Call: psych::mediate(y = Executive_Function ~ AMY_PC + (CT_PC), data = PCs)
##
## The DV (Y) was Executive_Function . The IV (X) was AMY_PC . The mediating variable(s) = CT_PC .
##
## Total effect(c) of AMY_PC on Executive_Function = -0.06 S.E. = 0.02 t = -2.84 df= 43 with p = 0.0068
## Direct effect (c') of AMY_PC on Executive_Function removing CT_PC = -0.05 S.E. = 0.15 t = 4.33 df= 41 with p = 9.4e-05
## Indirect effect (ab) of AMY_PC on Executive_Function through CT_PC = -0.01
## Mean bootstrapped indirect effect = -0.01 with standard error = 0.01 Lower CI = -0.03 Upper CI = 0
## R = 0.5 R2 = 0.25 F = 6.88 on 2 and 41 DF p-value: 0.000737
##
## To see the longer output, specify short = FALSE in the print statement or ask for the summary
##
## Mediation/Moderation Analysis
## Call: psych::mediate(y = Executive_Function ~ AMY_PC + (fISO_PC), data = PCs)
##
## The DV (Y) was Executive_Function . The IV (X) was AMY_PC . The mediating variable(s) = fISO_PC .
##
## Total effect(c) of AMY_PC on Executive_Function = -0.06 S.E. = 0.02 t = -2.84 df= 43 with p = 0.0068
## Direct effect (c') of AMY_PC on Executive_Function removing fISO_PC = -0.04 S.E. = 0.14 t = 4.74 df= 41 with p = 2.6e-05
## Indirect effect (ab) of AMY_PC on Executive_Function through fISO_PC = -0.02
## Mean bootstrapped indirect effect = -0.02 with standard error = 0.01 Lower CI = -0.04 Upper CI = 0
## R = 0.61 R2 = 0.37 F = 12.28 on 2 and 41 DF p-value: 7.21e-06
##
## To see the longer output, specify short = FALSE in the print statement or ask for the summary
Now to test a general additive linear model (from the JAMOVI package)
Now to test a general additive linear model (from the JAMOVI package)
PCs_New <- PCs
PCs_New$AMY_PC <- c(scale(PCs_New$AMY_PC,scale = TRUE, center = TRUE))
PCs_New$CT_PC <- c(scale(PCs_New$CT_PC,scale = TRUE, center = TRUE))
PCs_New$fISO_PC <- c(scale(PCs_New$fISO_PC,scale = TRUE, center = TRUE))
AA <- lm(Executive_Function ~ AMY_PC + fISO_PC +AMY_PC:fISO_PC + CT_PC , data =PCs_New)
summary(AA)##
## Call:
## lm(formula = Executive_Function ~ AMY_PC + fISO_PC + AMY_PC:fISO_PC +
## CT_PC, data = PCs_New)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.62216 -0.53648 -0.08207 0.49810 1.91653
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.7750 0.1416 5.472 2.8e-06 ***
## AMY_PC -0.2235 0.1447 -1.545 0.13047
## fISO_PC -0.5130 0.1665 -3.081 0.00377 **
## CT_PC 0.0205 0.1685 0.122 0.90379
## AMY_PC:fISO_PC -0.4146 0.1742 -2.380 0.02227 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8858 on 39 degrees of freedom
## Multiple R-squared: 0.4577, Adjusted R-squared: 0.4021
## F-statistic: 8.23 on 4 and 39 DF, p-value: 6.517e-05
##
## Call:
## lm(formula = MEMORY ~ AMY_PC + fISO_PC + AMY_PC:fISO_PC + CT_PC,
## data = PCs_New)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.03850 -0.37331 -0.01382 0.34851 1.84382
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.65996 0.09788 6.742 4.85e-08 ***
## AMY_PC -0.10882 0.09999 -1.088 0.28312
## fISO_PC -0.34486 0.11504 -2.998 0.00472 **
## CT_PC 0.03730 0.11642 0.320 0.75039
## AMY_PC:fISO_PC -0.39170 0.12035 -3.255 0.00235 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6121 on 39 degrees of freedom
## Multiple R-squared: 0.4922, Adjusted R-squared: 0.4401
## F-statistic: 9.449 on 4 and 39 DF, p-value: 1.935e-05