Plotting social networks
1 Introduction
In this assignment/tutorial I will demonstrate how to plot networks with the igraph package. During the workgroup I will explain all code. For those of you who don’t attend the workgroups, google knows way more than I do.
Someone who also knows more than I do, especially with respect to plotting of Social Networks is Katya Ognyanova (aka Kateto). Please visit her site.
In the upper left and right corner of the code blocks you will find copy-to-clipboard buttons. Use these buttons to copy the code to your own editor.
2 Before you start
Before you start, check whether you run the latest RStudio version (from the Help menu, pick ‘check for updates’ and whether you need to update R.
install.packages("installr") #you first install packages
require(installr) #then you will need to activate packages.
updateR() #run the function to start the update processGive your script a nice name. Include the author, and data when you last modified the script. Include a lot of comments in your script! Don’t forget, always start with cleaning up your workspace.
And set your working directory.
# set working directory
setwd("C:\\YOURDIR\\YOURSUBDIR\\YOURSUBSUBDIR\\") #change to your own workdirectoryInstall the packages you will need.
3 Data
We are going to play with Twitter Networks among Dutch MPs.
Download twitter_20190919.RdataLoad the Robject and have a look at it. Save the list elements in separate objects.
load("static/twitter_20190919.RData") #change to your working directory
str(twitter_20190919, 1)
keyf <- twitter_20190919[[1]]
mydata <- twitter_20190919[[2]]
seats <- twitter_20190919[[3]]## List of 3
## $ keyf :'data.frame': 147 obs. of 41 variables:
## $ mydata:List of 8
## ..- attr(*, "higher")= Named logi [1:9] FALSE FALSE FALSE FALSE FALSE FALSE ...
## .. ..- attr(*, "names")= chr [1:9] "fnet,fnet" "atmnet,fnet" "rtnet,fnet" "fnet,atmnet" ...
## ..- attr(*, "disjoint")= Named logi [1:9] FALSE FALSE FALSE FALSE FALSE FALSE ...
## .. ..- attr(*, "names")= chr [1:9] "fnet,fnet" "atmnet,fnet" "rtnet,fnet" "fnet,atmnet" ...
## ..- attr(*, "atLeastOne")= Named logi [1:9] FALSE FALSE FALSE FALSE FALSE FALSE ...
## .. ..- attr(*, "names")= chr [1:9] "fnet,fnet" "atmnet,fnet" "rtnet,fnet" "fnet,atmnet" ...
## ..- attr(*, "class")= chr "siena"
## $ seats :'data.frame': 150 obs. of 5 variables:So, what do we have?
- keyf: a data.frame on 147 Dutch MPs.
- mydata: This an object which is ready to analyze in RSiena. It is actually a quite complicated object. For now three things are important:
- The nodes in mydata are the same as in keyf and in seats.
- It contains the twitter data at three timepoints (in
mydata$depvars). We have three layers:
- fnet: who follows whom
- atmnet: who atmentions whom
- rtnet: who retweats whom
- It also contains timeinvariant information on the nodes (in
mydata$cCovars)
- The nodes in mydata are the same as in keyf and in seats.
- seats: a dataset which contains the coordinates of the seats in the House of Parliament in the Netherlands.
We are going to focus on the atmentions of politicians. This is most closely related to political discussion. Thus who is having discussions with whom on Twitter?
Let us go fishing for some data:
fnet <- mydata$depvars$fnet
atmnet <- mydata$depvars$atmnet
rtnet <- mydata$depvars$rtnet
vrouw <- mydata$cCovars$vrouw
partij <- mydata$cCovars$partij
ethminz <- mydata$cCovars$ethminz
lft <- mydata$cCovars$lft
# if you construct an object for RSiena, covariates are mean centered by default. I would like to
# have the original values again.
ethminz <- ethminz + attributes(ethminz)$mean
partij <- partij + attributes(partij)$mean
vrouw <- vrouw + attributes(vrouw)$mean
lft <- lft + attributes(lft)$meanHave a look at the network data. What are we a looking at?
## 'sienaDependent' num [1:147, 1:147, 1:3] 0 0 0 1 0 1 0 1 1 1 ...
## - attr(*, "type")= chr "oneMode"
## - attr(*, "sparse")= logi FALSE
## - attr(*, "nodeSet")= chr "Actors"
## - attr(*, "netdims")= int [1:3] 147 147 3
## - attr(*, "allowOnly")= logi TRUE
## - attr(*, "uponly")= logi [1:2] TRUE FALSE
## - attr(*, "downonly")= logi [1:2] FALSE FALSE
## - attr(*, "distance")= int [1:2] 527 277
## - attr(*, "vals")=List of 3
## ..$ : 'table' int [1:4(1d)] 15781 5389 292 147
## .. ..- attr(*, "dimnames")=List of 1
## .. .. ..$ mymat: chr [1:4] "0" "1" "10" NA
## ..$ : 'table' int [1:4(1d)] 15254 5916 292 147
## .. ..- attr(*, "dimnames")=List of 1
## .. .. ..$ mymat: chr [1:4] "0" "1" "10" NA
## ..$ : 'table' int [1:3(1d)] 15457 6005 147
## .. ..- attr(*, "dimnames")=List of 1
## .. .. ..$ mymat: chr [1:3] "0" "1" NA
## - attr(*, "nval")= int [1:3] 21462 21462 21462
## - attr(*, "noMissing")= num [1:3] 0 0 0
## - attr(*, "noMissingEither")= num [1:2] 0 0
## - attr(*, "nonMissingEither")= num [1:2] 21462 21462
## - attr(*, "balmean")= num 0.347
## - attr(*, "structmean")= num 0.321
## - attr(*, "simMean")= logi NA
## - attr(*, "symmetric")= logi FALSE
## - attr(*, "missing")= logi FALSE
## - attr(*, "structural")= logi TRUE
## - attr(*, "range2")= num [1:2] 0 1
## - attr(*, "ones")= Named int [1:3] 5389 5916 6005
## ..- attr(*, "names")= chr [1:3] "1" "1" "1"
## - attr(*, "density")= Named num [1:3] 0.251 0.276 0.28
## ..- attr(*, "names")= chr [1:3] "1" "1" "1"
## - attr(*, "degree")= Named num [1:3] 36.7 40.2 40.9
## ..- attr(*, "names")= chr [1:3] "1" "1" "1"
## - attr(*, "averageOutDegree")= num 39.3
## - attr(*, "averageInDegree")= num 39.3
## - attr(*, "maxObsOutDegree")= num [1:3] 137 137 137
## - attr(*, "missings")= num [1:3] 0 0 0
## - attr(*, "name")= chr "fnet"# It is just a 'sienaDependent' something [1:147,1:147,1:3]
fnet1 <- fnet[, , 1]
atmnet1 <- atmnet[, , 1]
atmnet2 <- atmnet[, , 2]
atmnet3 <- atmnet[, , 3]It is just a ‘sienaDependent’ something [1:147,1:147,1:3] but with a lot of attributes which we may ignore for now. It is an array. In this array our nominations are stored in adjacency matrices. I selected the friendship relations and the atmention relations of the first wave.
You may wonder why we only have 147 nodes (of MPs) in our data. Well that is because at the time of writing three MPs did not have a twitter account or at least we could not find it.
One final thing before we can go and play with the data. We have to replace the missing values of RSiena 10 (structural zeros) into 0 (or NA) as well.
4 First plots
The first step is to make a ‘graph object’.
library(igraph)
G1 <- igraph::graph_from_adjacency_matrix(atmnet1, mode = "directed", weighted = NULL, diag = TRUE, add.colnames = NA,
add.rownames = NA)Suppose you would like to add the data to this graph.
require(igraph)
# we need to retrieve the edges.
edges <- as_data_frame(G1, what = "edges")
# the first variable of the data we can attach needs to be some id, thus reorder columns of keyf
keyf <- cbind(keyf$EGOid, keyf[, names(keyf) != "EGOid"])
# the name has been changed as well. Lets correct this
names(keyf)[1] <- "EGOid"
# rebuild the graph.
G1 <- graph_from_data_frame(edges, directed = TRUE, vertices = keyf)
# I am a bit puzzled where the data is stored exactly but the same data as in keyf is now attached to
# the vertices.
# thus to find the names of our MPs we could now do this:
V(G1)$Naam## [1] "Agema, Fleur " "Amhaouch, Mustafa "
## [3] "Arib, Khadija " "v. Ark, Tamara "
## [5] "Azmani, Malik " "Beertema, Harm "
## [7] "Belhaj, Salima " "Bergkamp, Vera "
## [9] "Bisschop, Roelof " "Bosma, Martin "
## [11] "Bosman, Andre " "ten Broeke, Han "
## [13] "Bruins Slot, Hanke " "Van Dijk, Jasper "
## [15] "Dijkgraaf, Elbert " "Dijkstra, Pia "
## [17] "Dijkstra, Remco " "Dik-Faber, Carla "
## [19] "Duisenberg, Pieter " "Geurts, Jaco "
## [21] "De Graaf, Machiel " "Grashoff, Rik "
## [23] "Graus, Dion " "Van Haersma Buma, Sybrand "
## [25] "Harbers, Mark " "Heerma, Pieter "
## [27] "Helder, Lilian " "Van Helvert, Martijn "
## [29] "Keijzer, Mona " "Klaver, jesse "
## [31] "Knops, Raymond " "Kooiman, Nine "
## [33] "Koolmees, Wouter " "Krol, Henk "
## [35] "Kuiken, Attje " "Kuzu, Tunahan "
## [37] "Leijten, Renske " "Lodders, Helma "
## [39] "Madlener, Barry " "Van Meenen, Paul "
## [41] "Mulder, Agnes " "Nijboer, Henk "
## [43] "Nijkerken-de Haan, Chantal " "Van Nispen, Michiel "
## [45] "Omtzigt, Pieter " "Van Oosten, Foort "
## [47] "Ozturk, Selcuk " "Pechtold, Alexander "
## [49] "Van Raak, Ronald " "Roemer, Emile "
## [51] "Rog, Michel " "Ronnes, Erik "
## [53] "De Roon, Raymond " "Rutte, Arno "
## [55] "Schouten, Carola " "Segers, Gert-Jan "
## [57] "Sjoerdsma, Sjoerd " "Van der Staaij, Kees "
## [59] "Tellegen, Ockje " "Thieme, Marianne "
## [61] "Van Toorenburg, Madeleine " "Van Veldhoven, Stientje "
## [63] "Verhoeven, Kees " "Visser, Barbara "
## [65] "Voordewind, Joel " "Voortman, Linda "
## [67] "De Vries, Aukje " "Wassenberg, Frank "
## [69] "Van Weyenberg, Steven " "Wilders, Geert "
## [71] "Van t'Wout, Bas " "Ziengs, Erik "
## [73] "Zijlstra, Halbe " "Rutte, Mark "
## [75] "Ploumen, Lilianne " "Hennis-Plasschaert, Jeanine "
## [77] "Dijsselbloem, Jeroen " "Asscher, Lodewijk "
## [79] "Dijksma, Sharon " "Dekker, Sander "
## [81] "Dijkhoff, Klaas " "Thierry Baudet "
## [83] "Eppo Bruins " "LILIAN MARIJNISSEN "
## [85] "SADET KARABULUT " "SANDRA BECKERMAN "
## [87] "PETER KWINT " "BART VAN KENT "
## [89] "CEM LACIN " "FRANK FUTSELAAR "
## [91] "MAARTEN HIJINK " "Ingrid van Engelshoven "
## [93] "Jan Paternotte " "Rob Jetten "
## [95] "Jessica van Eijs " "Maarten Groothuizen "
## [97] "Rens Raemakers " "Achraf Bouali "
## [99] "Antje Diertens " "Tjeerd de Groot "
## [101] "René Peters " "Harry van der Molen "
## [103] "Anne Kuik " "Chris van Dam "
## [105] "Joba van den Berg-Jansen " "Maurits von Martels "
## [107] "Dennis Wiersma " "Bente Becker "
## [109] "Sophie Hermans " "Anne Mulder "
## [111] "Dilan Yesilgöz-Zegerius " "Daniel Koerhuis "
## [113] "Zohair el Yassini " "Martin Wörsdörfer "
## [115] "Arne Weverling " "Sven Koopmans "
## [117] "Jan Middendorp " "Léonie Sazias "
## [119] "Martin van Rooijen " "Corrie van Brenk "
## [121] "Esther Ouwehand " "Kathalijne Buitenweg "
## [123] "Tom van der Lee " "Corinne Ellemeet "
## [125] "Zihni Özdil " "Bart Snels "
## [127] "Suzanne Kröger " "Bram van Oijk "
## [129] "Nevin Özütok " "Lisa Westerveld "
## [131] "Isabelle Diks " "Liesbeth van Tongeren "
## [133] "Lammert van Raan " "Femke Merel Arissen "
## [135] "Farid Azarkan " "Gijs van Dijk "
## [137] "Kirsten van den Hul " "Gerbrands, Karen "
## [139] "Theo Hiddema " "Vicky Maeijer "
## [141] "Gidi Markuszower " "Danai van Weerdenburg "
## [143] "Edgar Mulder " "Léon de Jong "
## [145] "Gabriëlle Popken " "Alexander Kops "
## [147] "Roy van Aalst "But now let us start plotting.
I cant see anything!! |:-(
Would simplify help?
Still way too dense. What is the density of the network??
## [1] 0.04845774Actually, not very high at all.
5 From directed to undirected
But let us try to plot only the reciprocated ties.
# define undirected network
atmnet1_un <- atmnet1 == 1 & t(atmnet1) == 1
G2 <- graph_from_adjacency_matrix(atmnet1_un, mode = "undirected", weighted = NULL, diag = TRUE, add.colnames = NA,
add.rownames = NA)
# attach data if you want
edges <- as_data_frame(G2, what = "edges")
G2 <- graph_from_data_frame(edges, directed = FALSE, vertices = keyf)
plot(G2)
Mmm, It looks like MPs do like to mention themselves! Let simplify again.
6 Select nodes to plot
Suppose we want to remove the isolates.
# first make sure we don't end up with MPS who only mention themselves
diag(atmnet1_un) <- 0
# lets find the noisolates
noisolates <- rowSums(atmnet1_un, na.rm = T) > 0
# length(noisolates) sum(noisolates) if you select, select both correct nomination network as ego
# characteristics
atmnet1_un_sel <- atmnet1_un[noisolates, noisolates]
# if you are going to use the dataset keyf to add characteristics to the plot later, make sure to run
# the correct selection as well!!!
keyf_sel <- keyf[noisolates, ]
G2_sel <- graph_from_adjacency_matrix(atmnet1_un_sel, mode = "undirected", weighted = NULL, diag = TRUE,
add.colnames = NA, add.rownames = NA)
G2_sel <- simplify(G2_sel)
plot(G2_sel, mode = "undirected")
The same logic of course applies if you would like to select on node attributes (e.g. gender, party).
# option 1: see above. only select MPs from the liberal party
selection <- keyf$Partij == "VVD"
# build new adjacency matrix
atmnet1_un_sel2 <- atmnet1_un[selection, selection]
# etc.
# option 2. Suppose we have attached our dataset to our graph object. only select MPs from the
# liberal party
selection <- V(G2)$Partij == "VVD"
selection_id <- which(selection) # this gives us a numeric variable
G_sel <- induced_subgraph(G2, v = selection_id)
plot(G_sel)
7 Change Vertices
Okay, lets go back and change some stuff.
8 Changing edges
9 Add a legend
# adding legend because I am working in Rmarkdown I need some {}
{
plot.igraph(G2, margin = 0, mode = "udirected")
legend(x = -1, y = -1, c("Female", "Male"), pch = 21, col = "#777777", pt.bg = c("red", "green"),
pt.cex = 2, cex = 0.8, bty = "n", ncol = 1)
}
10 Coordinates
Lets puts the MPs where they belong.
# lets have a look first
plot(keyf$X, keyf$Y, xlim = c(-18, 18), ylim = c(-18, 18), col = keyf$Partij_col, pch = 16)
In case you wonder. The empty seats are the MPs without a Twitter account.
Lets assign these coordinates to our MPs
# it really depends on your plotting window (size, resolution etc.) to get consistent results you
# need to define this beforehand. won't do that now.
# combine atment nets. and make weighted graph. #replace missing values with 0 not with NA
# fnet1[fnet1==10] <- 0 atmnet1[atmnet1==10] <- 0 #combine the graphs Gtes <-
# igraph::graph_from_adjacency_matrix(atmnet1 + fnet1, mode = 'directed', weighted = TRUE, diag =
# TRUE, add.colnames = NA, add.rownames = NA) #save the weight of the edges edges_data <-
# as_data_frame(Gtes, what='edges') #set width of edge E(Gtes)$width <- edges_data$weight #and plot
# plot(Gtes)
# give nodes coler of their party
V(G2)$color <- keyf$Partij_col
# change node size a bit
V(G2)$size = degree(G2) * 1.05 + 6
# remove the labels
V(G2)$label = ""
# less curvature
E(G2)$curved = 0.1
owncoords <- cbind(keyf$X, keyf$Y)
owncoords <- owncoords/8
owncoords[, 1] <- (owncoords[, 1] - mean(owncoords[, 1]))
owncoords[, 2] <- (owncoords[, 2] - mean(owncoords[, 2]))
plot.igraph(G2, mode = "undirected", layout = owncoords, rescale = F, margin = c(0, 0, 0, 0), xlim = c(min(owncoords[,
1]), max(owncoords[, 1])), ylim = c(min(owncoords[, 2]), max(owncoords[, 2])))
11 Change edges
11.1 preperation
We can change the edges based on dyad charactersitics but if we have a weighted adjacency matrix also on the weights of the edges. To demonstrate this I first make a weighted atmention network. I simply sum wheter MPs have mentioned each other in t1, t2 and t3.
# construct adjacency matrix first define the recipricated atmentions in each wave
atmnet1_un <- atmnet1 == 1 & t(atmnet1) == 1
atmnet2_un <- atmnet2 == 1 & t(atmnet2) == 1
atmnet3_un <- atmnet3 == 1 & t(atmnet3) == 1
atmnet_weighted <- atmnet1_un + atmnet2_un + atmnet3_un
# contstruct graph / let us keep the loops
G_w <- igraph::graph_from_adjacency_matrix(atmnet_weighted, mode = "undirected", weighted = TRUE, diag = TRUE,
add.colnames = NA, add.rownames = NA)
# attach data
edges <- as_data_frame(G_w, what = "edges")
# rebuild the graph.
G_w <- graph_from_data_frame(edges, directed = FALSE, vertices = keyf)
# add changes as above
V(G_w)$color <- keyf$Partij_col
V(G_w)$size = degree(G_w) * 1.05 + 6
V(G_w)$label = ""
E(G2)$curved = 0.1
plot.igraph(G_w, mode = "undirected", layout = owncoords, rescale = F, margin = c(0, 0, 0, 0), xlim = c(min(owncoords[,
1]), max(owncoords[, 1])), ylim = c(min(owncoords[, 2]), max(owncoords[, 2])))
11.2 changing edge width based on weight.
# save the weight of the edges
edges_data <- as_data_frame(G_w, what = "edges")
# set width of edge edges_data$weight better yet just in one go
E(G_w)$width <- E(G_w)$weight
plot.igraph(G_w, mode = "undirected", layout = owncoords, rescale = F, margin = c(0, 0, 0, 0), xlim = c(min(owncoords[,
1]), max(owncoords[, 1])), ylim = c(min(owncoords[, 2]), max(owncoords[, 2])))
11.3 change edge width based on dyad charactersitics
# let us make them the color of the nodes if it is between nodes from same party. let us make them
# red if between parties
edges <- get.adjacency(G_w)
edges_mat <- matrix(as.numeric(edges), nrow = nrow(edges))
# edges_mat
# because we have undirected, we only need the edges once ...I know ...
edges_mat[lower.tri(edges_mat)] <- 0
# table(keyf$Geslacht)
teller <- 1
coloredges <- NA
for (i in 1:nrow(edges)) {
for (j in 1:ncol(edges)) {
if (edges_mat[i, j] == 1) {
if (keyf$Partij_col[i] == keyf$Partij_col[j]) {
coloredges[teller] <- keyf$Partij_col[i]
}
if (keyf$Partij_col[i] != keyf$Partij_col[j]) {
coloredges[teller] <- "black"
}
teller <- teller + 1
}
}
}
E(G_w)$color = coloredges
# prepare a legend
Party_names <- unique(keyf$Partij)
Party_cols <- unique(keyf$Partij_col)
png("MPplot.png", width = 900, height = 900)
{
plot.igraph(G_w, mode = "undirected", layout = owncoords, rescale = F, margin = c(0, 0, 0, 0), xlim = c(min(owncoords[,
1]), max(owncoords[, 1])), ylim = c(min(owncoords[, 2]), max(owncoords[, 2])), main = "Reciprocated @mention relations between Dutch MPs (2017)")
legend("topleft", legend = Party_names, pch = 21, col = "#777777", pt.bg = Party_cols, pt.cex = 2,
cex = 0.8, bty = "n", ncol = 3)
text(-2.2, -1.2, "Note 1: Node size based on degree", adj = 0, cex = 0.8)
text(-2.2, -1.3, "Note 2: Edge colar based on Party of MPs, black if MPs from different party", adj = 0,
cex = 0.8)
}
dev.off()## svg
## 2
I hope you like the plot!
12 Assignment
- Make a nice plot!
- show you are able to change edge / vertices attributes / use different attributes as in example
- show you are able to select part of network (e.g only one party)
- add a legend
- change background colors (hint look at ?par)
- add title to figure (hint: look at ?plot)
- save as pdf, png or html (hint: look at ?png)