Libraries

library(igraph)
library(ggplot2)
library(ggjoy)
library(reshape2)

Introduction

One of the easiest but important network property is the mean of distances. The density of distances can easily calculate and plot with R. In this blog post I compare distance densities of three main type of networks: random, small-world, scale-free.

Generate networks

Erdős-Rényi G(N,L) random network

g.random <- erdos.renyi.game(100, 300, type = "gnm")
plot(g.random, vertex.label= NA, edge.arrow.size=0.02,vertex.size = 5, xlab = "Random Network: G(N,L) model")

Watts-Strogatz small-world network

g.smallworld <- watts.strogatz.game(1, 100, 3, 0.05, loops = FALSE, multiple = FALSE)
#g.smallworld <- simplify(g.smallworld) :function can create multiple edges
#ecount(g.smallworld)
plot(g.smallworld, vertex.label= NA, edge.arrow.size=0.02,vertex.size = 5, xlab = "Small world model")

Barabási scale-free network

g.scalefree <- static.power.law.game(100, 300, exponent.out= 2.9, exponent.in = -1, 
                           loops = FALSE, multiple = FALSE, finite.size.correction = TRUE)

plot(g.scalefree, vertex.label= NA, edge.arrow.size=0.02,vertex.size = 5, xlab = "Scale-free network model (static)")

Calculate mean distances

Erdős-Rényi G(N,L) random network

g <- g.random

x <- distances(g)
x[which(x==Inf)] <- 0
y <- data.frame(min(x):max(x), sapply(min(x):max(x), function(k) length(which(x==k)))/sum(x))
colnames(y) <- c("d", "p_d")
res <- nls( p_d ~ k*exp(-1/2*(d-mu)^2/sigma^2), start=c(mu=2.5,sigma=1.5,k=1) , data = y)
v <- summary(res)$parameters[,"Estimate"]
fun <- function(d) v[3]*exp(-1/2*(d-v[1])^2/v[2]^2)

ggplot(y, aes(x=d, y=p_d)) + geom_point() + 
  stat_function(fun = fun, color = "red") +
  theme_bw() + labs(title="Distance distribution of Erdős-Rényi random network")

The fitted equation: function(d) \(k*exp(-1/2*(d-mu)^2/sigma^2)\)

Parameters of the fitted equation:

k = 0.1941091

mu = 2.8063912

sigma = 0.7330193

Watts-Strogatz small-world network

g <- g.smallworld

x <- distances(g)
x[which(x==Inf)] <- 0
y <- data.frame(min(x):max(x), sapply(min(x):max(x), function(k) length(which(x==k)))/sum(x))
colnames(y) <- c("d", "p_d")
res <- nls( p_d ~ k*exp(-1/2*(d-mu)^2/sigma^2), start=c(mu=2.5,sigma=1.5,k=1) , data = y)
v <- summary(res)$parameters[,"Estimate"]
fun <- function(d) v[3]*exp(-1/2*(d-v[1])^2/v[2]^2)

ggplot(y, aes(x=d, y=p_d)) + geom_point() + 
  stat_function(fun = fun, color = "red") +
  theme_bw() + labs(title="Distance distribution of Watts-Strogatz small-world network")

The fitted equation: function(d) \(k*exp(-1/2*(d-mu)^2/sigma^2)\)

Parameters of the fitted equation:

k = 0.1112433

mu = 3.5604521

sigma = 1.037419

Barabási scale-free network

g <- g.scalefree

x <- distances(g)
x[which(x==Inf)] <- 0
y <- data.frame(min(x):max(x), sapply(min(x):max(x), function(k) length(which(x==k)))/sum(x))
colnames(y) <- c("d", "p_d")
res <- nls( p_d ~ k*exp(-1/2*(d-mu)^2/sigma^2), start=c(mu=2.5,sigma=1.5,k=1) , data = y)
v <- summary(res)$parameters[,"Estimate"]
fun <- function(d) v[3]*exp(-1/2*(d-v[1])^2/v[2]^2)

ggplot(y, aes(x=d, y=p_d)) + geom_point() + 
  stat_function(fun = fun, color = "red") +
  theme_bw() + labs(title="Distance distribution of Barabási scale-free network")

The fitted equation: function(d) \(k*exp(-1/2*(d-mu)^2/sigma^2)\)

Parameters of the fitted equation:

k = 0.1840031

mu = 2.7992294

sigma = 0.7754645

Joyplot of distance frequences of networks as summary

Generated networks have the same number of nodes. That gives an opportunity to put them in the same data frame and plot it.

dat <- data.frame(random=as.vector(distances(g.random)),
                  smallworld=as.vector(distances(g.smallworld)),
                  scalefree=as.vector(distances(g.scalefree)))
dat <- melt(dat)
dat <- dat[dat$value!=Inf,]
ggplot(dat, aes(x=value, y=variable, fill=variable)) + geom_joy(scale=1) + 
  theme_bw() +
  scale_x_continuous(breaks=0:7, minor_breaks = NULL) +
  scale_fill_manual(values = c("#00cc00", "#00ccff", "#ff9900"), guide=F) +
  labs(x="Distance frequency", y="")

See also:

Barabasi: Network science (online book)

Google search for “ggjoy”, “joy plot”


Be happyR! :)