R/iGraph Holiday network animation and How-to tips

The animation embedded in this post was done using R and the iGraph package and was, frankly, a great deal more work than I thought it would be when I started. What kept me going was a desire to express a wish for the New Year while also experimenting with some functionality that might be useful in my future research. In the following post I will provide some example code that extends my previous attempts at network animation by: 1) using the iGraph plot parameter margin to zoom in and out of different parts of the graph; 2) use the neighborhood function to highlight an information spread; and, 3) moving nodes along a path where you know the first and last point and the number of steps you want to make between them. I can imagine using the first two in my research, and the third was, well, just fun. I’m a geek. I’ll end the post with a line or two more about my motivations for creating this particular animation.

Not including experimental code, the final set of code used to create this animation is over 1,500 lines, so I won’t post the whole thing. However, I will walk through some of the key aspects of the animation and include a few code blocks.

The animation roughly follows the following set of frame paths:

• Show the “you” node all zoomed in.
• Zoom out highlighting nodes that retweet along the way.
• Neighborhood diffusion wave.
• Move nodes to form the word Peace.
• Zoom back in.

First, the network. In this kind of animation I didn’t need a real network so I used a function to create a random network. For the animation the network needed to look somewhat like I think a lay-person would expect, links to close people spreading out to a sea of nodes. GRG game creates a network of nodes randomly situated in 2D space where all nodes within a certain distance are connected.

1
2

library(igraph)
g <- grg.game(total.nodes, 0.03, torus=FALSE, coords=1)

I utilized extremely systematic programmatic practices to identify the node I would use for the ‘you’ node: I tinkered. Once I had that I had to be able to zoom into a node given its id. Since I was going to be zooming more than once, I made it into a function (which I invite anyone to improve on).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

calculateZoomMarginVector <- function(g, zoom.node, start.zoom.in.margin) {
	l <- cbind(V(g)$x, V(g)$y)
	V(g)$norm.x <- layout.norm(l, -1, 1, -1, 1)[,1]
	V(g)$norm.y <- layout.norm(l, -1, 1, -1, 1)[,2]
 
	node.to.zoom.to.x <- V(g)[zoom.node]$norm.x # 0.2580286
	node.to.zoom.to.y <- V(g)[zoom.node]$norm.y # -0.08265183
 
	zoom.both.max <- start.zoom.in.margin
	original.scale <- 1
 
	zoom.top <- -((zoom.both.max/2) - (node.to.zoom.to.y/original.scale))
	zoom.bottom <- -((zoom.both.max/2) + (node.to.zoom.to.y/original.scale))
	zoom.left <- -((zoom.both.max/2) + (node.to.zoom.to.x/original.scale))
	zoom.right <- -((zoom.both.max/2) - (node.to.zoom.to.x/original.scale))
	# below, left, top, right
	zoom.margin <- c(zoom.bottom, zoom.left, zoom.top, zoom.right)
	zoom.margin
}

Calling the above function twice gives a start margin vector and end margin vector which can then be passed to another function that returns a data.frame for each zoom step. For an animation each zoom step gets plotted:

1
2
3
4
5
6
7
8
9

zoom.to.zoom <- function(start.zoom.margin, end.zoom.margin, steps.out) {
	zoom.bottom.vec <- seq(from=start.zoom.margin[1], to=end.zoom.margin[1], length=steps.out)
	zoom.left.vec <- seq(from=start.zoom.margin[2], to=end.zoom.margin[2], length=steps.out)
	zoom.top.vec <- seq(from=start.zoom.margin[3], to=end.zoom.margin[3], length=steps.out)
	zoom.right.vec <- seq(from=start.zoom.margin[4], to=end.zoom.margin[4], length=steps.out)
 
	zoom.margin.df <- data.frame(bottom=zoom.bottom.vec, left=zoom.left.vec, top=zoom.top.vec, right=zoom.right.vec)
	zoom.margin.df
}

I’ll pass over highlighting nodes since that is simply a matter of iterating over a color palette and setting the nodes color. The diffusion wave is more interesting. Essentially I store the degree that any node is from the ‘you’ node as an attribute in the network object (g). The wave first darkens the nodes, then flashes white, then goes to yellow. That means I need to set three different colors at each step out from the ‘you’ node.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

loop.its <- max(V(g)$color.wave.iteration)
 
for (i in 4:loop.its) {
 
	wave.start <- i
	wave.end <- wave.start - 3
 
	if (wave.end < 3) {
		wave.end <- 3
	}
 
	cat(" wave ", i, "\n")
	tweet.wave.col.palette.count <- 1
	for (k in wave.start:wave.end) {
 
		wave.it.nodes <- which(V(g)$color.wave.iteration == k)
		tmp.color <- tweet.wave.col.palette[tweet.wave.col.palette.count]
		tweet.wave.col.palette.count <- tweet.wave.col.palette.count + 1
		cat(k, ": ", length(wave.it.nodes), " ", tmp.color, "\n", sep="")
 
		V(g)$color[wave.it.nodes] <- tmp.color
		if (k < wave.start) {
			V(g)$size[wave.it.nodes] <- tweeted.size 
		}
	}
 
	plot.f.name <- paste(dir.path.frames, "Peace_frame_", frame.number, "_", frame.set, ".png", sep="")
	frame.number <- frame.number + 1
	png(plot.f.name, width=frame.width, height=frame.height)
		  par(bg="black", xpd=NA, mar=c(0,0,0,0))
		  plot.igraph(g, edge.arrow.size=0.02, edge.arrow.width=0, margin=local.zoom.margin , main="", edge.lty=edge.lty)
	dev.off()
}

Moving the nodes to the word peace wasn’t very difficult. What was difficult was coming up with the location of roughly 4000 points that together spelled “PEACE”. There ought to be an app for that. Anybody got a tool for this? I did it, embarrassingly, by trial and error. Once I had the points for the word it was simply a matter of… well, it was a couple of steps. First, I had to match points in the network up with points in the letter. I can post details on that if anyone is interested, but to keep this post short I’ll get right to code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

GetPathPoints <- function(start.x, end.x, start.y, end.y, space.between) {
 
	# get slope
	move.path.m <- ( (end.y - start.y) / (end.x - start.x) ) 
	# solve for b
	move.path.b <- start.y - move.path.m * start.x
	# distance between points
	move.path.d <- sqrt( (end.x - start.x)^2 + (end.y - start.y)^2 ) 
	# how many points along the path
	move.path.num.points <- floor(move.path.d / space.between)
	# make a vec of distances from starting point (x0,y0)
	move.path.d.vec <- seq(from=space.between, by=space.between, length=move.path.num.points)
 
	# when going from pos x to neg x, need move path to be neg
	if (end.x < start.x) {
		move.path.d.vec <- move.path.d.vec * -1
	}
 
	# x = x0 + distance/sqrt(1 + slope^2)
	move.path.x <- start.x + move.path.d.vec/sqrt(1 + move.path.m^2)
	# y = m * x + b
	move.path.y <- move.path.m * move.path.x + move.path.b
 
	data.frame(x = move.path.x, y = move.path.y)
}

Now I just move the nodes a tiny bit, based on the path data, plot, do again. When it is all done, I zoomed in using the same functions I used before.

I glossed over a great deal in this post, one of the big ones being managing the data, and the other being figuring out which network nodes went to which peace word points. If anyone is interested I can do a future post on the topic.

I want to finish with a bit more on why I went to all this effort. I am a PhD candidate. A few weeks ago the country that one of my advisers lives in was at war. The relationship between a PhD student and their advisers is… different. If you can munge together friend, co-worker, mentor, parent, child, competitor, advocate, cheerleader and camp counselor all together into one relationship that gets close. I just wanted the war to stop.