A Transdiagnostic Network Approach to Psychosis

            library(glmnet)library(qgraph)library(ggplot2)#library(tnet)library(igraph)library(poweRlaw)library(dplyr)library(IsingFit)library(grDevices)library(reshape2)# Custom functions:recode<-function(df,codeToZero=0){# Recodes responses in a dataframe df given in the vector codeToZero to zerodf_recode<-sapply(df, function(col){ifelse(col%in%codeToZero, 0, 1)})return(df_recode)}frequencies<-function(df,responses=0:3){# Outputs the frequencies of responsesfreqs<-c()for(iinresponses){freqs[i+1]<-sum(df==i)/(ncol(df)*nrow(df))}freqs.df<-data.frame(response=responses, frequency=round(freqs,3))return(freqs.df)}cif<-function(x, gamma=0, maxit=500000){# This function is the same as the IsingFit function, except for a different gamma value and more model fitting iterations.family="binomial"AND=TRUEplot=FALSEprogressbar=TRUEx<-as.matrix(x)allthemeans<-colMeans(x)NodesToAnalyze<-apply(x, 2, sd, na.rm=TRUE)!=0names(NodesToAnalyze)<-colnames(x)x<-x[, NodesToAnalyze, drop=FALSE]nvar<-ncol(x)p<-nvar-1intercepts<-betas<-lambdas<-list(vector, nvar)nlambdas<-rep(0, nvar)for(iin1:nvar){a<-glmnet(x[, -i], x[, i], family=family, maxit=maxit)intercepts[[i]]<-a$a0betas[[i]]<-a$betalambdas[[i]]<-a$lambdanlambdas[i]<-length(lambdas[[i]])}if(progressbar==TRUE){pb<-txtProgressBar(max=nvar, style=3)}P<-logl<-sumlogl<-J<-matrix(0, max(nlambdas), nvar)for(iin1:nvar){J[1:ncol(betas[[i]]), i]<-colSums(betas[[i]]!=0)}logl_M<-P_M<-array(0, dim=c(nrow(x), max(nlambdas), 
                                    nvar))N<-nrow(x)for(iin1:nvar){betas.ii<-as.matrix(betas[[i]])int.ii<-intercepts[[i]]y<-matrix(0, nrow=N, ncol=ncol(betas.ii))xi<-x[, -i]NB<-nrow(betas.ii)for(bbin1:NB){y<-y+betas.ii[rep(bb, N), ]*xi[, bb]}y<-matrix(int.ii, nrow=N, ncol=ncol(y), byrow=TRUE)+yn_NA<-max(nlambdas)-ncol(y)if(n_NA>0){for(vvin1:n_NA){y<-cbind(y, NA)}}P_M[, , i]<-exp(y*x[, i])/(1+exp(y))logl_M[, , i]<-log(P_M[, , i])if(progressbar==TRUE)setTxtProgressBar(pb, i)}logl_Msum<-colSums(logl_M, 1, na.rm=FALSE)if(progressbar==TRUE)close(pb)sumlogl<-logl_Msumsumlogl[sumlogl==0]=NApenalty<-J*log(nrow(x))+2*gamma*J*log(p)EBIC<--2*sumlogl+penaltylambda.opt<-apply(EBIC, 2, which.min)thresholds<-0for(iin1:length(lambda.opt))thresholds[i]<-intercepts[[i]][lambda.opt[i]]weights.opt<-matrix(, nvar, nvar)for(iin1:nvar){weights.opt[i, -i]<-betas[[i]][, lambda.opt[i]]}if(AND==TRUE){adj<-weights.optadj<-(adj!=0)*1EN.weights<-adj*t(adj)EN.weights<-EN.weights*weights.optmeanweights.opt<-(EN.weights+t(EN.weights))/2diag(meanweights.opt)<-0}else{meanweights.opt<-(weights.opt+t(weights.opt))/2diag(meanweights.opt)<-0}graphNew<-matrix(0, length(NodesToAnalyze), length(NodesToAnalyze))graphNew[NodesToAnalyze, NodesToAnalyze]<-meanweights.optcolnames(graphNew)<-rownames(graphNew)<-colnames(x)threshNew<-ifelse(allthemeans>0.5, -Inf, Inf)threshNew[NodesToAnalyze]<-thresholdsif(plot==TRUE){notplot=FALSE}else{notplot=TRUEq<-qgraph(graphNew, layout="spring", labels=names(NodesToAnalyze), DoNotPlot=notplot)}return(list(weiadj=graphNew, q=q))}allDat<-read.delim("Data/Network workfile 2015.dat", header=TRUE)cape<-allDat[,1:42]# cape itemsdass<-allDat[,43:63]# dass itemspos_items_ind<-c(2,5,6,7,10,11,13,15,17,20,22,24,26,28,30,31,34,41,42)# removed item 33 "stemmen horen"neg_items_ind<-c(3,4,8,16,18,21,23,25,27,29,32,35,36,37)dep_items_ind<-c(1,9,12,14,19,38,39,40)anx_items_ind<-c(2,4,7,9,15,19,20)stress_items_ind<-c(1,6,8,11,12,14,18)# cape subscales:cape_positive_items<-cape[,pos_items_ind]cape_negative_items<-cape[,neg_items_ind]cape_depression_items<-cape[,dep_items_ind]# dass subscales:dass_anxiety_items<-dass[,anx_items_ind]dass_stress_items<-dass[,stress_items_ind]cape<-cbind(cape_positive_items, cape_negative_items, cape_depression_items)dass<-cbind(dass_anxiety_items, dass_stress_items)# overige dass items zijn niet nodig en gooien we wegcape_dass<-cbind(cape, dass)# data recoding, preparation and model fitting:cape_dass_recoded<-recode(cape_dass, codeToZero=0)capenames<-c(paste0("pos",1:19),paste0("neg",1:14),paste0("dep",1:8))# labeling items per subscaledassnames<-c(paste0("anx",1:7),paste0("str",1:7))items_cape_dass<-list()# this list is uses to define groups of nodes in the qgraph plotsitems_cape_dass$positive<-1:19items_cape_dass$negative<-20:33items_cape_dass$depression<-34:41items_cape_dass$anxiety<-42:48items_cape_dass$stress<-49:55colnames(cape_dass_recoded)<-c(capenames,dassnames)cape_dass_out<-cif(cape_dass_recoded, gamma=0)# fitting the Ising model with gamma = 0cape_dass_out_gamma<-cif(cape_dass_recoded, gamma=.25)# fitting the Ising model with gamma = 0.25 for comparison# ---- figure 1no_grid<-theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(), panel.background=element_blank(), axis.line=element_line(colour="black"))# 1a# png("Output/figure1a_new.png", width = 1024, height = 768, type ="cairo")qgraph(cape_dass_out$weiadj, groups=items_cape_dass, vsize=2.8, title="Network for gamma = 0")# dev.off()# 1b# png("Output/figure1b_new.png", width = 1024, height = 768, type ="cairo")qgraph(cape_dass_out_gamma$weiadj, groups=items_cape_dass, vsize=2.8, title="Network for gamma = 0.25")# dev.off()# ---- figure 2cape_dass_centrality<-centrality_auto(cape_dass_out$q)strength_df<-data.frame(strength=cape_dass_centrality$node.centrality$Strength, 
                          subscale=c(rep("Positive Affect",19), 
                                       rep("Negative Affect",14), 
                                       rep("Depression",8), 
                                       rep("Anxiety",7), 
                                       rep("Stress",7)))betweenness_df<-data.frame(betweenness=cape_dass_centrality$node.centrality$Betweenness, 
                             subscale=c(rep("Positive Affect",19), 
                                          rep("Negative Affect",14), 
                                          rep("Depression",8), 
                                          rep("Anxiety",7), 
                                          rep("Stress",7)))strength_df$subscale<-as.factor(strength_df$subscale)# png("Output/figure2a_new.png", width = 1024, height = 768, type ="cairo")ggplot(data=strength_df, aes(x=1:55, y=strength, fill=subscale))+geom_bar(stat="identity")+xlab("Items")+ylab("Strength")+theme_bw()+ggtitle("Strength of nodes per subscale")+theme(plot.title=element_text(lineheight=.8, face="bold"))+scale_x_continuous(expand=c(0,0.5))+scale_y_continuous(expand=c(0,0))+theme(panel.background=element_blank())# no_grid # dev.off()# png("Output/figure2b_new.png", width = 1024, height = 768, type ="cairo")ggplot(data=betweenness_df, aes(x=1:55, y=betweenness, fill=subscale))+geom_bar(stat="identity")+xlab("Items")+ylab("Betweenness")+theme_bw()+ggtitle("Betweenness of nodes per subscale")+theme(plot.title=element_text(lineheight=.8, face="bold"))+scale_x_continuous(expand=c(0,0.5))+scale_y_continuous(expand=c(0,0))+theme(panel.background=element_blank())# no_grid # dev.off()# ---- Node strength summaries (table 2): for(iinlevels(strength_df$subscale)){cat(i,"\t",mean(strength_df[strength_df$subscale==i,]$strength),"\t",
      var(strength_df[strength_df$subscale==i,]$strength),"\t",
      median(strength_df[strength_df$subscale==i,]$strength),"\n")}# ---- figure 3:cape_dass_igraph<-graph.adjacency(cape_dass_out$weiadj, mode="undirected", weighted=TRUE)cape_dass_leadingEVcomm<-leading.eigenvector.community(cape_dass_igraph)cape_dass_edgecomm<-edge.betweenness.community(cape_dass_igraph)cape_dass_fastgreedycomm<-fastgreedy.community(cape_dass_igraph)V(cape_dass_igraph)$label.cex<-.9colors=rainbow(max(membership(cape_dass_edgecomm)))cairo_pdf("Output/figure3_new.pdf")plot(cape_dass_igraph, vertex.color=colors[membership(cape_dass_edgecomm)], layout=layout.auto)# node placement is random, so running this code will look slightly different in terms of node placementdev.off()# Powerlaw analysis and figure 4:cape_dass_centrality<-centrality_auto(qgraph(cape_dass_out$weiadj))$node.centralitystrengths<-cape_dass_centrality$Strengthm_pl=conpl$new(strengths[strengths>0])m_plest=estimate_xmin(m_pl)estm_pl$setXmin(2.436691)m_pl$setPars(9.20082)# png("Output/figure4_new.png", width = 1024, height = 768, type = "cairo")plot(m_pl)lines(m_pl)# dev.off()bs_p=bootstrap_p(m_pl, no_of_sims=1000, threads=2)bs_p$p# re-running the bootstrap can give different p-values because of the randomness involved# Splitting the data up into those patients who heared voices and those who didn't:geenstemmen<-allDat[allDat$T1_AVH_kind==0,]# data from patients who heared voiceswelstemmen<-allDat[allDat$T1_AVH_kind==1,]# data from those who didn'tpos_items_ind<-c(2,5,6,7,10,11,13,15,17,20,22,24,26,28,30,31,41,42)# removed item 33 "stemmen horen" and item 34neg_items_ind<-c(3,4,8,16,18,21,23,25,27,29,32,35,36,37)dep_items_ind<-c(1,9,12,14,19,38,39,40)items_list<-list(pos_items=pos_items_ind, neg_items=neg_items_ind, dep_items=dep_items_ind)cape_wel<-recode(welstemmen[, c(pos_items_ind, neg_items_ind, dep_items_ind)])cape_geen<-recode(geenstemmen[, c(pos_items_ind, neg_items_ind, dep_items_ind)])cif_wel<-cif(cape_wel)cif_geen<-cif(cape_geen)cape_groups<-list()cape_groups$positive<-1:18cape_groups$negative<-19:32cape_groups$depression<-33:40# figure 5a and 5b:# pdf("Output/Plots/cape_welstemmen.pdf")qgraph(cif_wel$weiadj, groups=cape_groups, vsize=3)# dev.off()# pdf("Output/Plots/cape_geenstemmen.pdf")qgraph(cif_geen$weiadj, groups=cape_groups, vsize=3)# dev.off()