Network Descriptives using qgraph
Sacha Epskamp
18-09-2014
PML co-authorship network (2011)
- In these slides we will analyse a co-authorship network
- PML department
- 2007-2011
- The network is weighted and undirected
- Nodes represent researchers of the PML department
- An edge indicates the amount of papers two authors published together in 2007-2011
PML co-authorship network (2011)
source("http://sachaepskamp.com/files/NA2014/PMLgraph.R")
PML[1:10, 1:3]
Hoogstraten, J. Dolan, C. V. Mellenbergh, G. J.
Hoogstraten, J. 33 0 0
Dolan, C. V. 0 90 2
Mellenbergh, G. J. 0 2 37
Molenaar, P. C. M. 0 7 1
Vorst, H. C. M. 0 0 4
Lubke, G. H. 0 8 2
Waldorp, L. J. 0 2 0
Hamaker, E. L. 0 6 0
Borsboom, D. 0 6 7
van Heerden, J. 0 0 4
library("qgraph")
Gw <- qgraph(PML, layout = "spring", diag = FALSE, labels = TRUE,
nodeNames = rownames(PML), cut = 2, edge.color = "darkblue",
legend.cex = 0.5, vsize = 5)
Unweighted Version
PMLu <- 1*(PML>0)
Gu <- qgraph(PMLu, layout = "spring", diag = FALSE, labels = TRUE,
nodeNames = rownames(PML), cut = 2, edge.color = "black",
legend.cex = 0.5, vsize = 5)
Connectivity
- Shortest Path Lengths
- Average shortest path length
- Diameter
- Density
Using the centrality function
# Weighted graph:
CentW <- centrality(Gw)
# Unweighted graph:
CentU <- centrality(Gu)
# Result is a list with the following elements:
names(CentW)
[1] "OutDegree" "InDegree" "Closeness"
[4] "Betweenness" "ShortestPathLengths" "ShortestPaths"
Shortest Path lengths
# Weighted network:
CentW$ShortestPathLengths[1:3,1:8]
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] 0.000 1.0500 1.2857 1.1929 1.25 1.1750 1.3429 1.2167
[2,] 1.050 0.0000 0.3095 0.1429 0.30 0.1250 0.3000 0.1667
[3,] 1.286 0.3095 0.0000 0.4524 0.25 0.4345 0.3429 0.4762
# Unweighted network:
CentU$ShortestPathLengths[1:3,1:8]
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] 0 2 3 2 2 3 2 3
[2,] 2 0 1 1 2 1 1 1
[3,] 3 1 0 1 1 1 2 2
Distance between Harry Vorst (5) and me (36)
# Weighted network:
CentW$ShortestPathLengths[5,36]
[1] 1.393
# Unweighted network:
CentU$ShortestPathLengths[5,36]
[1] 3
Paths between Harry Vorst (5) and me (36)
# Weighted network:
CentW$ShortestPaths[[5,36]]
$`9.3`
[1] 5 3 9 36
$`9.15`
[1] 5 15 9 36
Paths between Harry Vorst (5) and me (36)
# Unweighted network:
CentU$ShortestPaths[[5,36]]
$`7.15`
[1] 5 15 7 36
$`9.3`
[1] 5 3 9 36
$`9.15`
[1] 5 15 9 36
$`25.15`
[1] 5 15 25 36
Average shortest path length
# Weighted network:
sp <- CentW$ShortestPathLengths
mean(sp[upper.tri(sp,diag=FALSE)])
[1] 0.8034
# Unweighted network:
sp <- CentU$ShortestPathLengths
mean(sp[upper.tri(sp,diag=FALSE)])
[1] 2.123
Clustering
- Local clustering coefficient
- Global clustering coefficient
- Small-worldness
Local Clustering Coefficients
# Weighted Network:
clustcoef_auto(Gw)
clustWS clustZhang clustOnnela clustBarrat
1 0.0000 0.00000 0.00000 0.0000
2 0.2429 0.06880 0.05118 0.2971
3 0.2667 0.07806 0.04928 0.2700
4 0.5000 0.22734 0.09617 0.6466
5 0.0000 0.00000 0.00000 0.0000
6 0.6667 0.10769 0.10099 0.8636
7 0.5758 0.12563 0.08189 0.5676
8 1.0000 0.38514 0.16014 1.0000
9 0.2865 0.07226 0.04809 0.3381
10 1.0000 0.35000 0.24101 1.0000
11 0.2924 0.14348 0.05525 0.3919
12 0.0000 0.00000 0.00000 0.0000
13 0.4364 0.17385 0.08330 0.5571
14 0.0000 0.00000 0.00000 0.0000
15 0.3077 0.19269 0.06938 0.4454
16 1.0000 0.79138 0.21264 1.0000
17 0.3636 0.09358 0.05996 0.4506
18 0.8000 0.21455 0.11187 0.8542
19 0.8000 0.18793 0.08113 0.8889
20 1.0000 0.32273 0.11782 1.0000
21 0.6667 0.45556 0.10587 0.7778
22 0.6000 0.37900 0.09880 0.8667
23 1.0000 0.10000 0.12599 1.0000
24 0.6786 0.13952 0.07004 0.7768
25 0.4615 0.13213 0.05357 0.5687
26 0.8000 0.18333 0.08128 0.7778
27 0.7333 0.13800 0.06067 0.8000
28 0.5000 0.13333 0.04725 0.5333
29 0.6667 0.46887 0.12245 0.7536
30 0.6000 0.28235 0.08466 0.8182
31 0.0000 0.00000 0.00000 0.0000
32 0.5000 0.05833 0.03092 0.5000
33 0.0000 0.00000 0.00000 0.0000
34 1.0000 0.11667 0.06183 1.0000
35 0.6111 0.15000 0.05250 0.6354
36 1.0000 0.15000 0.06869 1.0000
37 1.0000 0.15000 0.07211 1.0000
38 1.0000 0.35000 0.10065 1.0000
39 1.0000 0.20000 0.12599 1.0000
Local Clustering Coefficients
# Unweighted Network:
clustcoef_auto(Gw)
clustWS clustZhang clustOnnela clustBarrat
1 0.0000 0.00000 0.00000 0.0000
2 0.2429 0.06880 0.05118 0.2971
3 0.2667 0.07806 0.04928 0.2700
4 0.5000 0.22734 0.09617 0.6466
5 0.0000 0.00000 0.00000 0.0000
6 0.6667 0.10769 0.10099 0.8636
7 0.5758 0.12563 0.08189 0.5676
8 1.0000 0.38514 0.16014 1.0000
9 0.2865 0.07226 0.04809 0.3381
10 1.0000 0.35000 0.24101 1.0000
11 0.2924 0.14348 0.05525 0.3919
12 0.0000 0.00000 0.00000 0.0000
13 0.4364 0.17385 0.08330 0.5571
14 0.0000 0.00000 0.00000 0.0000
15 0.3077 0.19269 0.06938 0.4454
16 1.0000 0.79138 0.21264 1.0000
17 0.3636 0.09358 0.05996 0.4506
18 0.8000 0.21455 0.11187 0.8542
19 0.8000 0.18793 0.08113 0.8889
20 1.0000 0.32273 0.11782 1.0000
21 0.6667 0.45556 0.10587 0.7778
22 0.6000 0.37900 0.09880 0.8667
23 1.0000 0.10000 0.12599 1.0000
24 0.6786 0.13952 0.07004 0.7768
25 0.4615 0.13213 0.05357 0.5687
26 0.8000 0.18333 0.08128 0.7778
27 0.7333 0.13800 0.06067 0.8000
28 0.5000 0.13333 0.04725 0.5333
29 0.6667 0.46887 0.12245 0.7536
30 0.6000 0.28235 0.08466 0.8182
31 0.0000 0.00000 0.00000 0.0000
32 0.5000 0.05833 0.03092 0.5000
33 0.0000 0.00000 0.00000 0.0000
34 1.0000 0.11667 0.06183 1.0000
35 0.6111 0.15000 0.05250 0.6354
36 1.0000 0.15000 0.06869 1.0000
37 1.0000 0.15000 0.07211 1.0000
38 1.0000 0.35000 0.10065 1.0000
39 1.0000 0.20000 0.12599 1.0000
Global Clustering Coefficient
Only defined for unweighted networks
# First transform to igraph:
library("igraph")
igraph_object <- as.igraph(Gu)
# Compute transitivity:
transitivity(igraph_object)
[1] 0.4027
Small-worldness
Function to compute average path length of comparable random graph:
APLr <- function(x){
if ("qgraph"%in%class(x)) x <- as.igraph(x)
if ("igraph"%in%class(x)) x <- get.adjacency(x)
N=nrow(x)
p=sum(x/2)/sum(lower.tri(x))
eulers_constant <- .57721566490153
l = (log(N)-eulers_constant)/log(p*(N-1)) +.5
l
}
Small-worldness
Function to compute clustering of comparable random graph:
Cr <- function(x){
if ("qgraph"%in%class(x)) x <- as.igraph(x)
if ("igraph"%in%class(x)) x <- get.adjacency(x)
N=nrow(x)
p=sum(x/2)/sum(lower.tri(x))
t=(p*(N-1)/N)
t
}
Small-worldness
# Clustering in graph:
transitivity(igraph_object)
[1] 0.4027
# Clustering in random graph:
Cr(igraph_object)
[1] 0.1604
# Average path length in graph:
average.path.length(igraph_object)
[1] 2.123
# Average path length in random graph:
APLr(igraph_object)
[1] 2.183
Small-world index
(transitivity(igraph_object) / Cr(igraph_object)) /
(average.path.length(igraph_object) / APLr(igraph_object))
[1] 2.582
Centrality
A node is central/important/influential if…
- …it has many connections
- Degree / strength
- …it is close to all other nodes
- Closeness
- …it connects other nodes
- Betweenness
Using the centrality function
# Weighted graph:
CentW <- centrality(Gw)
# Unweighted graph:
CentU <- centrality(Gu)
# Result is a list with the following elements:
names(CentW)
[1] "OutDegree" "InDegree" "Closeness"
[4] "Betweenness" "ShortestPathLengths" "ShortestPaths"
Degree
# Weighted graph:
CentW$InDegree[1:10]
1 2 3 4 5 6 7 8 9 10
1 119 20 29 8 11 37 11 70 8
CentW$OutDegree[1:10]
1 2 3 4 5 6 7 8 9 10
1 119 20 29 8 11 37 11 70 8
Degree
# Unweighted graph:
CentU$InDegree[1:10]
1 2 3 4 5 6 7 8 9 10
1 21 6 9 2 3 12 4 19 2
CentU$OutDegree[1:10]
1 2 3 4 5 6 7 8 9 10
1 21 6 9 2 3 12 4 19 2
Closeness
# Weighted graph:
CentW$Closeness
[1] 0.01833 0.05937 0.04203 0.04706 0.03789 0.04658 0.04564 0.04346
[9] 0.05281 0.03584 0.05567 0.01717 0.04882 0.04658 0.05692 0.04125
[17] 0.05065 0.03670 0.03548 0.03684 0.03832 0.04949 0.03709 0.03846
[25] 0.04156 0.03663 0.03198 0.02615 0.04658 0.03995 0.02815 0.01937
[33] 0.01788 0.01917 0.03487 0.01858 0.01873 0.02615 0.02761
# Unweighted graph:
CentU$Closeness
[1] 0.010101 0.018182 0.013158 0.014493 0.010526 0.011765 0.015625
[8] 0.012346 0.017241 0.011111 0.017544 0.009434 0.014706 0.010870
[15] 0.016129 0.011628 0.014925 0.012658 0.011111 0.011236 0.012658
[22] 0.012048 0.010753 0.012821 0.015873 0.012658 0.012658 0.012048
[29] 0.014286 0.012821 0.010417 0.011494 0.010526 0.011364 0.014085
[36] 0.011628 0.011364 0.011236 0.010753
Betweenness
# Weighted graph:
CentW$Betweenness
[1] 0.0 918.5 11.0 74.0 0.0 0.0 38.0 0.0 524.0 0.0 392.0
[12] 0.0 100.0 0.0 243.0 0.0 318.0 0.0 0.0 0.0 0.0 0.0
[23] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
[34] 0.0 0.0 0.0 0.0 0.0 0.0
# Unweighted graph:
CentU$Betweenness
[1] 0.0000 362.8904 38.4246 87.9005 1.4000 0.9167 43.4019
[8] 0.0000 277.1160 0.0000 309.4404 0.0000 58.2140 0.0000
[15] 230.0524 0.0000 90.3833 1.3937 1.0667 0.0000 4.0079
[22] 4.3556 0.0000 11.3128 69.5120 6.2667 5.0810 2.4389
[29] 15.0008 5.3841 2.0556 9.9111 0.0000 0.0000 26.0732
[36] 0.0000 0.0000 0.0000 0.0000
centralityPlot(Gw, labels = rownames(PML))
centralityPlot(list(Weighted = Gw, Unweighted = Gu),
labels = rownames(PML))
Tuning parameter
Use the second argument in centrality for Opsahl's tuning parameter:
centrality(Gw, 1)$InDegree[1:5]
1 2 3 4 5
1 119 20 29 8
centrality(Gw, 0.5)$InDegree[1:5]
1 2 3 4 5
1.00 49.99 10.95 16.16 4.00
centrality(Gw, 0)$InDegree[1:5]
1 2 3 4 5
1 21 6 9 2
centrality(Gu)$InDegree[1:5]
1 2 3 4 5
1 21 6 9 2
Alternative to centrality() the centrality_auto() function can be used:
Cauto <- centrality_auto(Gw)
str(Cauto)
List of 3
$ node.centrality :'data.frame': 39 obs. of 3 variables:
..$ Betweenness: num [1:39] 0 459.2 5.5 37 0 ...
..$ Closeness : num [1:39] 0.0183 0.0594 0.042 0.0471 0.0379 ...
..$ Strength : num [1:39] 1 119 20 29 8 11 37 11 70 8 ...
$ edge.betweenness.centrality:'data.frame': 741 obs. of 3 variables:
..$ from : chr [1:741] "2" "2" "11" "2" ...
..$ to : chr [1:741] "11" "9" "17" "15" ...
..$ edgebetweenness: num [1:741] 208 175 142 110 56 ...
$ ShortestPathLengths : num [1:39, 1:39] 0 1.05 1.29 1.19 1.25 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:39] "1" "2" "3" "4" ...
.. ..$ : chr [1:39] "1" "2" "3" "4" ...
- attr(*, "class")= chr [1:2] "list" "centrality_auto"