library(igraph)
library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
##
## The following objects are masked from 'package:stats':
##
## filter, lag
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
theme_set(theme_bw())
########################################
# toy networks
########################################
### star network
# look at edge list and adjacency matrix
star <- graph.star(5, mode="undirected", center=1)
plot(star)
get.edgelist(star)
## [,1] [,2]
## [1,] 1 2
## [2,] 1 3
## [3,] 1 4
## [4,] 1 5
get.adjacency(star)
## 5 x 5 sparse Matrix of class "dgCMatrix"
##
## [1,] . 1 1 1 1
## [2,] 1 . . . .
## [3,] 1 . . . .
## [4,] 1 . . . .
## [5,] 1 . . . .
### lattice network
# look at edge list and adjacency matrix
grid <- graph.lattice(length=3, dim=2)
plot(grid)
get.edgelist(grid)
## [,1] [,2]
## [1,] 1 2
## [2,] 1 4
## [3,] 2 3
## [4,] 2 5
## [5,] 3 6
## [6,] 4 5
## [7,] 4 7
## [8,] 5 6
## [9,] 5 8
## [10,] 6 9
## [11,] 7 8
## [12,] 8 9
get.adjacency(grid)
## 9 x 9 sparse Matrix of class "dgCMatrix"
##
## [1,] . 1 . 1 . . . . .
## [2,] 1 . 1 . 1 . . . .
## [3,] . 1 . . . 1 . . .
## [4,] 1 . . . 1 . 1 . .
## [5,] . 1 . 1 . 1 . 1 .
## [6,] . . 1 . 1 . . . 1
## [7,] . . . 1 . . . 1 .
## [8,] . . . . 1 . 1 . 1
## [9,] . . . . . 1 . 1 .
### ring network
# look at edge list and adjacency matrix
grid <- graph.ring(10)
plot(grid)
get.edgelist(grid)
## [,1] [,2]
## [1,] 1 2
## [2,] 2 3
## [3,] 3 4
## [4,] 4 5
## [5,] 5 6
## [6,] 6 7
## [7,] 7 8
## [8,] 8 9
## [9,] 9 10
## [10,] 1 10
get.adjacency(grid)
## 10 x 10 sparse Matrix of class "dgCMatrix"
##
## [1,] . 1 . . . . . . . 1
## [2,] 1 . 1 . . . . . . .
## [3,] . 1 . 1 . . . . . .
## [4,] . . 1 . 1 . . . . .
## [5,] . . . 1 . 1 . . . .
## [6,] . . . . 1 . 1 . . .
## [7,] . . . . . 1 . 1 . .
## [8,] . . . . . . 1 . 1 .
## [9,] . . . . . . . 1 . 1
## [10,] 1 . . . . . . . 1 .
# look at all-pairs shortest path distances
shortest.paths(grid)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 0 1 2 3 4 5 4 3 2 1
## [2,] 1 0 1 2 3 4 5 4 3 2
## [3,] 2 1 0 1 2 3 4 5 4 3
## [4,] 3 2 1 0 1 2 3 4 5 4
## [5,] 4 3 2 1 0 1 2 3 4 5
## [6,] 5 4 3 2 1 0 1 2 3 4
## [7,] 4 5 4 3 2 1 0 1 2 3
## [8,] 3 4 5 4 3 2 1 0 1 2
## [9,] 2 3 4 5 4 3 2 1 0 1
## [10,] 1 2 3 4 5 4 3 2 1 0
# plot a few watts-strogatz small world networks
# mostly a ring
plot(watts.strogatz.game(1, 100, 5, 0.01), layout=layout.circle, vertex.size=1, vertex.label=NA)
# some rewiring
plot(watts.strogatz.game(1, 100, 5, 0.05), layout=layout.circle, vertex.size=1, vertex.label=NA)
# lots of rewiring
plot(watts.strogatz.game(1, 100, 5, 0.10), layout=layout.circle, vertex.size=1, vertex.label=NA)
########################################
# real networks
########################################
### washington dc road network
# read in edge list
dc_edges <- read.table('dc_road_network.tsv', sep="\t", header=F, col.names=c('src','dst'))
# convert to igraph object
dc_graph <- graph.data.frame(dc_edges, directed=F)
# plot hairball
plot(dc_graph, vertex.size=1, vertex.label=NA)
# compute degree distribution
dc_degree_dist <- dc_edges %>%
group_by(src) %>%
summarize(degree=n()) %>%
group_by(degree) %>%
summarize(num_nodes=n())
qplot(x=degree, y=num_nodes, data=dc_degree_dist, geom="line", xlab="Degree", ylab="Number of nodes")
# plot distribution of path lengths
path_lengths <- path.length.hist(dc_graph)$res
qplot(x=1:length(path_lengths), y=path_lengths, xlab="Length of shortest path", ylab="Number of routes")
# compute mean path length
sum(1:length(path_lengths)*path_lengths)/sum(path_lengths)
## [1] 57.03
### wikipedia voting network
# read in edge list
wiki_edges <- read.table('wiki-Vote.txt', sep="\t", header=F, col.names=c('src','dst'))
wiki_graph <- graph.data.frame(wiki_edges, directed=T)
# compute degree distribution
wiki_degree_dist <- wiki_edges %>%
group_by(src) %>%
summarize(degree=n()) %>%
group_by(degree) %>%
summarize(num_nodes=n())
qplot(x=degree, y=num_nodes, data=wiki_degree_dist, geom="point", xlab="Degree", ylab="Number of nodes")
qplot(x=degree, y=num_nodes, data=wiki_degree_dist, geom="point", xlab="Degree", ylab="Number of nodes") +
scale_y_log10() +
scale_x_log10()
# plot distribution of path lengths
path_lengths <- path.length.hist(wiki_graph)$res
qplot(x=1:length(path_lengths), y=path_lengths, xlab="Length of shortest path", ylab="Number of paths")
# compute mean path length
sum(1:length(path_lengths)*path_lengths)/sum(path_lengths)
## [1] 3.341