Assessment 5: Part 1

Complete all Exercises, and submit answers to VtopBeta

Packages

## Load package
library(igraph)

## 
## Attaching package: 'igraph'

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

Construction of a directed graph and undirected graph with nodes

# undirected graph with three edges
g1 <- graph( edges=c(1,2, 2,3, 3, 1), n=3, directed=F ) 
plot(g1)

class(g1)

## [1] "igraph"

# Now with 10 vertices, and directed by default:
g2 <- graph( edges=c(1,2, 2,3, 3, 1), n=10 )
plot(g2)

g2

## IGRAPH 814a121 D--- 10 3 -- 
## + edges from 814a121:
## [1] 1->2 2->3 3->1

Name the nodes

# Nodes as names
g3 <- graph( c("John", "Jim", "Jim", "Jill", "Jill", "John")) # named vertices
plot(g3)

g3

## IGRAPH 9742ef9 DN-- 3 3 -- 
## + attr: name (v/c)
## + edges from 9742ef9 (vertex names):
## [1] John->Jim  Jim ->Jill Jill->John

Color the edges and nodes

# Printing the edges with color
g4 <- graph( c("John", "Jim", "Jim", "Jack", "Jim", "Jack", "John", "John"),
             isolates=c("Jesse", "Janis", "Jennifer", "Justin") ) 
plot(g4, edge.arrow.size=.5, vertex.color="gold", vertex.size=15, 
     vertex.frame.color="gray", vertex.label.color="black", 
     vertex.label.cex=0.8, vertex.label.dist=2, edge.curved=0.2) 

Print adjacency matrix of undirected graph

# Since g1 was the undirected graph
g1[]

## 3 x 3 sparse Matrix of class "dgCMatrix"
##           
## [1,] . 1 1
## [2,] 1 . 1
## [3,] 1 1 .

Add few extra nodes to the network and name them as well

E(g4) # The edges of the object

## + 4/4 edges from 267aed7 (vertex names):
## [1] John->Jim  Jim ->Jack Jim ->Jack John->John

V(g4) # The vertices of the object

## + 7/7 vertices, named, from 267aed7:
## [1] John     Jim      Jack     Jesse    Janis    Jennifer Justin

g4[] # Examining adjancency 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      .   .    .     .     .        .      .

g4[1,] # Examining first row

##     John      Jim     Jack    Jesse    Janis Jennifer   Justin 
##        1        1        0        0        0        0        0

# Adding an extra node
g4 <- g4 %>% 
        add_vertices(nv = 1, color = "red", name = "Tim") %>%
        add_edges(c("Tim", "John"))
plot(g4, edge.arrow.size=.5, vertex.size=15, 
     vertex.frame.color="gray", vertex.label.color="black", 
     vertex.label.cex=0.8, vertex.label.dist=2, edge.curved=0.2) 

# Add attributes to the network, vertices, or edges:
V(g4)$name # automatically generated when we created the network.

## [1] "John"     "Jim"      "Jack"     "Jesse"    "Janis"    "Jennifer"
## [7] "Justin"   "Tim"

V(g4)$gender <- c("male", "male", "male", "male", "female", "female", "male")

## Warning in vattrs[[name]][index] <- value: number of items to replace is
## not a multiple of replacement length

E(g4)$type <- "email" # Edge attribute, assign "email" to all edges
E(g4)$weight <- 10    # Edge weight, setting all existing edges to 10

# Examine attributes
edge_attr(g4) 

## $type
## [1] "email" "email" "email" "email" "email"
## 
## $weight
## [1] 10 10 10 10 10

vertex_attr(g4)

## $name
## [1] "John"     "Jim"      "Jack"     "Jesse"    "Janis"    "Jennifer"
## [7] "Justin"   "Tim"     
## 
## $color
## [1] NA    NA    NA    NA    NA    NA    NA    "red"
## 
## $gender
## [1] "male"   "male"   "male"   "male"   "female" "female" "male"   "male"

graph_attr(g4)

## named list()

# Plotting final graph
plot(g4, edge.arrow.size=.5, vertex.label.color="black", vertex.label.dist=1.5,
     vertex.color=c( "pink", "skyblue")[1+(V(g4)$gender=="male")] ) 

Print diameter of graph

net.bg <- sample_pa(80) 
V(net.bg)$size <- 8
V(net.bg)$frame.color <- "white"
V(net.bg)$color <- "orange"
V(net.bg)$label <- "" 
E(net.bg)$arrow.mode <- 0
plot(net.bg)

plot(net.bg, layout=layout_randomly)

#Diameter of graph
diameter(net.bg, directed=F, weights=NA)

## [1] 14

Find degree, in-degrees and out degrees of all

nodes

deg <- degree(net.bg, mode="all")
deg

##  [1]  5  2  6  9  2 11  3  1  2  1  6  1  3  2  2  2  1  5  2  5  1  2  2
## [24]  1  3  5  1  1  2  1  1  3  1  2  3  1  2  4  2  1  1  3  1  1  2  2
## [47]  1  1  1  2  1  1  3  1  1  2  1  1  1  1  1  1  1  1  1  1  1  1  1
## [70]  1  1  1  1  1  1  1  1  1  1  1

#In degree
in_deg <- degree(net.bg, mode="in")
in_deg

##  [1]  5  1  5  8  1 10  2  0  1  0  5  0  2  1  1  1  0  4  1  4  0  1  1
## [24]  0  2  4  0  0  1  0  0  2  0  1  2  0  1  3  1  0  0  2  0  0  1  1
## [47]  0  0  0  1  0  0  2  0  0  1  0  0  0  0  0  0  0  0  0  0  0  0  0
## [70]  0  0  0  0  0  0  0  0  0  0  0

#Out Degree
out_deg <- degree(net.bg, mode="out")
out_deg

##  [1] 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [36] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [71] 1 1 1 1 1 1 1 1 1 1

#Histogram of node degree
hist(deg, breaks=1:vcount(net.bg)-1, main="Histogram of node degree")

#Plotting graph based on degree
plot(net.bg, vertex.size=deg*3)

Find density of any nodes

edge_density(net.bg, loops=F)

## [1] 0.0125

ecount(net.bg)/(vcount(net.bg)*(vcount(net.bg)-1)) #for a directed network

## [1] 0.0125

Find closeness centrality of all nodes

#Degree (number of ties)
degree(net.bg, mode="in")

##  [1]  5  1  5  8  1 10  2  0  1  0  5  0  2  1  1  1  0  4  1  4  0  1  1
## [24]  0  2  4  0  0  1  0  0  2  0  1  2  0  1  3  1  0  0  2  0  0  1  1
## [47]  0  0  0  1  0  0  2  0  0  1  0  0  0  0  0  0  0  0  0  0  0  0  0
## [70]  0  0  0  0  0  0  0  0  0  0  0

centr_degree(net.bg, mode="in", normalized=T)

## $res
##  [1]  5  1  5  8  1 10  2  0  1  0  5  0  2  1  1  1  0  4  1  4  0  1  1
## [24]  0  2  4  0  0  1  0  0  2  0  1  2  0  1  3  1  0  0  2  0  0  1  1
## [47]  0  0  0  1  0  0  2  0  0  1  0  0  0  0  0  0  0  0  0  0  0  0  0
## [70]  0  0  0  0  0  0  0  0  0  0  0
## 
## $centralization
## [1] 0.1140823
## 
## $theoretical_max
## [1] 6320

#Closeness (centrality based on distance to others in the graph)
closeness(net.bg, mode="all", weights=NA) 

##  [1] 0.003215434 0.003367003 0.002967359 0.002610966 0.002583979
##  [6] 0.003508772 0.002801120 0.002754821 0.002770083 0.002754821
## [11] 0.003134796 0.002570694 0.002785515 0.002531646 0.002652520
## [16] 0.002583979 0.002409639 0.002597403 0.002178649 0.002849003
## [21] 0.002518892 0.002770083 0.002237136 0.002169197 0.001949318
## [26] 0.002288330 0.001862197 0.002518892 0.001949318 0.002150538
## [31] 0.002114165 0.001964637 0.002409639 0.001709402 0.002433090
## [36] 0.002277904 0.002444988 0.001709402 0.002309469 0.002159827
## [41] 0.002754821 0.002070393 0.001508296 0.001692047 0.001949318
## [46] 0.001697793 0.001782531 0.002169197 0.002169197 0.002341920
## [51] 0.002044990 0.001508296 0.002178649 0.002044990 0.001508296
## [56] 0.002341920 0.001703578 0.001862197 0.002754821 0.001692047
## [61] 0.001499250 0.002150538 0.002159827 0.001782531 0.002159827
## [66] 0.002169197 0.001862197 0.002298851 0.001980198 0.002169197
## [71] 0.002331002 0.001956947 0.002288330 0.001508296 0.002169197
## [76] 0.002277904 0.002288330 0.001941748 0.001980198 0.002331002

centr_clo(net.bg, mode="all", normalized=T) 

## $res
##  [1] 0.2540193 0.2659933 0.2344214 0.2062663 0.2041344 0.2771930 0.2212885
##  [8] 0.2176309 0.2188366 0.2176309 0.2476489 0.2030848 0.2200557 0.2000000
## [15] 0.2095491 0.2041344 0.1903614 0.2051948 0.1721133 0.2250712 0.1989924
## [22] 0.2188366 0.1767338 0.1713666 0.1539961 0.1807780 0.1471136 0.1989924
## [29] 0.1539961 0.1698925 0.1670190 0.1552063 0.1903614 0.1350427 0.1922141
## [36] 0.1799544 0.1931540 0.1350427 0.1824480 0.1706263 0.2176309 0.1635611
## [43] 0.1191554 0.1336717 0.1539961 0.1341256 0.1408200 0.1713666 0.1713666
## [50] 0.1850117 0.1615542 0.1191554 0.1721133 0.1615542 0.1191554 0.1850117
## [57] 0.1345826 0.1471136 0.2176309 0.1336717 0.1184408 0.1698925 0.1706263
## [64] 0.1408200 0.1706263 0.1713666 0.1471136 0.1816092 0.1564356 0.1713666
## [71] 0.1841492 0.1545988 0.1807780 0.1191554 0.1713666 0.1799544 0.1807780
## [78] 0.1533981 0.1564356 0.1841492
## 
## $centralization
## [1] 0.2013772
## 
## $theoretical_max
## [1] 39.24841

#Eigenvector (centrality proportional to the sum of connection centralities)
eigen_centrality(net.bg, directed=T, weights=NA)

## Warning in eigen_centrality(net.bg, directed = T, weights = NA): At
## centrality.c:344 :graph is directed and acyclic; eigenvector centralities
## will be zeros

## $vector
##  [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [36] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [71] 0 0 0 0 0 0 0 0 0 0
## 
## $value
## [1] 0
## 
## $options
## $options$bmat
## [1] "I"
## 
## $options$n
## [1] 0
## 
## $options$which
## [1] "XX"
## 
## $options$nev
## [1] 1
## 
## $options$tol
## [1] 0
## 
## $options$ncv
## [1] 3
## 
## $options$ldv
## [1] 0
## 
## $options$ishift
## [1] 1
## 
## $options$maxiter
## [1] 1000
## 
## $options$nb
## [1] 1
## 
## $options$mode
## [1] 1
## 
## $options$start
## [1] 0
## 
## $options$sigma
## [1] 0
## 
## $options$sigmai
## [1] 0
## 
## $options$info
## [1] 0
## 
## $options$iter
## [1] 1000
## 
## $options$nconv
## [1] 0
## 
## $options$numop
## [1] 0
## 
## $options$numopb
## [1] 0
## 
## $options$numreo
## [1] 0

centr_eigen(net.bg, directed=T, normalized=T)

## Warning in centr_eigen(net.bg, directed = T, normalized = T): At
## centrality.c:344 :graph is directed and acyclic; eigenvector centralities
## will be zeros

## $vector
##  [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [36] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [71] 0 0 0 0 0 0 0 0 0 0
## 
## $value
## [1] 0
## 
## $options
## $options$bmat
## [1] "I"
## 
## $options$n
## [1] 0
## 
## $options$which
## [1] "XX"
## 
## $options$nev
## [1] 1
## 
## $options$tol
## [1] 0
## 
## $options$ncv
## [1] 3
## 
## $options$ldv
## [1] 0
## 
## $options$ishift
## [1] 1
## 
## $options$maxiter
## [1] 1000
## 
## $options$nb
## [1] 1
## 
## $options$mode
## [1] 1
## 
## $options$start
## [1] 0
## 
## $options$sigma
## [1] 0
## 
## $options$sigmai
## [1] 0
## 
## $options$info
## [1] 0
## 
## $options$iter
## [1] 1000
## 
## $options$nconv
## [1] 0
## 
## $options$numop
## [1] 0
## 
## $options$numopb
## [1] 0
## 
## $options$numreo
## [1] 0
## 
## 
## $centralization
## [1] 0
## 
## $theoretical_max
## [1] 79

#Betweeness
betweenness(net.bg, directed=T, weights=NA)

##  [1]  0 46 26 32  1 90  9  0  3  0 66  0  6  4 40  1  0 24  3 18  0  3 21
## [24]  0 24 45  0  0  6  0  0 18  0  7  4  0  6 15  4  0  0  6  0  0  6  5
## [47]  0  0  0  4  0  0 10  0  0  4  0  0  0  0  0  0  0  0  0  0  0  0  0
## [70]  0  0  0  0  0  0  0  0  0  0  0

edge_betweenness(net.bg, directed=T, weights=NA)

##  [1] 47 27 34  2 92 12  3  6  3 69  1  9  8 44  2  2 28  6 21  4  6 24  3
## [24] 28 50  4  4 12  2  5 24  2 14  6  4  8 20  8  5  3  9  6  7 12 10  4
## [47]  3  3  8  3  8 15  3  6  8  7  6  3  7  6  2  5  4  5  3  6  4  5  3
## [70]  4  5  4  6  3  4  4  6  5  4

centr_betw(net.bg, directed=T, normalized=T)

## $res
##  [1]  0 46 26 32  1 90  9  0  3  0 66  0  6  4 40  1  0 24  3 18  0  3 21
## [24]  0 24 45  0  0  6  0  0 18  0  7  4  0  6 15  4  0  0  6  0  0  6  5
## [47]  0  0  0  4  0  0 10  0  0  4  0  0  0  0  0  0  0  0  0  0  0  0  0
## [70]  0  0  0  0  0  0  0  0  0  0  0
## 
## $centralization
## [1] 0.01364632
## 
## $theoretical_max
## [1] 486798

Hubs and Authorities

hs <- hub_score(net.bg, weights=NA)$vector
as <- authority_score(net.bg, weights=NA)$vector

par(mfrow=c(1,2))
 plot(net.bg, vertex.size=hs*50, main="Hubs")
 plot(net.bg, vertex.size=as*30, main="Authorities")

Social circles: Facebook

Source

## Read in edges information
igraphDat <- read.graph(file = "./facebook/0.edges", directed = FALSE)
## Simplify to remove duplications and from-self-to-self loops
igraphDat <- simplify(igraphDat, remove.multiple = TRUE, remove.loops = TRUE)
## Give numbers
V(igraphDat)$label <- seq_along(V(igraphDat))

## Community structure detection based on edge betweenness
communityEdgeBetwn <- edge.betweenness.community(igraphDat)
## Average path length between any two given nodes
(averagePathLength <- average.path.length(igraphDat))

## [1] 3.752446

## Check the transitivity of a graph (probability that the adjacent vertices of a vertex are connected)
(transitivityDat <- transitivity(igraphDat, type = "localaverage",isolates = "zero"))

## [1] 0.4863374

## Set the seed to get the same result
set.seed("20140513")
## Add community indicating background colors
plot(igraphDat,
     vertex.color = communityEdgeBetwn$membership, vertex.size = log(degree(igraphDat) + 1),
     mark.groups = by(seq_along(communityEdgeBetwn$membership), communityEdgeBetwn$membership, invisible))
## Annotate
title("Stanford Facebook data", 
      sub = "http://snap.stanford.edu/data/egonets-Facebook.html")
text(x = -1, y = -1, 
     labels = sprintf("Average path length: %.2f\nTransitivity:%.2f",
                      averagePathLength, transitivityDat))

deg2 <- degree(igraphDat, mode="all")
hist(deg2, breaks=1:vcount(net.bg)-1, main="Histogram of node degree")