install.packages('igraph')
library(igraph)
# Working with Network Data ---------------------------------------------------
# Create networks
g1 <- make_graph(edges=c(1,2, 2,3, 3,1), n=3)
plot(g1)
g2 <- make_graph(edges=c(1,2, 2,3, 3,1), n=10, directed = FALSE)
plot(g2)
g3 <- make_graph(edges=c("John","Jim", "Jim","Jack", "Jim","Jack", "John","John"),
isolates=c("Jesse", "Janis", "Jennifer", "Justin"))
plot(g3)
# Edge, vertex and network attributes
E(g3) # view edges
## + 4/4 edges from 1973f01 (vertex names):
## [1] John->Jim Jim ->Jack Jim ->Jack John->John
V(g3)
## + 7/7 vertices, named, from 1973f01:
## [1] John Jim Jack Jesse Janis Jennifer Justin
g3[] # view the network (in matrix)
## 7 x 7 sparse Matrix of class "dgCMatrix"
## John Jim Jack Jesse Janis Jennifer Justin
## John 1 1 . . . . .
## Jim . . 2 . . . .
## Jack . . . . . . .
## Jesse . . . . . . .
## Janis . . . . . . .
## Jennifer . . . . . . .
## Justin . . . . . . .
V(g3)$name # retrieve existing vertex attribute
## [1] "John" "Jim" "Jack" "Jesse" "Janis" "Jennifer"
## [7] "Justin"
V(g3)$gender <- c("male","male","male","male","female","female","male") # add v. attri.
E(g3)$type <- "email" # add edge attribute
E(g3)$weight <- c(2,5,1,10) # change edge weight
vertex_attr(g3) # list vertex attributes
## $name
## [1] "John" "Jim" "Jack" "Jesse" "Janis" "Jennifer"
## [7] "Justin"
##
## $gender
## [1] "male" "male" "male" "male" "female" "female" "male"
edge_attr(g3)
## $type
## [1] "email" "email" "email" "email"
##
## $weight
## [1] 2 5 1 10
# Network datasets
# data in edgelist
nodes <- read.csv('Dataset1-NODES.csv', header=T, as.is=T)
links <- read.csv('Dataset1-EDGES.csv', header=T, as.is=T)
head(nodes)
## id media media.type type.label audience.size
## 1 s01 NY Times 1 Newspaper 20
## 2 s02 Washington Post 1 Newspaper 25
## 3 s03 Wall Street Journal 1 Newspaper 30
## 4 s04 USA Today 1 Newspaper 32
## 5 s05 LA Times 1 Newspaper 20
## 6 s06 New York Post 1 Newspaper 50
head(links)
## from to weight type
## 1 s01 s02 10 hyperlink
## 2 s01 s02 12 hyperlink
## 3 s01 s03 22 hyperlink
## 4 s01 s04 21 hyperlink
## 5 s04 s11 22 mention
## 6 s05 s15 21 mention
nrow(nodes); length(unique(nodes$id))
## [1] 17
## [1] 17
nrow(links); nrow(unique(links[,c("from", "to")])) # a few duplicated pairs
## [1] 52
## [1] 49
# combine same pairs by suming up their weights
links <- aggregate(links[,3], links[,-3], sum) # sum weights by from, to, type
links <- links[order(links$from, links$to),]
head(links,3)
## from to type x
## 4 s01 s02 hyperlink 22
## 6 s01 s03 hyperlink 22
## 11 s01 s04 hyperlink 21
colnames(links)[4] <- "weight"
rownames(links) <- NULL
# convert to igraph object
net <- graph_from_data_frame(d=links, vertices=nodes, directed=T)
class(net)
## [1] "igraph"
net
## IGRAPH 1a86092 DNW- 17 49 --
## + attr: name (v/c), media (v/c), media.type (v/n), type.label
## | (v/c), audience.size (v/n), type (e/c), weight (e/n)
## + edges from 1a86092 (vertex names):
## [1] s01->s02 s01->s03 s01->s04 s01->s15 s02->s01 s02->s03 s02->s09
## [8] s02->s10 s03->s01 s03->s04 s03->s05 s03->s08 s03->s10 s03->s11
## [15] s03->s12 s04->s03 s04->s06 s04->s11 s04->s12 s04->s17 s05->s01
## [22] s05->s02 s05->s09 s05->s15 s06->s06 s06->s16 s06->s17 s07->s03
## [29] s07->s08 s07->s10 s07->s14 s08->s03 s08->s07 s08->s09 s09->s10
## [36] s10->s03 s12->s06 s12->s13 s12->s14 s13->s12 s13->s17 s14->s11
## [43] s14->s13 s15->s01 s15->s04 s15->s06 s16->s06 s16->s17 s17->s04
plot(net)
net <- simplify(net, remove.loops = T)
# data in matirx
links.m <- read.csv('Dataset1-EDGES-mat.csv', header=T, row.names=1)
head(links.m)
## s01 s02 s03 s04 s05 s06 s07 s08 s09 s10 s12 s13 s14 s15 s16 s17 s11
## s01 0 22 22 21 0 0 0 0 0 0 0 0 0 20 0 0 0
## s02 23 0 21 0 0 0 0 0 1 5 0 0 0 0 0 0 0
## s03 21 0 0 22 1 0 0 4 0 2 1 0 0 0 0 0 1
## s04 0 0 23 0 0 1 0 0 0 0 3 0 0 0 0 2 22
## s05 1 21 0 0 0 0 0 0 2 0 0 0 0 21 0 0 0
## s06 0 0 0 0 0 1 0 0 0 0 0 0 0 0 21 21 0
class(links.m)
## [1] "data.frame"
links.m <- as.matrix(links.m)
class(links.m)
## [1] "matrix"
net.m <- graph_from_adjacency_matrix(links.m)
class(net.m)
## [1] "igraph"
# Measure Networks ------------------------------------------------------------
# --- Vertex level: describe nodes --- #
# Centrality
degree(net, mode='in')
## s01 s02 s03 s04 s05 s06 s07 s08 s09 s10 s11 s12 s13 s14 s15 s16 s17
## 4 2 6 4 1 4 1 2 3 4 3 3 2 2 2 1 4
closeness(net, mode='all', weights=NA)
## s01 s02 s03 s04 s05 s06
## 0.03333333 0.03030303 0.04166667 0.03846154 0.03225806 0.03125000
## s07 s08 s09 s10 s11 s12
## 0.03030303 0.02857143 0.02564103 0.02941176 0.03225806 0.03571429
## s13 s14 s15 s16 s17
## 0.02702703 0.02941176 0.03030303 0.02222222 0.02857143
betweenness(net, directed=T, weights=NA)
## s01 s02 s03 s04 s05 s06
## 24.0000000 5.8333333 127.0000000 93.5000000 16.5000000 20.3333333
## s07 s08 s09 s10 s11 s12
## 1.8333333 19.5000000 0.8333333 15.0000000 0.0000000 33.5000000
## s13 s14 s15 s16 s17
## 20.0000000 4.0000000 5.6666667 0.0000000 58.5000000
# --- Graph level: describe network as a whole --- #
# number of nodes and edges
vcount(net)
## [1] 17
ecount(net)
## [1] 48
# average degree
mean(degree(net))
## [1] 5.647059
# degree distribution
net.degrees <- degree(net)
nd.hist <- as.data.frame(table(net.degrees)) # count the freq of each degree
nd.hist[,1] <- as.numeric(nd.hist[,1]) # convert the first column to numbers
plot(nd.hist)
# Density
graph.density(net)
## [1] 0.1764706
# Reciprocity
reciprocity(net)
## [1] 0.4166667
# --- Community Detection --- #
wc <- walktrap.community(net)
dendPlot(wc, mode="hclust")
plot(wc, net)
class(wc)
## [1] "communities"
length(wc)
## [1] 4
membership(wc)
## s01 s02 s03 s04 s05 s06 s07 s08 s09 s10 s11 s12 s13 s14 s15 s16 s17
## 1 1 1 1 1 3 2 2 2 2 1 4 4 4 1 3 3
modularity(wc)
## [1] 0.5972482
# Visualization ---------------------------------------------------------------
plot(net)
# set node & edge options
plot(net, edge.arrow.size=.2, edge.curved=0,
vertex.color='orange', vertex.frame.color='#555555',
vertex.label=V(net)$media, vertex.label.color='black',
vertex.label.cex=.7)
?igraph.plotting # plotting parameters
# set attributes for plotting
# set node colors, size, and labels
colrs <- c('gray50', 'tomato', 'gold')
V(net)$color <- colrs[V(net)$media.type]
V(net)$size <- V(net)$audience.size*0.7
V(net)$label.color <- 'black'
# set edge width, color and arrow size
E(net)$width <- E(net)$weight/6
E(net)$edge.color <- 'gray80'
E(net)$arrow.size <- .2
plot(net)
# adjust some of the settings
V(net)$label <- NA
E(net)$width <- 1+E(net)$weight/12
plot(net)
# the attribute settings can be override
plot(net, edge.color='orange', vertex.color='gray50')
# legend
plot(net)
legend(x=-1.5, y=-1.1, c("Newspaper","Television", "Online News"), pch=21,
col='#777777', pt.bg=colrs, pt.cex=2, cex=.8, bty='n', ncol=1)
# plot with labels only
plot(net, vertex.shape='none', vertex.label=V(net)$media,
vertex.label.font=2, vertex.label.color='gray40',
vertex.label.cex=.7, edge.color='gray85')
# color the edges based on source node color
edge.start <- ends(net, es=E(net), names=F)[,1]
edge.col <- V(net)$color[edge.start]
plot(net, edge.color=edge.col, edge.curved=.1)
# Network layout
plot(net, layout=layout.random)
layouts <- grep("^layout\\.", ls("package:igraph"), value=TRUE)
layouts <- layouts[c(3,6,8,17)] # pick some layouts to plot
par(mfrow=c(2,2))
for (layout in layouts) {
print(layout)
l <- do.call(layout, list(net))
plot(net, edge.arrow.mode=0, layout=l, main=layout) }
## [1] "layout.circle"
## [1] "layout.fruchterman.reingold"
## [1] "layout.gem"
## [1] "layout.random"
dev.off()
## null device
## 1
# create heat map to represent networks
netm <- get.adjacency(net, attr='weight', sparse=F)
colnames(netm) <- V(net)$media
rownames(netm) <- V(net)$media
palf <- colorRampPalette(c('gold', 'dark orange'))
heatmap(netm[,17:1], Rowv = NA, Colv = NA, col = palf(100),
scale="none", margins=c(10,10))