Introduction to Social Network Analysis - Lab 1
Paulo Serôdio
Start from clean slate and free up memory
rm(list = ls())
gc()Load R packages
packages <- c("statnet", "igraph", "RSiena", "EpiModel", "kableExtra", "netdiffuseR",
"sna", "ergm", "coda", "lattice", "plyr", "dplyr", "tidyr", "magrittr",
"mosaic", "snatools", "tidyverse", "ggplot2", "ggnetwork", "visNetwork",
"GGally", "ggraph", "networkD3", "ndtv", "amen", "knitr", "rio", "maps",
"googleAuthR", "ggmap", "smacof", "grid", "rworldmap", "visNetwork", "networkD3",
"ggraph", "tidygraph", "polyclip", "tweenr", "ROAuth", "twitteR", "tweetscores",
"devtools", "streamR", "gganimate", "gifski_renderer", "av", "r2d3")
missing.packages <- which(!packages %in% installed.packages()[, "Package"])
if (length(missing.packages)) install.packages(packages[missing.packages])
lapply(packages, require, character.only = T)
library(devtools)
install_github("pablobarbera/twitter_ideology/pkg/tweetscores")
install.packages("gifski", type = "source")1 Handing Network Data
1.1 Matrix Operations
Creating matrix
m <- matrix(data=1, nrow=5, ncol=4)
dim(m)## [1] 5 4m <- matrix(1:10,10,10)Select matrix elements:
m[2, 3] # Matrix m, row 2, column 3 - a single cell## [1] 2m[2, ] # The whole second row of m as a vector## [1] 2 2 2 2 2 2 2 2 2 2m[, 2] # The whole second column of m as a vector## [1] 1 2 3 4 5 6 7 8 9 10m[1:2, 4:6] # submatrix: rows 1 and 2, columns 4, 5 and 6## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 2 2 2m[-1, ] # all rows *except* the first one## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 2 2 2 2 2 2 2 2 2 2
## [2,] 3 3 3 3 3 3 3 3 3 3
## [3,] 4 4 4 4 4 4 4 4 4 4
## [4,] 5 5 5 5 5 5 5 5 5 5
## [5,] 6 6 6 6 6 6 6 6 6 6
## [6,] 7 7 7 7 7 7 7 7 7 7
## [7,] 8 8 8 8 8 8 8 8 8 8
## [8,] 9 9 9 9 9 9 9 9 9 9
## [9,] 10 10 10 10 10 10 10 10 10 10Import Camp data: - these data were collected by Steve Borgatti, Russ Bernard, Bert Pelto and Gery Ryan at the 1992 NSF Summer Institute on Research Methods in Cultural Anthropology. This was a 3 week course given to 14 carefully selected participants. Network data were collected at the end of each week. These data were collected at the end of the second week. The data were collected by placing each person’s name on a card and asking each respondent to sort the cards in order of how much interaction they had with that person since the beginning of the course (known informally as “camp”). This results in rank order data in which a “1” indicates the most interaction while a “17” indicates the least interaction.
camp92 <- as.matrix(rio::import("./data/camp92.txt"))[,-1]
camp92 <- apply(camp92, 2, as.numeric)
rownames(camp92) <- colnames(camp92)Transpose matrix:
print(camp92)## HOLLY BRAZEY CAROL PAM PAT JENNIE PAULINE ANN MICHAEL BILL LEE DON
## HOLLY 0 2 15 8 4 12 10 5 3 11 13 1
## BRAZEY 1 0 12 2 10 11 5 7 9 17 3 8
## CAROL 17 15 0 1 2 4 6 12 7 16 11 10
## PAM 9 5 6 0 3 4 1 2 8 15 16 13
## PAT 4 10 8 3 0 1 2 14 9 16 7 13
## JENNIE 11 9 4 2 1 0 7 3 15 16 10 14
## PAULINE 14 10 5 1 3 4 0 7 6 17 12 11
## ANN 8 9 12 2 10 1 7 0 3 15 17 5
## MICHAEL 3 11 4 6 9 13 7 8 0 17 10 1
## BILL 3 4 8 15 10 16 17 13 2 0 11 1
## LEE 5 6 9 14 7 15 12 17 8 13 0 2
## DON 3 9 13 14 12 17 15 16 1 10 4 0
## JOHN 17 11 1 5 9 15 3 16 8 14 12 6
## HARRY 4 17 5 11 14 16 9 8 1 12 3 2
## GERY 11 6 9 13 15 12 17 16 4 10 8 7
## STEVE 10 9 5 12 8 15 7 14 11 17 3 6
## BERT 7 4 9 6 13 11 14 15 10 16 5 8
## RUSS 2 9 10 17 16 11 15 14 13 3 8 7
## JOHN HARRY GERY STEVE BERT RUSS
## HOLLY 16 9 17 7 6 14
## BRAZEY 15 13 16 6 4 14
## CAROL 3 5 13 8 9 14
## PAM 7 12 17 11 10 14
## PAT 11 12 17 5 6 15
## JENNIE 12 13 17 5 6 8
## PAULINE 2 13 16 9 8 15
## ANN 16 4 13 11 6 14
## MICHAEL 14 2 15 12 5 16
## BILL 9 14 12 6 7 5
## LEE 11 4 16 1 3 10
## DON 11 2 6 8 5 7
## JOHN 0 4 7 10 13 2
## HARRY 6 0 13 10 7 15
## GERY 5 14 0 2 3 1
## STEVE 16 13 4 0 1 2
## BERT 17 12 3 1 0 2
## RUSS 6 12 1 4 5 0t(camp92)## HOLLY BRAZEY CAROL PAM PAT JENNIE PAULINE ANN MICHAEL BILL LEE DON
## HOLLY 0 1 17 9 4 11 14 8 3 3 5 3
## BRAZEY 2 0 15 5 10 9 10 9 11 4 6 9
## CAROL 15 12 0 6 8 4 5 12 4 8 9 13
## PAM 8 2 1 0 3 2 1 2 6 15 14 14
## PAT 4 10 2 3 0 1 3 10 9 10 7 12
## JENNIE 12 11 4 4 1 0 4 1 13 16 15 17
## PAULINE 10 5 6 1 2 7 0 7 7 17 12 15
## ANN 5 7 12 2 14 3 7 0 8 13 17 16
## MICHAEL 3 9 7 8 9 15 6 3 0 2 8 1
## BILL 11 17 16 15 16 16 17 15 17 0 13 10
## LEE 13 3 11 16 7 10 12 17 10 11 0 4
## DON 1 8 10 13 13 14 11 5 1 1 2 0
## JOHN 16 15 3 7 11 12 2 16 14 9 11 11
## HARRY 9 13 5 12 12 13 13 4 2 14 4 2
## GERY 17 16 13 17 17 17 16 13 15 12 16 6
## STEVE 7 6 8 11 5 5 9 11 12 6 1 8
## BERT 6 4 9 10 6 6 8 6 5 7 3 5
## RUSS 14 14 14 14 15 8 15 14 16 5 10 7
## JOHN HARRY GERY STEVE BERT RUSS
## HOLLY 17 4 11 10 7 2
## BRAZEY 11 17 6 9 4 9
## CAROL 1 5 9 5 9 10
## PAM 5 11 13 12 6 17
## PAT 9 14 15 8 13 16
## JENNIE 15 16 12 15 11 11
## PAULINE 3 9 17 7 14 15
## ANN 16 8 16 14 15 14
## MICHAEL 8 1 4 11 10 13
## BILL 14 12 10 17 16 3
## LEE 12 3 8 3 5 8
## DON 6 2 7 6 8 7
## JOHN 0 6 5 16 17 6
## HARRY 4 0 14 13 12 12
## GERY 7 13 0 4 3 1
## STEVE 10 10 2 0 1 4
## BERT 13 7 3 1 0 5
## RUSS 2 15 1 2 2 01.2 Dichotomizing (thinning network)
campnet <- ifelse(camp92 > 15, 1, 0)
print(campnet)## HOLLY BRAZEY CAROL PAM PAT JENNIE PAULINE ANN MICHAEL BILL LEE DON
## HOLLY 0 0 0 0 0 0 0 0 0 0 0 0
## BRAZEY 0 0 0 0 0 0 0 0 0 1 0 0
## CAROL 1 0 0 0 0 0 0 0 0 1 0 0
## PAM 0 0 0 0 0 0 0 0 0 0 1 0
## PAT 0 0 0 0 0 0 0 0 0 1 0 0
## JENNIE 0 0 0 0 0 0 0 0 0 1 0 0
## PAULINE 0 0 0 0 0 0 0 0 0 1 0 0
## ANN 0 0 0 0 0 0 0 0 0 0 1 0
## MICHAEL 0 0 0 0 0 0 0 0 0 1 0 0
## BILL 0 0 0 0 0 1 1 0 0 0 0 0
## LEE 0 0 0 0 0 0 0 1 0 0 0 0
## DON 0 0 0 0 0 1 0 1 0 0 0 0
## JOHN 1 0 0 0 0 0 0 1 0 0 0 0
## HARRY 0 1 0 0 0 1 0 0 0 0 0 0
## GERY 0 0 0 0 0 0 1 1 0 0 0 0
## STEVE 0 0 0 0 0 0 0 0 0 1 0 0
## BERT 0 0 0 0 0 0 0 0 0 1 0 0
## RUSS 0 0 0 1 1 0 0 0 0 0 0 0
## JOHN HARRY GERY STEVE BERT RUSS
## HOLLY 1 0 1 0 0 0
## BRAZEY 0 0 1 0 0 0
## CAROL 0 0 0 0 0 0
## PAM 0 0 1 0 0 0
## PAT 0 0 1 0 0 0
## JENNIE 0 0 1 0 0 0
## PAULINE 0 0 1 0 0 0
## ANN 1 0 0 0 0 0
## MICHAEL 0 0 0 0 0 1
## BILL 0 0 0 0 0 0
## LEE 0 0 1 0 0 0
## DON 0 0 0 0 0 0
## JOHN 0 0 0 0 0 0
## HARRY 0 0 0 0 0 0
## GERY 0 0 0 0 0 0
## STEVE 1 0 0 0 0 0
## BERT 1 0 0 0 0 0
## RUSS 0 0 0 0 0 01.3 Transposing and multiplying networks multiplication
# Transposing
t(campnet)## HOLLY BRAZEY CAROL PAM PAT JENNIE PAULINE ANN MICHAEL BILL LEE DON
## HOLLY 0 0 1 0 0 0 0 0 0 0 0 0
## BRAZEY 0 0 0 0 0 0 0 0 0 0 0 0
## CAROL 0 0 0 0 0 0 0 0 0 0 0 0
## PAM 0 0 0 0 0 0 0 0 0 0 0 0
## PAT 0 0 0 0 0 0 0 0 0 0 0 0
## JENNIE 0 0 0 0 0 0 0 0 0 1 0 1
## PAULINE 0 0 0 0 0 0 0 0 0 1 0 0
## ANN 0 0 0 0 0 0 0 0 0 0 1 1
## MICHAEL 0 0 0 0 0 0 0 0 0 0 0 0
## BILL 0 1 1 0 1 1 1 0 1 0 0 0
## LEE 0 0 0 1 0 0 0 1 0 0 0 0
## DON 0 0 0 0 0 0 0 0 0 0 0 0
## JOHN 1 0 0 0 0 0 0 1 0 0 0 0
## HARRY 0 0 0 0 0 0 0 0 0 0 0 0
## GERY 1 1 0 1 1 1 1 0 0 0 1 0
## STEVE 0 0 0 0 0 0 0 0 0 0 0 0
## BERT 0 0 0 0 0 0 0 0 0 0 0 0
## RUSS 0 0 0 0 0 0 0 0 1 0 0 0
## JOHN HARRY GERY STEVE BERT RUSS
## HOLLY 1 0 0 0 0 0
## BRAZEY 0 1 0 0 0 0
## CAROL 0 0 0 0 0 0
## PAM 0 0 0 0 0 1
## PAT 0 0 0 0 0 1
## JENNIE 0 1 0 0 0 0
## PAULINE 0 0 1 0 0 0
## ANN 1 0 1 0 0 0
## MICHAEL 0 0 0 0 0 0
## BILL 0 0 0 1 1 0
## LEE 0 0 0 0 0 0
## DON 0 0 0 0 0 0
## JOHN 0 0 0 1 1 0
## HARRY 0 0 0 0 0 0
## GERY 0 0 0 0 0 0
## STEVE 0 0 0 0 0 0
## BERT 0 0 0 0 0 0
## RUSS 0 0 0 0 0 0# Matrix multiplication as sum of vector dot-products
campnet %*% campnet # Multiplying adjacency matrix by itself (A^2). Result? A_ij shows # 2-length paths. Diagonal shows degree of node i. E.g. Calculate entry A_21 and soon realise we're checking for presence of 1s in both second row (Brazey's out-ties) and first column (Holly's in-ties), which is a directed two-path from Brazey to Holly.## HOLLY BRAZEY CAROL PAM PAT JENNIE PAULINE ANN MICHAEL BILL LEE DON
## HOLLY 1 0 0 0 0 0 1 2 0 0 0 0
## BRAZEY 0 0 0 0 0 1 2 1 0 0 0 0
## CAROL 0 0 0 0 0 1 1 0 0 0 0 0
## PAM 0 0 0 0 0 0 1 2 0 0 0 0
## PAT 0 0 0 0 0 1 2 1 0 0 0 0
## JENNIE 0 0 0 0 0 1 2 1 0 0 0 0
## PAULINE 0 0 0 0 0 1 2 1 0 0 0 0
## ANN 1 0 0 0 0 0 0 2 0 0 0 0
## MICHAEL 0 0 0 1 1 1 1 0 0 0 0 0
## BILL 0 0 0 0 0 0 0 0 0 2 0 0
## LEE 0 0 0 0 0 0 1 1 0 0 1 0
## DON 0 0 0 0 0 0 0 0 0 1 1 0
## JOHN 0 0 0 0 0 0 0 0 0 0 1 0
## HARRY 0 0 0 0 0 0 0 0 0 2 0 0
## GERY 0 0 0 0 0 0 0 0 0 1 1 0
## STEVE 1 0 0 0 0 1 1 1 0 0 0 0
## BERT 1 0 0 0 0 1 1 1 0 0 0 0
## RUSS 0 0 0 0 0 0 0 0 0 1 1 0
## JOHN HARRY GERY STEVE BERT RUSS
## HOLLY 0 0 0 0 0 0
## BRAZEY 0 0 0 0 0 0
## CAROL 1 0 1 0 0 0
## PAM 0 0 1 0 0 0
## PAT 0 0 0 0 0 0
## JENNIE 0 0 0 0 0 0
## PAULINE 0 0 0 0 0 0
## ANN 0 0 1 0 0 0
## MICHAEL 0 0 0 0 0 0
## BILL 0 0 2 0 0 0
## LEE 1 0 0 0 0 0
## DON 1 0 1 0 0 0
## JOHN 2 0 1 0 0 0
## HARRY 0 0 2 0 0 0
## GERY 1 0 1 0 0 0
## STEVE 0 0 0 0 0 0
## BERT 0 0 0 0 0 0
## RUSS 0 0 2 0 0 0print(campnet)## HOLLY BRAZEY CAROL PAM PAT JENNIE PAULINE ANN MICHAEL BILL LEE DON
## HOLLY 0 0 0 0 0 0 0 0 0 0 0 0
## BRAZEY 0 0 0 0 0 0 0 0 0 1 0 0
## CAROL 1 0 0 0 0 0 0 0 0 1 0 0
## PAM 0 0 0 0 0 0 0 0 0 0 1 0
## PAT 0 0 0 0 0 0 0 0 0 1 0 0
## JENNIE 0 0 0 0 0 0 0 0 0 1 0 0
## PAULINE 0 0 0 0 0 0 0 0 0 1 0 0
## ANN 0 0 0 0 0 0 0 0 0 0 1 0
## MICHAEL 0 0 0 0 0 0 0 0 0 1 0 0
## BILL 0 0 0 0 0 1 1 0 0 0 0 0
## LEE 0 0 0 0 0 0 0 1 0 0 0 0
## DON 0 0 0 0 0 1 0 1 0 0 0 0
## JOHN 1 0 0 0 0 0 0 1 0 0 0 0
## HARRY 0 1 0 0 0 1 0 0 0 0 0 0
## GERY 0 0 0 0 0 0 1 1 0 0 0 0
## STEVE 0 0 0 0 0 0 0 0 0 1 0 0
## BERT 0 0 0 0 0 0 0 0 0 1 0 0
## RUSS 0 0 0 1 1 0 0 0 0 0 0 0
## JOHN HARRY GERY STEVE BERT RUSS
## HOLLY 1 0 1 0 0 0
## BRAZEY 0 0 1 0 0 0
## CAROL 0 0 0 0 0 0
## PAM 0 0 1 0 0 0
## PAT 0 0 1 0 0 0
## JENNIE 0 0 1 0 0 0
## PAULINE 0 0 1 0 0 0
## ANN 1 0 0 0 0 0
## MICHAEL 0 0 0 0 0 1
## BILL 0 0 0 0 0 0
## LEE 0 0 1 0 0 0
## DON 0 0 0 0 0 0
## JOHN 0 0 0 0 0 0
## HARRY 0 0 0 0 0 0
## GERY 0 0 0 0 0 0
## STEVE 1 0 0 0 0 0
## BERT 1 0 0 0 0 0
## RUSS 0 0 0 0 0 0campnet %*% t(campnet) # Multiplying by its transpose, what do we get? Ties in common.## HOLLY BRAZEY CAROL PAM PAT JENNIE PAULINE ANN MICHAEL BILL LEE DON
## HOLLY 2 1 0 1 1 1 1 1 0 0 1 0
## BRAZEY 1 2 1 1 2 2 2 0 1 0 1 0
## CAROL 0 1 2 0 1 1 1 0 1 0 0 0
## PAM 1 1 0 2 1 1 1 1 0 0 1 0
## PAT 1 2 1 1 2 2 2 0 1 0 1 0
## JENNIE 1 2 1 1 2 2 2 0 1 0 1 0
## PAULINE 1 2 1 1 2 2 2 0 1 0 1 0
## ANN 1 0 0 1 0 0 0 2 0 0 0 0
## MICHAEL 0 1 1 0 1 1 1 0 2 0 0 0
## BILL 0 0 0 0 0 0 0 0 0 2 0 1
## LEE 1 1 0 1 1 1 1 0 0 0 2 1
## DON 0 0 0 0 0 0 0 0 0 1 1 2
## JOHN 0 0 1 0 0 0 0 0 0 0 1 1
## HARRY 0 0 0 0 0 0 0 0 0 1 0 1
## GERY 0 0 0 0 0 0 0 0 0 1 1 1
## STEVE 1 1 1 0 1 1 1 1 1 0 0 0
## BERT 1 1 1 0 1 1 1 1 1 0 0 0
## RUSS 0 0 0 0 0 0 0 0 0 0 0 0
## JOHN HARRY GERY STEVE BERT RUSS
## HOLLY 0 0 0 1 1 0
## BRAZEY 0 0 0 1 1 0
## CAROL 1 0 0 1 1 0
## PAM 0 0 0 0 0 0
## PAT 0 0 0 1 1 0
## JENNIE 0 0 0 1 1 0
## PAULINE 0 0 0 1 1 0
## ANN 0 0 0 1 1 0
## MICHAEL 0 0 0 1 1 0
## BILL 0 1 1 0 0 0
## LEE 1 0 1 0 0 0
## DON 1 1 1 0 0 0
## JOHN 2 0 1 0 0 0
## HARRY 0 2 0 0 0 0
## GERY 1 0 2 0 0 0
## STEVE 0 0 0 2 2 0
## BERT 0 0 0 2 2 0
## RUSS 0 0 0 0 0 2# Element-wise multiplication (both matrices must have same dimension)
campnet * t(campnet) # Note that * is element-wise multiplication. What do we get? Symmetric Adjacency Matrix under the max/strong rule.## HOLLY BRAZEY CAROL PAM PAT JENNIE PAULINE ANN MICHAEL BILL LEE DON
## HOLLY 0 0 0 0 0 0 0 0 0 0 0 0
## BRAZEY 0 0 0 0 0 0 0 0 0 0 0 0
## CAROL 0 0 0 0 0 0 0 0 0 0 0 0
## PAM 0 0 0 0 0 0 0 0 0 0 0 0
## PAT 0 0 0 0 0 0 0 0 0 0 0 0
## JENNIE 0 0 0 0 0 0 0 0 0 1 0 0
## PAULINE 0 0 0 0 0 0 0 0 0 1 0 0
## ANN 0 0 0 0 0 0 0 0 0 0 1 0
## MICHAEL 0 0 0 0 0 0 0 0 0 0 0 0
## BILL 0 0 0 0 0 1 1 0 0 0 0 0
## LEE 0 0 0 0 0 0 0 1 0 0 0 0
## DON 0 0 0 0 0 0 0 0 0 0 0 0
## JOHN 1 0 0 0 0 0 0 1 0 0 0 0
## HARRY 0 0 0 0 0 0 0 0 0 0 0 0
## GERY 0 0 0 0 0 0 1 0 0 0 0 0
## STEVE 0 0 0 0 0 0 0 0 0 0 0 0
## BERT 0 0 0 0 0 0 0 0 0 0 0 0
## RUSS 0 0 0 0 0 0 0 0 0 0 0 0
## JOHN HARRY GERY STEVE BERT RUSS
## HOLLY 1 0 0 0 0 0
## BRAZEY 0 0 0 0 0 0
## CAROL 0 0 0 0 0 0
## PAM 0 0 0 0 0 0
## PAT 0 0 0 0 0 0
## JENNIE 0 0 0 0 0 0
## PAULINE 0 0 1 0 0 0
## ANN 1 0 0 0 0 0
## MICHAEL 0 0 0 0 0 0
## BILL 0 0 0 0 0 0
## LEE 0 0 0 0 0 0
## DON 0 0 0 0 0 0
## JOHN 0 0 0 0 0 0
## HARRY 0 0 0 0 0 0
## GERY 0 0 0 0 0 0
## STEVE 0 0 0 0 0 0
## BERT 0 0 0 0 0 0
## RUSS 0 0 0 0 0 01.4 Symmetrizing
sna::symmetrize(campnet, rule = "weak") # OR rule, if either i->j or i<-j exist;## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 0 0 1 0 0 0 0 0 0 0 0 0 1
## [2,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [3,] 1 0 0 0 0 0 0 0 0 1 0 0 0
## [4,] 0 0 0 0 0 0 0 0 0 0 1 0 0
## [5,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [6,] 0 0 0 0 0 0 0 0 0 1 0 1 0
## [7,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [8,] 0 0 0 0 0 0 0 0 0 0 1 1 1
## [9,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [10,] 0 1 1 0 1 1 1 0 1 0 0 0 0
## [11,] 0 0 0 1 0 0 0 1 0 0 0 0 0
## [12,] 0 0 0 0 0 1 0 1 0 0 0 0 0
## [13,] 1 0 0 0 0 0 0 1 0 0 0 0 0
## [14,] 0 1 0 0 0 1 0 0 0 0 0 0 0
## [15,] 1 1 0 1 1 1 1 1 0 0 1 0 0
## [16,] 0 0 0 0 0 0 0 0 0 1 0 0 1
## [17,] 0 0 0 0 0 0 0 0 0 1 0 0 1
## [18,] 0 0 0 1 1 0 0 0 1 0 0 0 0
## [,14] [,15] [,16] [,17] [,18]
## [1,] 0 1 0 0 0
## [2,] 1 1 0 0 0
## [3,] 0 0 0 0 0
## [4,] 0 1 0 0 1
## [5,] 0 1 0 0 1
## [6,] 1 1 0 0 0
## [7,] 0 1 0 0 0
## [8,] 0 1 0 0 0
## [9,] 0 0 0 0 1
## [10,] 0 0 1 1 0
## [11,] 0 1 0 0 0
## [12,] 0 0 0 0 0
## [13,] 0 0 1 1 0
## [14,] 0 0 0 0 0
## [15,] 0 0 0 0 0
## [16,] 0 0 0 0 0
## [17,] 0 0 0 0 0
## [18,] 0 0 0 0 0sna::symmetrize(campnet, rule = "strong") # AND rule, iff i<->j exist;## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 0 0 0 0 0 0 0 0 0 0 0 0 1
## [2,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [4,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [5,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [6,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [7,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [8,] 0 0 0 0 0 0 0 0 0 0 1 0 1
## [9,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [10,] 0 0 0 0 0 1 1 0 0 0 0 0 0
## [11,] 0 0 0 0 0 0 0 1 0 0 0 0 0
## [12,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [13,] 1 0 0 0 0 0 0 1 0 0 0 0 0
## [14,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [15,] 0 0 0 0 0 0 1 0 0 0 0 0 0
## [16,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [17,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [18,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [,14] [,15] [,16] [,17] [,18]
## [1,] 0 0 0 0 0
## [2,] 0 0 0 0 0
## [3,] 0 0 0 0 0
## [4,] 0 0 0 0 0
## [5,] 0 0 0 0 0
## [6,] 0 0 0 0 0
## [7,] 0 1 0 0 0
## [8,] 0 0 0 0 0
## [9,] 0 0 0 0 0
## [10,] 0 0 0 0 0
## [11,] 0 0 0 0 0
## [12,] 0 0 0 0 0
## [13,] 0 0 0 0 0
## [14,] 0 0 0 0 0
## [15,] 0 0 0 0 0
## [16,] 0 0 0 0 0
## [17,] 0 0 0 0 0
## [18,] 0 0 0 0 0sna::symmetrize(campnet, rule = "upper") # copy the upper triangle over the lower;## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 0 0 0 0 0 0 0 0 0 0 0 0 1
## [2,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [3,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [4,] 0 0 0 0 0 0 0 0 0 0 1 0 0
## [5,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [6,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [7,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [8,] 0 0 0 0 0 0 0 0 0 0 1 0 1
## [9,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [10,] 0 1 1 0 1 1 1 0 1 0 0 0 0
## [11,] 0 0 0 1 0 0 0 1 0 0 0 0 0
## [12,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [13,] 1 0 0 0 0 0 0 1 0 0 0 0 0
## [14,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [15,] 1 1 0 1 1 1 1 0 0 0 1 0 0
## [16,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [17,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [18,] 0 0 0 0 0 0 0 0 1 0 0 0 0
## [,14] [,15] [,16] [,17] [,18]
## [1,] 0 1 0 0 0
## [2,] 0 1 0 0 0
## [3,] 0 0 0 0 0
## [4,] 0 1 0 0 0
## [5,] 0 1 0 0 0
## [6,] 0 1 0 0 0
## [7,] 0 1 0 0 0
## [8,] 0 0 0 0 0
## [9,] 0 0 0 0 1
## [10,] 0 0 0 0 0
## [11,] 0 1 0 0 0
## [12,] 0 0 0 0 0
## [13,] 0 0 0 0 0
## [14,] 0 0 0 0 0
## [15,] 0 0 0 0 0
## [16,] 0 0 0 0 0
## [17,] 0 0 0 0 0
## [18,] 0 0 0 0 0sna::symmetrize(campnet, rule = "lower") # copy the lower triangle over the upper;## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 0 0 1 0 0 0 0 0 0 0 0 0 1
## [2,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3,] 1 0 0 0 0 0 0 0 0 0 0 0 0
## [4,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [5,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [6,] 0 0 0 0 0 0 0 0 0 1 0 1 0
## [7,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [8,] 0 0 0 0 0 0 0 0 0 0 1 1 1
## [9,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [10,] 0 0 0 0 0 1 1 0 0 0 0 0 0
## [11,] 0 0 0 0 0 0 0 1 0 0 0 0 0
## [12,] 0 0 0 0 0 1 0 1 0 0 0 0 0
## [13,] 1 0 0 0 0 0 0 1 0 0 0 0 0
## [14,] 0 1 0 0 0 1 0 0 0 0 0 0 0
## [15,] 0 0 0 0 0 0 1 1 0 0 0 0 0
## [16,] 0 0 0 0 0 0 0 0 0 1 0 0 1
## [17,] 0 0 0 0 0 0 0 0 0 1 0 0 1
## [18,] 0 0 0 1 1 0 0 0 0 0 0 0 0
## [,14] [,15] [,16] [,17] [,18]
## [1,] 0 0 0 0 0
## [2,] 1 0 0 0 0
## [3,] 0 0 0 0 0
## [4,] 0 0 0 0 1
## [5,] 0 0 0 0 1
## [6,] 1 0 0 0 0
## [7,] 0 1 0 0 0
## [8,] 0 1 0 0 0
## [9,] 0 0 0 0 0
## [10,] 0 0 1 1 0
## [11,] 0 0 0 0 0
## [12,] 0 0 0 0 0
## [13,] 0 0 1 1 0
## [14,] 0 0 0 0 0
## [15,] 0 0 0 0 0
## [16,] 0 0 0 0 0
## [17,] 0 0 0 0 0
## [18,] 0 0 0 0 01.5 Network Modes
Brief intro to dataset: “The National Longitudinal Study of Adolescent to Adult Health (Add Health) is a longitudinal study of a nationally representative sample of adolescents in grades 7-12 in the United States during the 1994-95 school year. Add Health combines longitudinal survey data on respondents’ social, economic, psychological and physical well-being with contextual data on the family, neighborhood, community, school, friendships, peer groups, and romantic relationships, providing unique opportunities to study how social environments and behaviors in adolescence are linked to health and achievement outcomes in young adulthood.”
Tidyverse grammar: - Selecting: always refers to selecting the columns you want. - Arranging: reorder rows with respect to columns. - Mutating: refers to creating a new variable based on operations peformed on another variable. - Filtering: refers to filtering by rows - Renaming: refers to relabeling column names. - Gathering: refers to gathering columns to transform a wide data set into a long one. - Summarizing: refers to generating summary statitics for a given variable. - Separating: refers to splitting delimited values in one column into multiple columns - Distinct: Eliminates all duplicate values - Joining: refers to merging data sets using key variable.
- Import and arrange AddHealth data
AHS_WPVAR <- rio::import('./data/ahs_wpvar.csv')| commcnt | sdummy | ego_nid | mfnid_1 | mfnid_2 | mfnid_3 | mfnid_4 | mfnid_5 | mfact_1 | mfact_2 | mfact_3 | mfact_4 | mfact_5 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 1 | 1 | 52 | 99999 | NA | NA | NA | 0 | 0 | NA | NA | NA |
| 1 | 1 | 2 | 99999 | 33 | 57 | 59 | 62 | 1 | 1 | 1 | 1 | 1 |
| 1 | 1 | 3 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| 1 | 1 | 4 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| 1 | 1 | 5 | 99999 | NA | NA | NA | NA | 2 | NA | NA | NA | NA |
| 1 | 1 | 6 | 99999 | 19 | 26 | 47 | NA | 1 | 1 | 1 | 0 | NA |
mf stands for “male friend”; ff female friend; mfact stands for # of acts;
- Transform data wide to long as to capture all ties between Ego and Alters. Alters currently organised in different columns. Two variables: tie and frequency of interaction (number of acts).
AHS_Edges <- AHS_WPVAR %>%
select(ego_nid, mfnid_1:mfnid_5, ffnid_1:ffnid_5, commcnt, sex) %>%
filter(commcnt == 7) %>%
gather(Alter_Label, value, mfnid_1:mfnid_5, ffnid_1:ffnid_5, na.rm = TRUE) %>%
arrange(ego_nid, sex) %>%
filter(value != 99999) %>%
select(ego_nid, value) %>%
rename(Sender = `ego_nid`, Target = `value`) - Creating list of nodes
AHS_Nodes <- AHS_Edges %>%
gather(Alter_Label, value, Sender, Target, na.rm = TRUE) %>%
select(value) %>% rename(ego_nid = `value`)
AHS_Nodes <- AHS_Nodes %>% distinct(ego_nid)
AHS_Nodes <- AHS_Nodes %>% (add_rownames) %>% rename (Sender_ID = rowname) %>%
mutate(Sender_ID = as.numeric(Sender_ID)) - Merging/Joining Numeric IDs into the Edgelist
AHS_Nodes <- AHS_Nodes %>% rename(Sender = `ego_nid`)
AHS_Edges <- AHS_Edges %>% left_join(AHS_Nodes, by = c("Sender"))
AHS_Nodes <- AHS_Nodes %>% rename(Target = `Sender`, Target_ID = `Sender_ID`)
AHS_Edges <- AHS_Edges %>% left_join(AHS_Nodes, by = c("Target"))- Tidying up edgelists and list of nodes
AHS_Edges <- AHS_Edges %>%
select(Sender_ID, Target_ID) %>%
rename(Sender = `Sender_ID`, Target = `Target_ID`)
AHS_Nodes <- AHS_Nodes %>%
rename (ego_nid = `Target`, ID = `Target_ID`)- Adding attributes
AHS_Attributes <- AHS_WPVAR %>%
select(commcnt, ego_nid, sex, grade, race5) %>%
filter(commcnt == 7)
AHS_Nodes <- AHS_Nodes %>%
left_join(AHS_Attributes, by = c("ego_nid"))
save(AHS_Edges,file="AHS_Edges.Rda")
save(AHS_Nodes, file="AHS_Nodes.Rda")- Creating adjacency matrix
number.nodes <- length(unique(c(AHS_Edges$Sender, AHS_Edges$Target)))
ties <- cbind(a=AHS_Edges$Sender, b=AHS_Edges$Target)
ahs.adjmat <- matrix(0, number.nodes, number.nodes)
ahs.adjmat[ties] <- 1
ahs.adjmat[1:15, 1:15]## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [4,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [5,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [6,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [7,] 0 0 0 0 0 0 0 0 0 0 0 1 0
## [8,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [9,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [10,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [11,] 0 0 0 0 0 0 0 0 0 1 0 0 0
## [12,] 0 0 0 0 1 0 1 0 0 0 0 0 0
## [13,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [14,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [15,] 0 0 0 0 0 0 0 0 0 0 0 0 0
## [,14] [,15]
## [1,] 0 0
## [2,] 0 0
## [3,] 0 0
## [4,] 0 0
## [5,] 0 0
## [6,] 0 0
## [7,] 0 0
## [8,] 0 0
## [9,] 0 0
## [10,] 0 0
## [11,] 0 0
## [12,] 0 0
## [13,] 0 0
## [14,] 0 0
## [15,] 0 01.5.1 One-mode network
1.5.1.1 with statnet: from an edgelist
print(AHS_Edges[1:20,])## Sender Target
## 1 1 108
## 2 1 112
## 3 1 166
## 4 1 113
## 5 1 132
## 6 1 151
## 7 1 204
## 8 2 51
## 9 3 85
## 10 3 117
## 11 3 183
## 12 3 235
## 13 3 56
## 14 3 57
## 15 3 64
## 16 3 182
## 17 3 214
## 18 4 131
## 19 5 243
## 20 6 85ahs.net <- network::network(AHS_Edges, matrix.type = "edgelist")
print(ahs.net)## Network attributes:
## vertices = 440
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges= 2099
## missing edges= 0
## non-missing edges= 2099
##
## Vertex attribute names:
## vertex.names
##
## Edge attribute names not shown1.5.1.2 with statnet: from an adjacency matrix
adj.mat <- network::as.matrix.network(ahs.net)
adj.mat[1:20, 1:20]## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 11 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0
## 12 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0
## 13 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 15 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 17 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 18 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 19 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 20 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0ahs.net <- network::network(adj.mat, matrix.type = "adjacency")
print(ahs.net)## Network attributes:
## vertices = 440
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges= 2099
## missing edges= 0
## non-missing edges= 2099
##
## Vertex attribute names:
## vertex.names
##
## Edge attribute names not shown1.5.1.3 with igraph: from an edgelist
print(as.matrix(AHS_Edges[1:10,]))## Sender Target
## 1 1 108
## 2 1 112
## 3 1 166
## 4 1 113
## 5 1 132
## 6 1 151
## 7 1 204
## 8 2 51
## 9 3 85
## 10 3 117ahs.net <- igraph::graph_from_edgelist(as.matrix(AHS_Edges))
print(ahs.net)## IGRAPH 9045073 D--- 440 2099 --
## + edges from 9045073:
## [1] 1->108 1->112 1->166 1->113 1->132 1->151 1->204 2-> 51
## [9] 3-> 85 3->117 3->183 3->235 3-> 56 3-> 57 3-> 64 3->182
## [17] 3->214 4->131 5->243 6-> 85 6->117 6->167 6->183 6->185
## [25] 6-> 56 6->165 6->179 6->214 7-> 12 7-> 68 7->149 8->111
## [33] 8->183 8->186 8->241 8-> 86 8->215 9->102 9->181 9->207
## [41] 9->236 9-> 55 9-> 56 9-> 67 10->411 10-> 33 11->411 11->243
## [49] 11-> 10 12-> 5 12-> 7 12-> 71 13-> 88 13->216 13->412 14->248
## [57] 14-> 71 14-> 83 14->149 15-> 30 15->130 15->178 15-> 81 15->106
## [65] 15->151 15->215 16->413 16->186 16->220 16-> 57 16->135 16->211
## + ... omitted several edgesLet’s understand the information contained in an igraph object:
IGRAPHsimply annotates g as an igraph object704e0f7or whatever followsIGRAPHis simply howigraphidentifies thegfor itselfD---refers to descriptive details of g :Uwould tell us thatgis an undirected graphDtells us thatgis directed graphNwould thatgis a named graph, in that the vertices have anameattribute--refers to attributes not applicable tog, but you may see them in the future:Wwould refer to a weighted graph, where edges have aweightattributeBwould refer to a bipartite graph, where vertices have atypeattribute
440refers to the number of vertices ing2099refers to the number of edges ingattr: would display a list of attributes within the graph. There are no attributes in this network. But, in cases where you load networks that use names instead of numbers, you will seenamelisted afterattr: . You will see multiple attributes in the future.(v/c), which will appear followingname, tells us that it is a vertex attribute of acharacterdata type. character is simply what R calls astring.- In the future we will also see:
(e/c)or(e/n)referring to edge attributes that are of character or numeric data types(g/c)or(g/n)referring to graph attributes that are of character or numeric data types
+ edges from 704e0f7:lists a sample of g ’s edges using the names of the vertices which they connect.
1.5.1.4 with igraph: from an adjacency matrix
ahs.net <- igraph::graph.adjacency(ahs.adjmat, mode="directed", weighted=NULL, diag=FALSE)
print(ahs.net)## IGRAPH ba2f6b9 D--- 440 2099 --
## + edges from ba2f6b9:
## [1] 1->108 1->112 1->113 1->132 1->151 1->166 1->204 2-> 51
## [9] 3-> 56 3-> 57 3-> 64 3-> 85 3->117 3->182 3->183 3->214
## [17] 3->235 4->131 5->243 6-> 56 6-> 85 6->117 6->165 6->167
## [25] 6->179 6->183 6->185 6->214 7-> 12 7-> 68 7->149 8-> 86
## [33] 8->111 8->183 8->186 8->215 8->241 9-> 55 9-> 56 9-> 67
## [41] 9->102 9->181 9->207 9->236 10-> 33 10->411 11-> 10 11->243
## [49] 11->411 12-> 5 12-> 7 12-> 71 13-> 88 13->216 13->412 14-> 71
## [57] 14-> 83 14->149 14->248 15-> 30 15-> 81 15->106 15->130 15->151
## [65] 15->178 15->215 16-> 57 16->135 16->186 16->211 16->214 16->220
## + ... omitted several edges1.5.1.5 From a nodelist? igraph only package to handle nodelists; so, use edgelists instead.
ahs.nodelist <- NULL
for (i in unique(AHS_Edges$Sender)) {
nodelist <- unlist(strsplit(paste(c(i, AHS_Edges$Target[AHS_Edges$Sender ==
i]), collapse = ","), ","))
names(nodelist) <- c("sender", paste0(rep("target", length(nodelist) - 1),
1:(length(nodelist) - 1)))
ahs.nodelist <- plyr::rbind.fill(ahs.nodelist, data.frame(t(as.matrix(nodelist))))
}
ahs.nodelist <- as.matrix(ahs.nodelist)[, -1] # Make sure row.names == sender columns
ahs.nodelist <- split(ahs.nodelist, 1:nrow(ahs.nodelist))
ahs.nodelist <- lapply(ahs.nodelist, function(x) x[!is.na(x)])
print(ahs.nodelist[1:10])## $`1`
## [1] "108" "112" "166" "113" "132" "151" "204"
##
## $`2`
## [1] "51"
##
## $`3`
## [1] "85" "117" "183" "235" "56" "57" "64" "182" "214"
##
## $`4`
## [1] "131"
##
## $`5`
## [1] "243"
##
## $`6`
## [1] "85" "117" "167" "183" "185" "56" "165" "179" "214"
##
## $`7`
## [1] "12" "68" "149"
##
## $`8`
## [1] "111" "183" "186" "241" "86" "215"
##
## $`9`
## [1] "102" "181" "207" "236" "55" "56" "67"
##
## $`10`
## [1] "411" "33"ahs.net <- igraph::graph_from_adj_list(ahs.nodelist, mode = "out")
print(ahs.net)## IGRAPH acde59e D--- 440 2099 --
## + edges from acde59e:
## [1] 1->108 1->112 1->166 1->113 1->132 1->151 1->204 2-> 51
## [9] 3-> 85 3->117 3->183 3->235 3-> 56 3-> 57 3-> 64 3->182
## [17] 3->214 4->131 5->243 6-> 85 6->117 6->167 6->183 6->185
## [25] 6-> 56 6->165 6->179 6->214 7-> 12 7-> 68 7->149 8->111
## [33] 8->183 8->186 8->241 8-> 86 8->215 9->102 9->181 9->207
## [41] 9->236 9-> 55 9-> 56 9-> 67 10->411 10-> 33 11->411 11->243
## [49] 11-> 10 12-> 5 12-> 7 12-> 71 13-> 88 13->216 13->412 14->248
## [57] 14-> 71 14-> 83 14->149 15-> 30 15->130 15->178 15-> 81 15->106
## [65] 15->151 15->215 16->413 16->186 16->220 16-> 57 16->135 16->211
## + ... omitted several edges1.5.2 Working with Network Objects
1.5.2.1 with statnet
- Attributes
ahs.net <- network::network(AHS_Edges, matrix.type = "edgelist")
# Node attributes
network::set.vertex.attribute(ahs.net, "sex", AHS_Nodes$sex)library(statnet)ahs.net %v% "race" <- AHS_Nodes$race5
detach("package:statnet", unload=TRUE)
network::list.vertex.attributes(ahs.net)## [1] "na" "race" "sex" "vertex.names"network::get.vertex.attribute(ahs.net, "race")## [1] 3 1 1 1 3 1 1 1 1 3 1 1 1 1 1 1 1 1 1 5 1 1 1 1 5 1 1 1 1 1 1 1 1 1 1
## [36] 1 1 1 5 1 1 1 1 0 5 5 1 1 1 1 5 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 5 1 1 1
## [71] 0 1 3 1 1 1 3 1 5 1 1 5 1 1 1 1 1 1 1 1 1 1 1 1 1 5 1 1 5 1 5 1 1 1 3
## [106] 1 1 1 1 1 1 1 1 1 1 5 1 3 1 1 1 1 1 5 1 1 5 1 1 1 1 1 1 5 1 1 1 1 3 1
## [141] 1 1 1 1 1 1 1 3 5 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 5 1 1 1 1 1
## [176] 5 1 1 1 1 1 1 3 5 1 1 1 5 1 1 1 1 1 1 1 1 5 3 1 3 5 3 3 5 4 1 1 1 5 1
## [211] 1 1 1 1 1 1 1 1 5 1 1 1 1 1 1 1 1 1 5 1 1 1 1 1 1 1 1 1 5 1 1 1 1 1 3
## [246] 1 1 1 1 1 1 5 1 5 0 1 5 1 1 0 1 1 5 1 1 1 3 1 1 1 1 5 5 1 3 3 1 1 1 5
## [281] 1 1 1 1 3 1 1 1 1 0 1 1 1 1 5 1 1 1 1 3 1 1 1 1 5 3 1 1 1 1 1 1 5 1 1
## [316] 1 5 3 1 4 5 1 1 3 1 1 1 1 0 1 5 5 1 1 1 1 5 1 1 5 1 1 1 1 1 1 5 1 1 5
## [351] 1 1 5 1 1 1 1 1 1 1 1 1 1 1 1 5 1 1 1 1 1 1 1 3 5 3 1 1 5 1 1 5 3 5 3
## [386] 5 1 1 1 1 1 1 5 1 3 1 1 1 1 5 0 1 1 1 1 5 1 1 1 1 1 1 3 1 5 3 3 3 5 5
## [421] 1 5 2 5 3 5 1 1 5 1 5 5 1 1 0 5 1 5 3 1network::delete.vertex.attribute(ahs.net, "sex")
# Edge attributes
network::set.edge.attribute(ahs.net, "value", 1)
ahs.net %e% "value" <- 1
network::list.edge.attributes(ahs.net)## [1] "na" "value"# Network attributes
network::set.network.attribute(ahs.net, "degree distribution", 1:10)- Visualization
ahs.net <- network::network(AHS_Edges, matrix.type = "edgelist")
AHS_Nodes$gender <- ifelse(AHS_Nodes$sex==1, "M", "F")
network::set.vertex.attribute(ahs.net, "gender", AHS_Nodes$gender)
nodeColors <- ifelse(AHS_Nodes$gender == "M", "hotpink", "dodgerblue")
gender.label <- network::get.vertex.attribute(ahs.net, "gender")
gplot(ahs.net, gmode = "digraph", displaylabels = TRUE, vertex.col = nodeColors,
label = gender.label, label.cex = 0.5, label.col = nodeColors, mode="fruchtermanreingold",
usearrows = FALSE, usecurve = TRUE, edge.curve = 0.1)
- Export to other formats
head(network::as.matrix.network(ahs.net, matrix.type = "edgelist")) # Edgelist
network::as.matrix.network(ahs.net, matrix.type="adjacency")[1:5, 1:5] # Adjacency Matrix
head(sna::as.edgelist.sna(ahs.net))
sna::as.sociomatrix.sna(ahs.net)[1:5, 1:5]1.5.2.2 with igraph
- Attributes
ahs.net <- igraph::graph.data.frame(AHS_Edges)
ahs.net <- igraph::set.vertex.attribute(ahs.net, "gender", index=igraph::V(ahs.net), AHS_Nodes$gender)
names(igraph::get.vertex.attribute(ahs.net))## [1] "name" "gender"summary(ahs.net)## IGRAPH fd8ddc4 DN-- 440 2099 --
## + attr: name (v/c), gender (v/c)- Network metadata
igraph::ecount(ahs.net)## [1] 2099igraph::vcount(ahs.net)## [1] 440igraph::V(ahs.net)[1:10]## + 10/440 vertices, named, from fd8ddc4:
## [1] 1 2 3 4 5 6 7 8 9 10igraph::no.clusters(ahs.net)## [1] 4igraph::is.connected(ahs.net)## [1] FALSEigraph::is.directed(ahs.net)## [1] TRUEigraph::get.edgelist(ahs.net)[1:10,]## [,1] [,2]
## [1,] "1" "108"
## [2,] "1" "112"
## [3,] "1" "166"
## [4,] "1" "113"
## [5,] "1" "132"
## [6,] "1" "151"
## [7,] "1" "204"
## [8,] "2" "51"
## [9,] "3" "85"
## [10,] "3" "117"- Visualization
ahs_layout <- igraph::layout.fruchterman.reingold(ahs.net)
vertex.colors <- igraph::get.vertex.attribute(ahs.net,"gender")
vertex.colors <- ifelse(vertex.colors == "M", "blue", "pink")
plot(ahs.net, layout=ahs_layout, vertex.color=vertex.colors,
vertex.label=NA, edge.arrow.size=.1, vertex.size=3)
1.5.2.3 with sna_tools
ahs.net <- igraph::graph.data.frame(AHS_Edges)
summary(ahs.net)## IGRAPH 0f6eab6 DN-- 440 2099 --
## + attr: name (v/c)ahs.net <- ahs.net %>% snatools::as_network()
print(ahs.net)## Network attributes:
## vertices = 440
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges= 2099
## missing edges= 0
## non-missing edges= 2099
##
## Vertex attribute names:
## .vrt_id vertex.names
##
## Edge attribute names not shownahs.net <- ahs.net %>% snatools::as_igraph()
summary(ahs.net)## IGRAPH 03ecf9e DN-- 440 2099 --
## + attr: .vrt_id (v/n), name (v/c), .edg_id (e/n)1.5.3 Two-mode networks
Suppose we want to analyse how people are connected based on their voting patterns? That is, we want to draw a network where a tie is present between a dyad if they voted the same way on a bill. We need to perform a two-mode to one-mode conversion.
Case in point: Brexit indicative votes. Indicative votes are where MPs vote on a series of options designed to test the will of Parliament to see what, if anything, commands a majority. In the case of Brexit, supporters of indicative votes believe it could provide a way out of the current political stalemate. Usually the government has control over what happens day-to-day in Parliament, but MPs have backed a proposal by a cross-party group of MPs, including Labour’s Hilary Benn and Conservative Sir Oliver Letwin, to take control of the timetable. Under the cross-party plan, MPs can put forward their preferred Brexit plans to Speaker John Bercow, who will select all or some of these options for debate. MPs may be asked to consider whether any plan agreed by Parliament should be put back to the public in another referendum, or whether the UK should stop Brexit altogether by revoking its notification of Article 50. Following a debate on the various options, at 7pm the Commons will be suspended for 30 minutes so MPs can vote on the each plan. During the indicative votes, MPs will enter one of the division lobbies - the corridors in the House of Commons where votes are normally counted - and will receive a paper ballot. They can vote “yes” or “no” on as many options as they are prepared to support.
- Analysing votes individually
## Import Brexit indicative votes
brexit.votes <- readRDS("./data/indicative_votes.rds")
brexit.edgelist <- data.frame(brexit.votes %>% select(Member, Party, Vote, description) %>% spread(description, Vote))
brexit.edgelist <- brexit.edgelist[,-ncol(brexit.edgelist)]
colnames(brexit.edgelist) <- c("mp", "party", "baron", "beckett", "boles", "cherry", "clarke", "corbyn", "eusrace", "fysh")
votes <- c("baron", "beckett", "boles", "cherry", "clarke", "corbyn", "eusrace", "fysh")| mp | party | baron | beckett | boles | cherry | clarke | corbyn | eusrace | fysh |
|---|---|---|---|---|---|---|---|---|---|
| ?rfhlaith Begley | Sinn F?in | No Vote Recorded | No Vote Recorded | No Vote Recorded | No Vote Recorded | No Vote Recorded | No Vote Recorded | No Vote Recorded | No Vote Recorded |
| Adam Afriyie | Conservative | Aye | No | No | No | No | No | No | Aye |
| Adam Holloway | Conservative | Aye | No | No | No | No | No | No | Aye |
| Adrian Bailey | Labour | No | Aye | Aye | No Vote Recorded | Aye | Aye | No Vote Recorded | No |
| Afzal Khan | Labour | No | Aye | Aye | No Vote Recorded | Aye | Aye | No Vote Recorded | No |
| Alan Brown | Scottish National Party | No | Aye | No Vote Recorded | Aye | No Vote Recorded | No Vote Recorded | No | No |
brexit.edgelist <- brexit.edgelist %>% mutate_at(votes, function(x) ifelse(x=="Aye", 1, ifelse(x=="No", 0, NA)))| mp | party | baron | beckett | boles | cherry | clarke | corbyn | eusrace | fysh |
|---|---|---|---|---|---|---|---|---|---|
| ?rfhlaith Begley | Sinn F?in | NA | NA | NA | NA | NA | NA | NA | NA |
| Adam Afriyie | Conservative | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 1 |
| Adam Holloway | Conservative | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 1 |
| Adrian Bailey | Labour | 0 | 1 | 1 | NA | 1 | 1 | NA | 0 |
| Afzal Khan | Labour | 0 | 1 | 1 | NA | 1 | 1 | NA | 0 |
| Alan Brown | Scottish National Party | 0 | 1 | NA | 1 | NA | NA | 0 | 0 |
- Analysing all votes together
brexit.votes <- data.frame(readRDS("./data/indicative_votes.rds") %>% select(Member, Party, Vote, description))
# Remove non-recorded votes
brexit.votes <- brexit.votes[-grep("No Vote Recorded|No", brexit.votes$Vote),]
brexit.votes <- data.frame(mp=brexit.votes$Member, party=brexit.votes$Party, motion=brexit.votes$description)
brexit.votes[1:10,]| mp | party | motion |
|---|---|---|
| Wendy Morton | Conservative | Baron (No Deal) |
| Nigel Mills | Conservative | Fysh (tariffs) |
| Nigel Mills | Conservative | Baron (No Deal) |
| Nick Herbert | Conservative | Clarke (CU) |
| Nick Herbert | Conservative | Boles (CM2.0) |
| Nick Herbert | Conservative | Eustace (EFTA) |
| Gloria De Piero | Labour | Corbyn (Lab.) |
| Gloria De Piero | Labour | Clarke (CU) |
| Gloria De Piero | Labour | Boles (CM2.0) |
| Damian Green | Conservative | Clarke (CU) |
brexit.votes.2mode.edgelist <- brexit.votes[,c(1,3)]
brexit.votes.2mode.adj <- as.matrix(table(brexit.votes.2mode.edgelist))
brexit.votes.2mode.adj[1:10, 1:7]## motion
## mp Baron (No Deal) Beckett (Public vote) Boles (CM2.0)
## Adam Afriyie 1 0 0
## Adam Holloway 1 0 0
## Adrian Bailey 0 1 1
## Afzal Khan 0 1 1
## Alan Brown 0 1 0
## Alan Campbell 0 1 0
## Alan Duncan 0 0 0
## Alan Mak 1 0 0
## Alan Whitehead 0 1 1
## Albert Owen 0 1 1
## motion
## mp Cherry (Revocation) Clarke (CU) Corbyn (Lab.)
## Adam Afriyie 0 0 0
## Adam Holloway 0 0 0
## Adrian Bailey 0 1 1
## Afzal Khan 0 1 1
## Alan Brown 1 0 0
## Alan Campbell 0 1 1
## Alan Duncan 1 0 0
## Alan Mak 0 0 0
## Alan Whitehead 1 1 1
## Albert Owen 1 1 1
## motion
## mp Eustace (EFTA)
## Adam Afriyie 0
## Adam Holloway 0
## Adrian Bailey 0
## Afzal Khan 0
## Alan Brown 0
## Alan Campbell 0
## Alan Duncan 0
## Alan Mak 0
## Alan Whitehead 0
## Albert Owen 0# Creating igraph object for 2-mode network
brexit.2mode.graph <- igraph::graph.incidence(brexit.votes.2mode.adj, mode="all")
igraph::V(brexit.2mode.graph)$color <- ""
igraph::V(brexit.2mode.graph)$color[1:(igraph::vcount(brexit.2mode.graph)-7)] <- "red"
igraph::V(brexit.2mode.graph)$color[(igraph::vcount(brexit.2mode.graph)-7):igraph::vcount(brexit.2mode.graph)] <- "green"
igraph::V(brexit.2mode.graph)$label <- igraph::V(brexit.2mode.graph)$name
igraph::V(brexit.2mode.graph)$label.color <- rgb(0,0,.2,.5)
igraph::V(brexit.2mode.graph)$label.cex <- .4
igraph::V(brexit.2mode.graph)$size <- 6
igraph::V(brexit.2mode.graph)$frame.color <- NA
igraph::E(brexit.2mode.graph)$color <- rgb(.5,.5,0,.2)
brexit_layout <- igraph::layout.fruchterman.reingold(brexit.2mode.graph)
plot(brexit.2mode.graph, layout=brexit_layout)
To convert a two-mode incidence matrix to a one-mode adjacency matrix, one can simply multiply an incidence matrix by its transpose, which sum the common 1’s between rows.
\[\begin{align*} AB = \left[ \begin{array}{cc} a & b \\ c & d \end{array} \right] \left[ \begin{array}{cc} e & f \\ g & h \end{array} \right] = \left[ \begin{array}{cc} ae+bg & af+bh \\ ce+dg & cf+dh \end{array} \right] \end{align*}\]
Now multiplying the matrix by its transpose:
\[\begin{align*} AA' = \left[ \begin{array}{cc} a & b \\ c & d \end{array} \right] \left[ \begin{array}{cc} a & c \\ b & d \end{array} \right] = \left[ \begin{array}{cc} aa+bb & ac+bd \\ ca+db & cc+dd \end{array} \right] \end{align*}\]
Because our incidence matrix consists of 0’s and 1’s, the off-diagonal entries represent the total number of common columns, which is exactly what we wanted.
# One-mode projection
brexit.votes.1mode.proj <- brexit.votes.2mode.adj %*% t(brexit.votes.2mode.adj)
# Alternatively, use tcrossprod() function, which is much faster as it creates sparse matrices
brexit.votes.1mode.proj[1:5, 1:5] ## mp
## mp Adam Afriyie Adam Holloway Adrian Bailey Afzal Khan
## Adam Afriyie 2 2 0 0
## Adam Holloway 2 2 0 0
## Adrian Bailey 0 0 4 4
## Afzal Khan 0 0 4 4
## Alan Brown 0 0 1 1
## mp
## mp Alan Brown
## Adam Afriyie 0
## Adam Holloway 0
## Adrian Bailey 1
## Afzal Khan 1
## Alan Brown 2brexit.votes.1mode.graph <- igraph::graph.adjacency(brexit.votes.1mode.proj, mode="undirected", weighted=TRUE, diag=FALSE) # Weighted = TRUE (MPs vote on MULTIPLE motions together)
brexit_layout <- igraph::layout.fruchterman.reingold(brexit.votes.1mode.graph)
party <- data.frame(mp=as.character(igraph::V(brexit.votes.1mode.graph)$name)) %>% left_join(brexit.edgelist[,1:2])
party$party <- as.character(party$party)
party <- party %>% mutate(color = case_when(party=="Conservative" ~ "blue" ,
party=="Democratic Unionist Party" ~ "pink",
party=="Green Party" ~ "green",
party=="Independent" ~ "gray",
party=="Labour" ~ "red",
party=="Liberal Democrat" ~ "orange",
party=="Plaid Cymru" ~ "darkgreen",
party=="Scottish National Party" ~ "yellow"))
igraph::V(brexit.votes.1mode.graph)$party <- as.character(party$party)
igraph::V(brexit.votes.1mode.graph)$color <- as.character(party$color)
igraph::V(brexit.votes.1mode.graph)$label.color <- "black"
igraph::E(brexit.votes.1mode.graph)$width <- igraph::E(brexit.votes.1mode.graph)$weight/20
igraph::E(brexit.votes.1mode.graph)$edge.color <- "gray10"
edge.start <- igraph::ends(brexit.votes.1mode.graph, es=igraph::E(brexit.votes.1mode.graph), names=F)[,1]
edge.col <- igraph::V(brexit.votes.1mode.graph)$color[edge.start]
plot(brexit.votes.1mode.graph, edge.arrow.size=.1, edge.curved=.1, layout=brexit_layout,
vertex.size=3, vertex.label=NA, edge.color=edge.col)
library(ggraph)
library(gganimate)
library(tidygraph)
library(gifski)
library(stringi)
# Amimation without edges
graph <-brexit.votes.1mode.graph %>% as_tbl_graph()
graph
layout_list <- list(
list(layout = 'star'),
list(layout = 'circle'),
list(layout = 'gem'),
list(layout = 'graphopt'),
list(layout = 'grid'),
list(layout = 'mds'),
list(layout = 'randomly'),
list(layout = 'fr'),
list(layout = 'kk'),
list(layout = 'nicely'),
list(layout = 'lgl'),
list(layout = 'drl'))
#filtered_graph <- graph %>% mutate(community = group_walktrap())
layouts <- graph %>%
invoke_map('create_layout', layout_list, graph = .) %>%
set_names(unlist(layout_list)) %>%
bind_rows(.id = 'layout')
dummy_layout <- create_layout(graph, 'nicely')
attr(layouts, 'graph') <- attr(dummy_layout, 'graph')
attr(layouts, 'circular') <- FALSE
# Plot with singular layout + edges
graph %>% ggraph(layout="nicely") +
geom_node_point(aes(col = as.factor(color))) +
geom_edge_arc(alpha = 0.01, aes(edge_width = width/3, col="gray")) +
theme_graph() + theme(legend.position = 'none') +
labs(title = "Commons' Brexit Parties",
subtitle = 'Using nicely layout engine')
ggsave("./output/brexit_toolarge.png")
# Animation with multiple layouts
g <- ggraph(layouts.sub) +
geom_node_point(aes(col = as.factor(color))) +
theme_graph() +
theme(legend.position = 'none') +
labs(title = "Commons' Brexit Parties",
subtitle = 'Using {closest_state} layout engine') +
transition_states(layout, 1, 2) +
ease_aes('linear') +
view_follow()
animated.graph <- animate(g, fps = 30, nframes = 1000)
gganimate::anim_save("brexit_animation.gif", animation = last_animation(), path = "./output/")
save(animated.graph, file="./data/animated_Brexit.RData")