Symtoms Network analysis

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).

1 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 problems

TM <- 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 problems

BHR <- 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 problems

THR <- 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 problems

BLR <- 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 problems

TLR <- 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 problems

BS=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)

2 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)

3 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)