Symtoms Network analysis
THONG
1/2/2020
Network analysis
In a recent class of Network Analytics, we were asked to visualise correlations between symtoms. As an investor, you’re interested in diversifying risk by selecting different types of them. You might therefore want visualise which sytoms behave similarly (positive correlations) or very differently (negative correlations).
Loading packages & Data
library("readxl")
library(huge)
library(qgraph)## Registered S3 methods overwritten by 'BDgraph':
## method from
## plot.sim huge
## print.sim huge#Raw data
BS <- read_excel("D:/Research/REFERENCES/Statistic/Network analysis/PROJECT/Data/Raw data.xlsx",sheet = "BS")## New names:
## * PANSS.P.TO...16 -> PANSS.P.TO
## * PANSS.N.TO...24 -> PANSS.N.TO
## * PANSS.G.TO...41 -> PANSS.G.TO
## * BCSS.NS...111 -> BCSS.NS
## * BCSS.PS...112 -> BCSS.PS
## * ... and 4 more problemsTM <- read_excel("D:/Research/REFERENCES/Statistic/Network analysis/PROJECT/Data/Raw data.xlsx",sheet = "TM")## New names:
## * PANSS.P.TO...171 -> PANSS.P.TO
## * PANSS.N.TO...179 -> PANSS.N.TO
## * PANSS.G.TO...196 -> PANSS.G.TO
## * BCSS.NS...234 -> BCSS.NS
## * BCSS.PS...235 -> BCSS.PS
## * ... and 4 more problemsBHR <- read_excel("D:/Research/REFERENCES/Statistic/Network analysis/PROJECT/Data/Raw data.xlsx",sheet = "BHR")## New names:
## * PANSS.P.TO...16 -> PANSS.P.TO
## * PANSS.N.TO...24 -> PANSS.N.TO
## * PANSS.G.TO...41 -> PANSS.G.TO
## * BCSS.NS...111 -> BCSS.NS
## * BCSS.PS...112 -> BCSS.PS
## * ... and 4 more problemsTHR <- read_excel("D:/Research/REFERENCES/Statistic/Network analysis/PROJECT/Data/Raw data.xlsx",sheet = "THR")## New names:
## * PANSS.P.TO...171 -> PANSS.P.TO
## * PANSS.N.TO...179 -> PANSS.N.TO
## * PANSS.G.TO...196 -> PANSS.G.TO
## * BCSS.NS...234 -> BCSS.NS
## * BCSS.PS...235 -> BCSS.PS
## * ... and 4 more problemsBLR <- read_excel("D:/Research/REFERENCES/Statistic/Network analysis/PROJECT/Data/Raw data.xlsx",sheet = "BLR")## New names:
## * PANSS.P.TO...16 -> PANSS.P.TO
## * PANSS.N.TO...24 -> PANSS.N.TO
## * PANSS.G.TO...41 -> PANSS.G.TO
## * BCSS.NS...111 -> BCSS.NS
## * BCSS.PS...112 -> BCSS.PS
## * ... and 4 more problemsTLR <- read_excel("D:/Research/REFERENCES/Statistic/Network analysis/PROJECT/Data/Raw data.xlsx",sheet = "TLR")## New names:
## * PANSS.P.TO...171 -> PANSS.P.TO
## * PANSS.N.TO...179 -> PANSS.N.TO
## * PANSS.G.TO...196 -> PANSS.G.TO
## * BCSS.NS...234 -> BCSS.NS
## * BCSS.PS...235 -> BCSS.PS
## * ... and 4 more problemsBS=sapply(BS,as.numeric)
TM=sapply(TM,as.numeric)
BLR=sapply(BLR,as.numeric)
BHR=sapply(BHR,as.numeric)
THR=sapply(THR,as.numeric)
TLR=sapply(TLR,as.numeric)
#Delete MV
BS <- na.omit(BS)
TM <- na.omit(TM)
BHR <- na.omit(BHR)
BLR <- na.omit(BLR)
THR <- na.omit(THR)
TLR <- na.omit(TLR)
#Transformation
BS1 <- huge.npn(BS )## Conducting the nonparanormal (npn) transformation via shrunkun ECDF....done.TM1<- huge.npn(TM)## Conducting the nonparanormal (npn) transformation via shrunkun ECDF....done.BLR1 <- huge.npn(BLR )## Conducting the nonparanormal (npn) transformation via shrunkun ECDF....done.BHR1<- huge.npn(BHR)## Conducting the nonparanormal (npn) transformation via shrunkun ECDF....done.THR1 <- huge.npn(THR )## Conducting the nonparanormal (npn) transformation via shrunkun ECDF....done.TLR1<- huge.npn(TLR)## Conducting the nonparanormal (npn) transformation via shrunkun ECDF....done.# Compute correlations:
BS2 <- cor_auto(BS1)
TM2 <- cor_auto(TM1)
BLR2 <- cor_auto(BLR1)
BHR2 <- cor_auto(BHR1)
TLR2 <- cor_auto(TLR1)
THR2 <- cor_auto(THR1)Compute correlations:
BS2 <- cor_auto(BS1)
TM2 <- cor_auto(TM1)
BLR2 <- cor_auto(BLR1)
BHR2 <- cor_auto(BHR1)
TLR2 <- cor_auto(TLR1)
THR2 <- cor_auto(THR1)Network estimation
Names1a<-c("PANSS-Pos", "PANSS-Neg", "PANSS-Gen", "CDSS","BCSS-NS",
"BCSS-PS", "BCSS-NO", "BCSS-PO", "BSE", "BSC", "PAR")
Labels1a<-c("A1","A2","A3", "B1","C1","C2","C3","C4","D1", "D2","E1")
group.item <- list("PANSS" = 1:3,"CDSS" = 4,"BCSS" = 5:8,"BS " = 9:10,"PAR" = 11)
#No fit
layout(t(1:2))
network1 <- qgraph(BS2, layout = "spring", groups=group.item, graph = "pcor",
tuning = 0.5, sampleSize = 257, legend.cex = 0.3,groups = group.item,
nodeNames=Names1a,labels = Labels1a,title = "Baseline",
color=c("olivedrab2", "darkseagreen1", "wheat3", "goldenrod2", "darkorange1",
"darkslategray2", "mediumpurple"),cut = 0.03, maximum = 1,details = TRUE,
borders=FALSE, theme="colorblind", usePCH=TRUE)
network2 <- qgraph(TM2, layout = "spring", groups=group.item, graph = "pcor",
tuning = 0.5, sampleSize = 257, legend.cex = 0.3,groups = group.item,
nodeNames=Names1a,labels = Labels1a,title = "6M follow up",
color=c("olivedrab2", "darkseagreen1", "wheat3", "goldenrod2", "darkorange1",
"darkslategray2", "mediumpurple"),cut = 0.03, maximum = 1,details = TRUE,
borders=FALSE, theme="colorblind", usePCH=TRUE)
#nct TEST
library(NetworkComparisonTest)
set.seed(1)
nct.res_long <- NCT(huge.npn(BS), huge.npn(TM), gamma = 0, it = 1000,
weighted=TRUE, binary.data=FALSE, progressbar = TRUE,
test.edges=TRUE, edges='all')## Conducting the nonparanormal (npn) transformation via shrunkun ECDF....done.
## Conducting the nonparanormal (npn) transformation via shrunkun ECDF....done.
##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|==== | 7%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|====== | 10%
|
|======= | 10%
|
|======= | 11%
|
|======= | 12%
|
|======== | 12%
|
|======== | 13%
|
|========= | 13%
|
|========= | 14%
|
|========= | 15%
|
|========== | 15%
|
|========== | 16%
|
|=========== | 16%
|
|=========== | 17%
|
|=========== | 18%
|
|============ | 18%
|
|============ | 19%
|
|============= | 19%
|
|============= | 20%
|
|============= | 21%
|
|============== | 21%
|
|============== | 22%
|
|=============== | 22%
|
|=============== | 23%
|
|=============== | 24%
|
|================ | 24%
|
|================ | 25%
|
|================= | 25%
|
|================= | 26%
|
|================= | 27%
|
|================== | 27%
|
|================== | 28%
|
|=================== | 28%
|
|=================== | 29%
|
|=================== | 30%
|
|==================== | 30%
|
|==================== | 31%
|
|==================== | 32%
|
|===================== | 32%
|
|===================== | 33%
|
|====================== | 33%
|
|====================== | 34%
|
|====================== | 35%
|
|======================= | 35%
|
|======================= | 36%
|
|======================== | 36%
|
|======================== | 37%
|
|======================== | 38%
|
|========================= | 38%
|
|========================= | 39%
|
|========================== | 39%
|
|========================== | 40%
|
|========================== | 41%
|
|=========================== | 41%
|
|=========================== | 42%
|
|============================ | 42%
|
|============================ | 43%
|
|============================ | 44%
|
|============================= | 44%
|
|============================= | 45%
|
|============================== | 45%
|
|============================== | 46%
|
|============================== | 47%
|
|=============================== | 47%
|
|=============================== | 48%
|
|================================ | 48%
|
|================================ | 49%
|
|================================ | 50%
|
|================================= | 50%
|
|================================= | 51%
|
|================================= | 52%
|
|================================== | 52%
|
|================================== | 53%
|
|=================================== | 53%
|
|=================================== | 54%
|
|=================================== | 55%
|
|==================================== | 55%
|
|==================================== | 56%
|
|===================================== | 56%
|
|===================================== | 57%
|
|===================================== | 58%
|
|====================================== | 58%
|
|====================================== | 59%
|
|======================================= | 59%
|
|======================================= | 60%
|
|======================================= | 61%
|
|======================================== | 61%
|
|======================================== | 62%
|
|========================================= | 62%
|
|========================================= | 63%
|
|========================================= | 64%
|
|========================================== | 64%
|
|========================================== | 65%
|
|=========================================== | 65%
|
|=========================================== | 66%
|
|=========================================== | 67%
|
|============================================ | 67%
|
|============================================ | 68%
|
|============================================= | 68%
|
|============================================= | 69%
|
|============================================= | 70%
|
|============================================== | 70%
|
|============================================== | 71%
|
|============================================== | 72%
|
|=============================================== | 72%
|
|=============================================== | 73%
|
|================================================ | 73%
|
|================================================ | 74%
|
|================================================ | 75%
|
|================================================= | 75%
|
|================================================= | 76%
|
|================================================== | 76%
|
|================================================== | 77%
|
|================================================== | 78%
|
|=================================================== | 78%
|
|=================================================== | 79%
|
|==================================================== | 79%
|
|==================================================== | 80%
|
|==================================================== | 81%
|
|===================================================== | 81%
|
|===================================================== | 82%
|
|====================================================== | 82%
|
|====================================================== | 83%
|
|====================================================== | 84%
|
|======================================================= | 84%
|
|======================================================= | 85%
|
|======================================================== | 85%
|
|======================================================== | 86%
|
|======================================================== | 87%
|
|========================================================= | 87%
|
|========================================================= | 88%
|
|========================================================== | 88%
|
|========================================================== | 89%
|
|========================================================== | 90%
|
|=========================================================== | 90%
|
|=========================================================== | 91%
|
|=========================================================== | 92%
|
|============================================================ | 92%
|
|============================================================ | 93%
|
|============================================================= | 93%
|
|============================================================= | 94%
|
|============================================================= | 95%
|
|============================================================== | 95%
|
|============================================================== | 96%
|
|=============================================================== | 96%
|
|=============================================================== | 97%
|
|=============================================================== | 98%
|
|================================================================ | 98%
|
|================================================================ | 99%
|
|=================================================================| 99%
|
|=================================================================| 100%Network estimation
#global strength(DIFFERENCE IN GLOBALSTRENGTH)
plot(nct.res_long, what="strength")
#in terms of edge weights (NETWORK)
plot(nct.res_long, what="network") 
#the edge (DIFFERENCE IN EDGE STRENGTH)
plot(nct.res_long, what="edge")
