Analysis of the provided Networks.

Let’s read the structure

## Loading required package: plyr
## Loading required package: xtable
## Loading required package: igraph
## Loading required package: doMC
## Loading required package: foreach
## Loading required package: iterators
## Loading required package: parallel

Now we will build up the structural networks:

Types of networks.

Let’s have a look into the network’s motifs. For the particular type of size = 3 the meaning of each of the motifs can be found here: http://igraph.org/c/doc/igraph-Motifs.html

#
cfgplt=function(net) {
  V(net)$size=degree(net)*1.2+3
#  layout = layout.reingold.tilford(net, circular=T)
  layout = layout.lgl
  plot.igraph(net,layout=layout)
}
nm3s=unlist(lapply(nets,graph.motifs.no,size=3))
tnm3s=graph.motifs.no(tnets,size=3)
nm3f=unlist(lapply(nets,graph.motifs.no,size=3))
tnm3f=graph.motifs.no(tnetf,size=3)
print(xtable(as.data.frame(nm3s)),type="html")
nm3s
0 8
1 113
2 63
3 145
4 89
5 66 
print(xtable(as.data.frame(tnm3s)),type="html")
tnm3s
1 511 
print(xtable(as.data.frame(nm3f)),type="html")
nm3f
0 8
1 113
2 63
3 145
4 89
5 66 
print(xtable(as.data.frame(tnm3f)),type="html")
tnm3f
1 2582 
print(xtable(ldply(nets,graph.motifs,size=3)),type="html")
.id V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16
1 0 0.00 2.00 0.00 3.00 3.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
2 1 33.00 53.00 0.00 10.00 17.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
3 2 16.00 27.00 0.00 12.00 8.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
4 3 50.00 66.00 1.00 7.00 16.00 0.00 2.00 0.00 0.00 1.00 2.00 0.00 0.00
5 4 14.00 17.00 10.00 1.00 4.00 0.00 10.00 25.00 0.00 0.00 2.00 2.00 4.00
6 5 3.00 4.00 14.00 1.00 0.00 0.00 15.00 20.00 0.00 2.00 2.00 3.00 2.00 
print(xtable(as.data.frame(graph.motifs(tnets,size=3))),type="html")
graph.motifs(tnets, size = 3)
1
2
3 127.00
4
5 185.00
6 25.00
7 30.00
8 52.00
9 0.00
10 27.00
11 45.00
12 0.00
13 3.00
14 6.00
15 5.00
16 6.00 
print(xtable(ldply(netf,graph.motifs,size=3)),type="html")
.id V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16
1 0 13.00 0.00 0.00 26.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
2 1 0.00 2.00 13.00 1.00 0.00 0.00 19.00 120.00 0.00 0.00 0.00 13.00 35.00
3 2 17.00 46.00 44.00 22.00 15.00 6.00 38.00 21.00 2.00 13.00 10.00 8.00 2.00
4 3 135.00 242.00 139.00 138.00 77.00 39.00 169.00 25.00 11.00 35.00 28.00 31.00 6.00
5 4 69.00 84.00 90.00 47.00 53.00 23.00 85.00 13.00 11.00 46.00 16.00 41.00 5.00
6 5 25.00 33.00 45.00 16.00 21.00 14.00 35.00 21.00 10.00 21.00 17.00 20.00 8.00 
print(xtable(as.data.frame(graph.motifs(tnetf,size=3))),type="html")
graph.motifs(tnetf, size = 3)
1
2
3 281.00
4
5 470.00
6 398.00
7 250.00
8 166.00
9 82.00
10 346.00
11 200.00
12 34.00
13 115.00
14 71.00
15 113.00
16 56.00 
#
nm4s=unlist(lapply(nets,graph.motifs.no,size=4))
tnm4s=graph.motifs.no(tnets,size=4)
nm4f=unlist(lapply(nets,graph.motifs.no,size=4))
tnm4f=graph.motifs.no(tnetf,size=4)
print(xtable(as.data.frame(nm4s)),type="html")
nm4s
0 5
1 364
2 175
3 499
4 265
5 178 
print(xtable(as.data.frame(tnm4s)),type="html")
tnm4s
1 1793 
print(xtable(as.data.frame(nm4f)),type="html")
nm4f
0 5
1 364
2 175
3 499
4 265
5 178 
print(xtable(as.data.frame(tnm4f)),type="html")
tnm4f
1 15069 
#
cat(paste("<br>Full Structural Network of hospitals:","<br>",sep=""))


Full Structural Network of hospitals:

cfgplt(tnets)

cat(paste("<br>Full Fucntional Network of hospitals:","<br>",sep=""))


Full Fucntional Network of hospitals:

cfgplt(tnetf)

cat("<hr>")
for (i in 1:numh){
  cat(paste("<br>Structural Network hospital:",(i-1),"<br>",sep=""))
  cfgplt(nets[[i]])
  cat(paste("<br>Functional Network hospital:",(i-1),"<br>",sep=""))
  cfgplt(netf[[i]])
}


Structural Network hospital:0

Functional Network hospital:0

Structural Network hospital:1

Functional Network hospital:1

Structural Network hospital:2

Functional Network hospital:2

Structural Network hospital:3

Functional Network hospital:3

Structural Network hospital:4

Functional Network hospital:4

Structural Network hospital:5

Functional Network hospital:5

#

Let us have a similat behaviour for a random network

#
rnet=function(net) {
  g=erdos.renyi.game(vcount(net),ecount(net),type="gnm",directed=TRUE)
  return(g)
}
rnets=lapply(nets,rnet)
trnets=rnet(tnets)
rnetf=lapply(netf,rnet)
trnetf=rnet(tnetf)
#
strt=data.frame(health_st=unlist(lapply(nets,graph.motifs.no,size=3)),
                thealth_st=graph.motifs.no(tnets,size=3),
                random_st=unlist(lapply(rnets,graph.motifs.no,size=3)),
                trandom_st=graph.motifs.no(trnets,size=3),
                health_fn=unlist(lapply(netf,graph.motifs.no,size=3)),
                thealth_nf=graph.motifs.no(tnetf,size=3),
                random_fn=unlist(lapply(rnetf,graph.motifs.no,size=3)),
                trandom_fn=graph.motifs.no(trnetf,size=3))
print(xtable(strt),type="html")
health_st thealth_st random_st trandom_st health_fn thealth_nf random_fn trandom_fn
0 8 511 4 894 39 2582 25 7570
1 113 511 110 894 203 2582 625 7570
2 63 511 56 894 244 2582 424 7570
3 145 511 176 894 1075 2582 1782 7570
4 89 511 185 894 583 2582 737 7570
5 66 511 100 894 286 2582 389 7570

Key Parameter Identification

#
radio=function(net){
  dg0=degree(net)
  hdg=which.max(dg0)[1]
  dg1=(1:length(dg0))[-hdg]
  return(mean(unlist(lapply(dg1,function(x,net){return(shortest.paths(net,hdg,x))},net=net))))
}
diametro=function(net) {
  nv =length(V(net))
  sec=data.frame(o=1,d=2:nv)
  for (i in 2:nv) {
    if ( i < nv) {
      dd=data.frame(o=i,d=((i+1):nv))
      sec=rbind(sec,dd)
    }
  }
  sp=foreach(pos=1:nrow(sec)) %dopar%
      shortest.paths(net,sec[pos,1],sec[pos,2])
  return(mean(unlist(sp)))
}
#
nets_pl = ldply(nets,average.path.length)
netf_pl = ldply(netf,average.path.length)
tnets_pl= average.path.length(tnets)
tnetf_pl= average.path.length(tnetf)
nets_cc = ldply(nets,transitivity)
netf_cc = ldply(netf,transitivity)
tnets_cc= transitivity(tnets)
tnetf_cc= transitivity(tnetf)
nets_d  = ldply(nets,diametro)
netf_d  = ldply(netf,diametro)
tnets_d = diametro(tnets)
tnetf_d = diametro(tnetf)
nets_r  = ldply(nets,radio)
netf_r  = ldply(netf,radio)
tnets_r = radio(tnets)
tnetf_r = radio(tnetf)
nnds    = ldply(nets,function(x){return(length(V(x)))})
nndf    = ldply(netf,function(x){return(length(V(x)))})
tnnds   = length(V(tnets))
tnndf   = length(V(tnetf))
rnets_pl= ldply(rnets,average.path.length)
rnetf_pl= ldply(rnetf,average.path.length)
trnets_pl= average.path.length(trnets)
trnetf_pl= average.path.length(trnetf)
rnets_cc= ldply(rnets,transitivity)
rnetf_cc= ldply(rnetf,transitivity)
trnets_cc= transitivity(trnets)
trnetf_cc= transitivity(trnetf)
rnets_d = ldply(rnets,diametro)
rnetf_d = ldply(rnetf,diametro)
trnets_d= diametro(trnets)
trnetf_d= diametro(trnetf)
rnets_r = ldply(rnets,radio)
rnetf_r = ldply(rnetf,radio)
trnets_r= radio(trnets)
trnetf_r= radio(trnetf)
# 
ndt = data.frame(pls=c(tnets_pl,nets_pl[,2]),
                 plf=c(tnetf_pl,netf_pl[,2]),
                 ccs=c(tnets_cc,nets_cc[,2]),
                 ccf=c(tnetf_cc,netf_cc[,2]),
                 ds=c(tnets_d,nets_d[,2]),
                 df=c(tnetf_d,netf_d[,2]), 
                 rs=c(tnets_r,nets_r[,2]),
                 rf=c(tnetf_r,netf_r[,2]),                 
                 rpls=c(trnets_pl,rnets_pl[,2]), 
                 rplf=c(trnetf_pl,rnetf_pl[,2]),
                 rccs=c(trnets_cc,rnets_cc[,2]),
                 rccf=c(trnetf_cc,rnetf_cc[,2]),
                 rds=c(trnets_d,rnets_d[,2]),
                 rdf=c(trnetf_d,rnetf_d[,2]),
                 rrs=c(trnets_r,rnets_r[,2]),                 
                 rrf=c(trnetf_r,rnetf_r[,2]),                 
                 NS=c(tnnds,nnds[,2]),
                 NF=c(tnndf,nndf[,2]))
rownames(ndt) = c("Full Net",paste("Hospital",namh,sep=" "))
print(xtable(ndt),type="html")
pls plf ccs ccf ds df rs rf rpls rplf rccs rccf rds rdf rrs rrf NS NF
Full Net 2.63 2.15 0.33 0.50 4.96 4.11 3.63 3.00 5.45 2.74 0.05 0.12 3.44 2.11 2.74 1.89 110 109
Hospital 0 1.40 1.00 0.64 0.00 1.30 1.54 1.00 1.29 1.40 2.46 0.50 0.49 1.70 1.64 1.25 1.29 5 8
Hospital 1 2.22 2.21 0.35 0.48 2.44 2.13 1.62 1.45 3.59 1.94 0.10 0.47 Inf 1.53 Inf 1.20 22 21
Hospital 2 2.07 2.09 0.30 0.47 2.62 1.71 1.58 1.47 2.35 1.84 0.15 0.48 2.78 1.49 2.00 1.24 20 18
Hospital 3 2.06 2.27 0.31 0.45 3.01 1.79 1.76 1.45 4.57 1.91 0.08 0.40 2.82 1.60 2.15 1.39 34 32
Hospital 4 2.68 1.73 0.32 0.60 2.48 1.43 1.70 1.22 2.96 1.58 0.23 0.67 2.01 1.32 1.70 1.17 21 19
Hospital 5 2.53 1.70 0.32 0.66 2.36 1.48 1.69 1.07 2.84 1.62 0.25 0.60 2.03 1.38 1.75 1.20 17 16

Checking some parameters

You can find here some checks as

#
mls = lm(ds~log(NS),data=ndt)
summary(mls)$adj.r.squared

[1] 0.9366125

print(xtable(summary(mls)),type="html")
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.9309 0.4016 -2.32 0.0682
log(NS) 1.1779 0.1244 9.47 0.0002 
plot(mls)

mlf = lm(df~log(NF),data=ndt)
summary(mlf)$adj.r.squared

[1] 0.7444562

print(xtable(summary(mlf)),type="html")
Estimate Std. Error t value Pr(>|t|)
(Intercept) -1.2472 0.7831 -1.59 0.1721
log(NF) 1.0473 0.2436 4.30 0.0077 
plot(mlf)