How can I add text to a network plot in R? - r

Question

I am using the package networkDynamic to visualise two evolving networks and I would like to add, close to each network a simple legend (a few words of text). I can't find a way of doing this.
In the networkDynamic package, the function render.animation uses plot.network (from the package network) to render each frame and then compiles the different frames into an animation.
The plot.network arguments can be passed to render.animation, so the problem seems to boils down to adding text to a plot generated with plot.network but there doesn't seem to be a way of adding text at specified coordinates.
With a normal plot I would use the text function, but is there a way of including this function into the plot.network arguments?

Answer 1

render.animation is a function in the ndtv package. You will have to create a custom render.animation2 function based on render.animation. In the following function, I add an extra line to the render.animation function. I add an mtext after each plot.network calls (see about 20 lines from the end). You could change it to a text instead of mtext.
render.animation2 <- function (net, render.par = list(tween.frames = 10, show.time = TRUE,
show.stats = NULL, extraPlotCmds = NULL, initial.coords = 0),
plot.par = list(bg = "white"), ani.options = list(interval = 0.1),
render.cache = c("plot.list", "none"), verbose = TRUE, ...)
{
if (!is.network(net)) {
stop("render.animation requires the first argument to be a network object")
}
if (is.null(render.par)) {
stop("render.animation is missing the 'render.par' argument (a list of rendering parameters).")
}
if (is.null(render.par$tween.frames)) {
render.par$tween.frames <- 10
}
if (is.null(render.par$show.time)) {
render.par$show.time <- TRUE
}
if (is.null(render.par$initial.coords)) {
render.par$initial.coords <- matrix(0, ncol = 2, nrow = network.size(net))
}
if (!all(c("animation.x.active", "animation.y.active") %in%
list.vertex.attributes(net))) {
net <- compute.animation(net, verbose = verbose)
}
externalDevice <- FALSE
doRStudioHack <- TRUE
if (!is.null(render.par$do_RStudio_plot_hack)) {
doRStudioHack <- render.par$do_RStudio_plot_hack
}
if (!is.function(options()$device)) {
if (names(dev.cur()) == "RStudioGD" & doRStudioHack) {
message("RStudio's graphics device is not well supported by ndtv, attempting to open another type of plot window")
if (.Platform$OS.type == "windows") {
windows()
}
else if (length(grep(R.version$platform, pattern = "apple")) >
0) {
quartz()
}
else {
x11()
}
externalDevice <- TRUE
}
}
if (par("bg") == "transparent" & is.null(plot.par$bg)) {
plot.par$bg <- "white"
}
origPar <- par(plot.par)
oopts <- ani.options(ani.options)
slice.par <- get.network.attribute(net, "slice.par")
if (is.null(slice.par)) {
stop("render.animation can not locate the 'slice.par' list of parameters in the input network object")
}
render.cache <- match.arg(render.cache)
plot_params <- list(...)
if (is.null(plot_params$label)) {
plot_params$label <- function(slice) {
network.vertex.names(slice)
}
}
if (is.null(plot_params$xlab) & render.par$show.time) {
plot_params$xlab <- function(onset, terminus) {
ifelse(onset == terminus, paste("t=", onset, sep = ""),
paste("t=", onset, "-", terminus, sep = ""))
}
}
if (!is.null(render.par$show.stats) && render.par$show.stats !=
FALSE) {
if (render.par$show.time) {
plot_params$xlab <- eval(parse(text = paste("function(slice,onset,terminus){stats<-summary.statistics.network(slice",
render.par$show.stats, ")\n return(paste('t=',onset,'-',terminus,' ',paste(rbind(names(stats),stats),collapse=':'),sep='')) }",
sep = "")))
}
else {
plot_params$xlab <- eval(parse(text = paste("function(slice){stats<-summary.statistics.network(slice",
render.par$show.stats, ")\n return(paste(rbind(names(stats),stats),collapse=':')) }",
sep = "")))
}
}
if (is.null(plot_params$jitter)) {
plot_params$jitter <- FALSE
}
interp.fun <- coord.interp.smoothstep
starts <- seq(from = slice.par$start, to = slice.par$end,
by = slice.par$interval)
ends <- seq(from = slice.par$start + slice.par$aggregate.dur,
to = slice.par$end + slice.par$aggregate.dur, by = slice.par$interval)
xmin <- aggregate.vertex.attribute.active(net, "animation.x",
min)
xmax <- aggregate.vertex.attribute.active(net, "animation.x",
max)
ymin <- aggregate.vertex.attribute.active(net, "animation.y",
min)
ymax <- aggregate.vertex.attribute.active(net, "animation.y",
max)
if (is.null(plot_params$xlim)) {
if (xmin == xmax) {
xmax <- xmin + 1
xmin <- xmin - 1
}
plot_params$xlim <- c(xmin, xmax)
}
if (is.null(plot_params$ylim)) {
if (ymin == ymax) {
ymax <- ymin + 1
ymin <- ymin - 1
}
plot_params$ylim <- c(ymin, ymax)
}
if (is.numeric(render.par$initial.coords)) {
coords <- matrix(render.par$initial.coords, ncol = 2,
nrow = network.size(net))
}
slice <- network.collapse(net, starts[1], ends[1], rule = slice.par$rule,
rm.time.info = FALSE)
activev <- is.active(net, starts[1], ends[1], v = seq_len(network.size(net)),
rule = if (slice.par$rule != "all") {
"any"
})
if (length(slice) > 0 & network.size(slice) > 0) {
coords[activev, 1] <- get.vertex.attribute(slice, "animation.x")
coords[activev, 2] <- get.vertex.attribute(slice, "animation.y")
}
coords2 <- coords
if (render.cache == "plot.list") {
ani.record(reset = TRUE)
}
for (s in 1:length(starts)) {
if (verbose) {
print(paste("rendering", render.par$tween.frames,
"frames for slice", s - 1))
}
slice <- network.collapse(net, starts[s], ends[s], rule = slice.par$rule,
rm.time.info = FALSE)
activev <- is.active(net, starts[s], ends[s], v = seq_len(network.size(net)),
rule = if (slice.par$rule != "all") {
"any"
})
if (length(slice) > 0 & network.size(slice) > 0) {
evald_params <- .evaluate_plot_params(plot_params = plot_params,
net = net, slice = slice, s = s, onset = starts[s],
terminus = ends[s])
for (t in 1:render.par$tween.frames) {
coords2[activev, 1] <- get.vertex.attribute(slice,
"animation.x")
coords2[activev, 2] <- get.vertex.attribute(slice,
"animation.y")
tweenCoords <- interp.fun(coords, coords2, t,
render.par$tween.frames)
plot_args <- list(x = slice, coord = tweenCoords[activev,
, drop = FALSE])
plot_args <- c(plot_args, evald_params)
do.call(plot.network, plot_args)
mtext("my text\n on two lines", side = 3) #my.legend
if (!is.null(render.par$extraPlotCmds)) {
eval(render.par$extraPlotCmds)
}
if (render.cache == "plot.list") {
ani.record()
}
}
coords <- coords2
}
else {
evald_params <- .evaluate_plot_params(plot_params = plot_params,
net = net, slice = slice, s = s, onset = starts[s],
terminus = ends[s])
if (render.par$show.time) {
xlab <- evald_params$xlab
}
else {
xlab <- NULL
}
singlenet <- network.initialize(1)
for (t in 1:render.par$tween.frames) {
plot.network(singlenet, vertex.cex = 0, xlab = xlab)
if (!is.null(render.par$extraPlotCmds)) {
eval(render.par$extraPlotCmds)
}
if (render.cache == "plot.list") {
ani.record()
}
}
}
}
par(origPar)
if (externalDevice) {
dev.off()
}
}
It is then important to assign your new function render.animation2 to the ndtv namespace. If you don't, it will crash because render.animation refers to functions that can only be found in its own namespace.
environment(render.animation2) <- asNamespace('ndtv')
environment(render.animation) #<environment: namespace:ndtv>
environment(render.animation2) #<environment: namespace:ndtv>
Using, render.animation2, you will then get your legend printed on each slide of the animation.
require(ndtv)
triangle <- network.initialize(3) # create a toy network
add.edge(triangle,1,2)
# add an edge between vertices 1 and 2
add.edge(triangle,2,3)
# add a more edges
activate.edges(triangle,at=1) # turn on all edges at time 1 only
activate.edges(triangle,onset=2, terminus=3,
e=get.edgeIDs(triangle,v=1,alter=2))
add.edges.active(triangle,onset=4, length=2,tail=3,head=1)
render.animation2(triangle) #custom function
ani.replay()
Here's what the last slide looks like in the animation:

Answer 2

If you only need to add a few lines of text, you can pass the standard plot arguments main (for the main title) or xlab (for the x-axis caption). you can separate lines with the newline escape "\n"
library(ndtv)
data(short.stergm.sim)
render.animation(short.stergm.sim,main='hello\nworld')
It is also possible to plot other graphic elements (such as legend or text or maps) using the extraPlotCmds argument to render.animation. For example, if you wanted to plot "hello world" in blue at coordiantes 0,0 using text you can wrap it in an expression and pass it in via render.par
render.animation(short.stergm.sim,
render.par=list(extraPlotCmds=expression(
text(0,0,'hello\nworld',col='blue')
))
)
the extra plot command will evaluated on each frame as the network is rendered