Temporal network model – Barabási-Albert model with the library igraph

February 17, 2013
By

(This article was first published on ProbaPerception, and kindly contributed to R-bloggers)

I found a golden website. The blog of Esteban Moro. He uses R to work on networks. In particular he has done a really nice code to make some great videos of networks. This post is purely a copy of his code. I just changed a few arguments to change colors and to do my own network.

To create the network, I used the  Barabási-Albert algorithm that you can find at the end of the post on the different algorithms for networks. Igraph is the library which has been used.

In order to make a video from the .png I used a software called Ffmpeg. It took me a bit of time to use it but you can find some tutorials on Internet.

Here is the kind of result you can expect :

The code (R) : 


n <- 300
data <- matrix(0, ncol = 3, nrow = n-1)
data[1,2] <- 1
data[1:(n-1),1] <- 2:n
data[, 3] <- 1:(n-1)
weight <- NULL
weight[1] <- 1
weight[2] <- 1
for(i1 in 2:(n-1)){
  link = sample(c(1:(i1)), size = 1, prob = weight)
  data[i1, 2] <- link
  weight[i1+1] <- 1
  weight[link] <- weight[link] + 1
}

install.packages("igraph")
library(igraph)

#generate the full graph
g <- graph.edgelist(as.matrix(data[,c(1,2)]),directed=F)
E(g)$time <- data[,3]

#generate a cool palette for the graph
YlOrBr <- c(hsv(0.925, 0.20, 0.7), hsv(0.925, 0.40, 0.7), hsv(0.925, 0.60, 0.7), hsv(0.925, 0.80, 0.7), hsv(0.925,1, 0.7))
YlOrBr.Lab <- colorRampPalette(YlOrBr, space = "Lab")
#colors for the nodes are chosen from the very beginning
vcolor <- rev(YlOrBr.Lab(vcount(g)))

#time in the edges goes from 1 to 300. We kick off at time 3
ti <- 3
#weights of edges formed up to time ti is 1. Future edges are weighted 0
E(g)$weight <- ifelse(E(g)$time < ti,1,0)
#generate first layout using weights.
layout.old <- layout.fruchterman.reingold(g,params=list(weights=E(g)$weight))


#total time of the dynamics
total_time <- max(E(g)$time)
#This is the time interval for the animation. In this case is taken to be 1/10
#of the time (i.e. 10 snapshots) between adding two consecutive nodes
dt <- 0.1
#Output for each frame will be a png with HD size 1600x900 :)
png(file="example%04d.png", width=1600,height=900)
nsteps <- max(E(g)$time)
#Time loop starts
for(ti in seq(3,total_time,dt)){
  #define weight for edges present up to time ti.
  E(g)$weight <- ifelse(E(g)$time < ti,1,0)
  #Edges with non-zero weight are in gray. The rest are transparent
  E(g)$color <- ifelse(E(g)$time < ti,"black",rgb(0,0,0,0))
  #Nodes with at least a non-zero weighted edge are in color. The rest are transparent
  V(g)$color <- ifelse(graph.strength(g)==0,rgb(0,0,0,0),vcolor)
  #given the new weights, we update the layout a little bit
  layout.new <- layout.fruchterman.reingold(g,params=list(niter=10,start=layout.old,weights=E(g)$weight,maxdelta=1))
  #plot the new graph
  plot(g,layout=layout.new,vertex.label="",vertex.size=1+2*log(graph.strength(g)),olor=V(g)$color,edge.width=1.5,asp=9/16,margin=-0.15)
  #use the new layout in the next round
  layout.old <- layout.new
}
dev.off()

To leave a comment for the author, please follow the link and comment on his blog: ProbaPerception.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.