##################################################################################### # # # Network paper on Perinatal Depression # # # # Santos & Fried et al. 2017 # # Research in Nursing & Health # # # # 1) Network model of 20 CES-D symptoms in full sample # # 2) Include hormonal data in network # # 3) Compare networks of healthy and depresse groups # # # ##################################################################################### # ----------------------------------------------------------------------------------- # ---------- Load libraries --------------------------------------------------------- # ----------------------------------------------------------------------------------- library("qgraph") library("ggplot2") library("dplyr") library("mgm") # library("devtools") # devtools::install_github("sachaepskamp/qgraph") # devtools::install_github("sachaepskamp/bootnet") library("bootnet") # devtools::install_github("cvborkulo/NetworkComparisonTest") library("NetworkComparisonTest") # ----------------------------------------------------------------------------------- # ---------- Primary analysis ------------------------------------------------------- # ----------------------------------------------------------------------------------- ### A: Data management data <- read.csv ("Master.csv") data1 <- data [,2:21] nrow(data1) # 515 nrow(na.omit(data1)) # 503 CESD_names <- c("Bothered", "Appetite changes", "Feeling blue", "Feeling good", "Concentration", "Depressed mood", "Effort", "Feeling hopeful", "Failure", "Fearful", "Sleep disturbance", "Happy", "Talking less", "Lonely", "People unfriendly", "Enjoy", "Crying", "Sadness", "People dislike", "Get going") colnames(data1) <- c(1:20) ### B: Network estimation network1<-estimateNetwork(data1, default = "EBICglasso") # tuning parameter default = 0.5 Fig1a<-plot(network1, layout = "spring", cut=0, labels = TRUE, vsize=6.5, border.width=1.5, nodeNames = CESD_names, legend.cex=.4) Fig1a_bw<-plot(network1, layout = "spring", cut=0, labels = TRUE, vsize=6.5, border.width=1.5, nodeNames = CESD_names, legend.cex=.4, theme='gray') L<-averageLayout(Fig1a) # we need this for later WM1<-getWmat(Fig1a) # adjacency matrix pdf("Fig1a.pdf", height=5, width=6.5) plot(Fig1a) dev.off() pdf("Fig1a_bw.pdf", height=5, width=6.5) plot(Fig1a_bw) dev.off() ### C: Network inference centRes <- centrality(Fig1a) centRes$OutDegree # node strength centrality / degree centrality centRes$Closeness centRes$Betweenness cor(centRes$OutDegree, centRes$Closeness, method='spearman') #0.79 cor(centRes$OutDegree, centRes$Betweenness, method='spearman') #0.85 cor(centRes$Betweenness, centRes$Closeness, method='spearman') #0.82 source("centralityPlotRev.R") #does not work when package 'reshape' is loaded; turns around the centrality plot pdf("Fig1b.pdf") centralityPlotRev(Fig1a) dev.off() ### D: Network stability ## Edge Weights # boot1 <- bootnet(network1, nBoots = 1000, nCores = 4) # save(boot1, file = "boot1.Rdata") load(file = "boot1.Rdata") pdf("boot1.pdf") #this equals Fig2a plot(boot1, labels = F, order = "sample" ) dev.off() ## Centrality boot2 <- bootnet(network1, nBoots = 1000, type = "case", nCores = 4) # save(boot2, file = "boot2.Rdata") load(file = "boot2.Rdata") pdf("boot2.pdf") #this equals Fig2b plot(boot2) dev.off() corStability(boot2) # "CS-coefficient should not be below 0.25, and preferably above 0.5" (bootnet paper) # betweenness closeness strength # 0.05048544 0.12815534 0.28349515 ## Differences # Gray boxes indicate nodes or edges that do not differ significantly from one-another # and black boxes represent nodes or edges that do differ significantly from one-another boot3 <- plot(boot1, "edge", plot = "difference", onlyNonZero = TRUE, order = "sample", labels=FALSE) boot4 <- plot(boot1, "strength", order="sample", labels=FALSE) pdf("boot3.pdf") plot(boot3) dev.off() pdf("boot4.pdf") plot(boot4) dev.off() # ----------------------------------------------------------------------------------- # ---------- Secondary analysis 1: Hormone Network ---------------------------------- # ----------------------------------------------------------------------------------- ### A: Data data2 <- data [,2:25] nrow(data2) #515 nrow(na.omit(data2)) #461 colnames(data2) <- c(1:24) CESD_marker_names <- c("Bothered", "Appetite changes", "Feeling blue", "Feeling good", "Concentration", "Depressed mood", "Effort", "Feeling hopeful", "Failure", "Fearful", "Sleep disturbance", "Happy", "Talking less", "Lonely", "People unfriendly", "Enjoy", "Crying", "Sadness", "People dislike", "Get going", "Estriol", "Cortisol", "Corticotropin-releasing hormone", "Tumor necrosis factor-alpha") gr1 <- c(rep("CES-D symptom",20),rep("Marker",4)) ### B: Network estimation estArgs0 <- list(n = nrow(data2), returnAllResults = TRUE, gamma = 0.5) network2 <- estimateNetwork(data2, default = "EBICglasso", estArgs=estArgs0) Fig3<-plot(network2, layout = "spring", groups=gr1, cut=0, labels = TRUE, vsize=6, border.width=1.5, color=c("#ffffff","#cccccc"), nodeNames=CESD_marker_names, legend.cex=.56) Fig3_bw<-plot(network2, layout = "spring", groups=gr1, cut=0, labels = TRUE, vsize=6, border.width=1.5, color=c("#ffffff","#cccccc"), nodeNames=CESD_marker_names, legend.cex=.56, theme="gray") WM2<-getWmat(Fig2) # adjacency matrix pdf("Fig3.pdf", height=8, width=12) qgraph(Fig3) dev.off() pdf("Fig3_bw.pdf", height=8, width=12) plot(Fig3_bw) dev.off() ### C: Network inference (irrelevant due to low power) ### D: Network stability (irrelevant due to low power) # ----------------------------------------------------------------------------------- # ---------- Secondary analysis 2: Comparison healthy vs depressed ------------------ # ----------------------------------------------------------------------------------- ### A: data data.h <- filter(data, BDI_Tot>9) #healthy data.h <- data.h[,2:21] nrow(data.h) #246 nrow(data.h2<- na.omit(data.h)) #240 data.d <- filter(data, BDI_Tot<10) #depressed data.d <- data.d[,2:21] nrow(data.d) #270 nrow(data.d2 <- na.omit(data.d)) #264 colnames(data.h) <- colnames(data.d) <- colnames(data.h2) <- colnames(data.d2) <- c(1:20) ### B: network estimation # check if spearman and polychoric correlations give similar results cor(as.vector(cor(data.h2, method="spearman")[upper.tri(cor(data.h2))]),as.vector(cor_auto(data.h2)[upper.tri(cor_auto(data.h2))]))# 0.99 cor(as.vector(cor(data.d2, method="spearman")),as.vector(cor_auto(data.d2))) # 0.9374345 # networks estArgs1 <- list(n = nrow(data.h2), returnAllResults = TRUE, gamma = 0.5) # set conservative tuning parameter of 0.5 estArgs2 <- list(n = nrow(data.d2), returnAllResults = TRUE, gamma = 0.5) # set conservative tuning parameter of 0.5 Network4a <- estimateNetwork(data.h2, default = "glasso", estArgs = estArgs1) Network4b <- estimateNetwork(data.d2, default = "glasso", estArgs = estArgs2) Fig4a<-plot(Network4a, layout = "spring", cut=0, labels = CESD_names, vsize=6.5, border.width=1.5, details=T, labels=TRUE, nodeNames=CESD_names, legend.cex=.4) # max = .51 Fig4b<-plot(Network4b, layout = "spring", cut=0, labels = CESD_names, vsize=6.5, border.width=1.5, details=T, labels=TRUE, nodeNames=CESD_names, legend.cex=.4) # max = .52 WM4a<-getWmat(Fig4a) # adjacency matrix WM4b<-getWmat(Fig4b) # adjacency matrix pdf("Fig4a.pdf", height=5, width=6.5) qgraph(Fig4a, layout=L, max=.52, details=F) dev.off() pdf("Fig4a_bw.pdf", height=5, width=6.5) qgraph(Fig4a, layout=L, max=.52, details=F, theme="gray") dev.off() pdf("Fig4b.pdf", height=5, width=6.5) qgraph(Fig4b, layout=L, max=.52, details=F) dev.off() pdf("Fig4b_bw.pdf", height=5, width=6.5) qgraph(Fig4b, layout=L, max=.52, details=F, theme="gray") dev.off() sum(abs(getWmat(Fig4a)[upper.tri(getWmat(Fig4a))])) # 8.47 sum(abs(getWmat(Fig4b)[upper.tri(getWmat(Fig4a))])) # 8.83 # which correlation coef do we need to correlate the two adjacency matrices? plot(as.vector(getWmat(Fig4a)[upper.tri(getWmat(Fig3a))])) # non-normal so we use spearman here cor(as.vector(getWmat(Fig4a)[upper.tri(getWmat(Fig4a))]), as.vector(getWmat(Fig4b)[upper.tri(getWmat(Fig3a))]), method='spearman') # .41 ### C: network inference (irrelevant due to low power) ### D: network stability (irrelevant due to low power) ### E: network comparison compare1<-NCT(data.h2, data.d2, binary.data=F, it=1000, gamma=.5, progressbar=T, paired=F) # save(compare1, file = "compare1.Rdata") load(file = "compare1.Rdata") plot(compare1, what="network") # is structure different? p= 0.99 <- no plot(compare1, what="strength") # is global strength different? p= 0.001 <- totally plot(compare1, what="edge") # error # ------------------------------------------------------------------------------------ # ---------- Predictability ---------------------------------------------------------- # ------------------------------------------------------------------------------------ # re-estimate Ising Model via mgm (identical result when d=1) datamiss <- na.omit(data1) # 503 type=rep('g', 20) fitobj <- mgmfit(datamiss, type=type, lev=rep(1,20), d=1, ret.warn = FALSE) predobj1 <- predict.mgm(fitobj, datamiss, error.continuous = "VarExpl") # simple accuracy signedmatrix <- fitobj$wadj*fitobj$signs # code negative edges as negatives signedmatrix[is.na(signedmatrix)] <- 0 network.mgm <- qgraph(signedmatrix, layout=L, pie=predobj1$error$Error, cut=0, labels = TRUE, vsize=6.5, border.width=1.5, nodeNames = CESD_names, legend.cex=.4) pdf("mgm.pdf", width=6.5, height=5) qgraph(signedmatrix, layout=L, pie=predobj1$error$Error, cut=0, labels = TRUE, vsize=6.5, border.width=1.5, nodeNames = CESD_names, legend.cex=.4) dev.off() cor(as.vector(signedmatrix), as.vector(WM1), method='spearman') #0.709602