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

[This article was first published on ProbaPerception, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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 1600×900 🙂
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 their blog: ProbaPerception.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)