Add annotation box to grid of ggplot objects

Question

I am preparing a grid of 37 ggplots using the grid.arrange function. To save space currently taken by the axis labels and to add some information like Sys.time() I would add a box to the lower right of the graphics grid.

A minimal example using the mtcars data can be found below. The real data will cover very different ranges on x axis to facetting is not an option.

Is there a way to add a "textbox" as shown in the *.pdf below within R to add further info using e.g. cat or print? Any hint would be highly appreciated.

# load needed libraries
library(ggplot2)
library(gridExtra)

# Set loop counter and create list to store objects
imax=37 
plist <- list() 

# loop to generate 37 ggplot objects
# the real example covers different ranges on x-axis so facetting
# is not an option
for(i in 1:imax){
  p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_line()  + ggtitle(i) 
  plist[[i]] <- p
}

# print to pdf in A3 format
pdf(file="out.pdf",width=16.5,height=11.7)
do.call(grid.arrange,c(plist,main="Main Title",sub="Subtitle"))
dev.off()

Update

The solution by Slowlearner using the code provided by Baptiste does exactly what I was looking for.

Another way to achieve something similar would be to use the annotate_custom() function of ggplot2 on an empty plot. Empty means that all theme() attributes are set to element_blank(). This plot could then be arranged in the grid using the following function provided by Winston Chang on his R Cookbook website. However, in this solution the textgrob would not span all the remaining empty grobs.

Answer 1

Based on mature consideration of Baptiste's comments above (i.e. I basically pinched all his code) I have put together a simple example. Obviously you will need to experiment with formatting and sizes for the plots and the textGrob will need to be defined and formatted elsewhere, but these are details. The plot generated is below and the code follows that. Most of it is taken up by the function definition with the plot code at the bottom.

gtable_arrange <- function(..., grobs=list(), as.table=TRUE,
                           top = NULL, bottom = NULL, 
                           left = NULL, right = NULL, draw=TRUE){
  require(gtable)
  # alias
  gtable_add_grobs <- gtable_add_grob

  dots <- list(...)
  params <- c("nrow", "ncol", "widths", "heights",
              "respect", "just", "z") # TODO currently ignored

  layout.call <- intersect(names(dots), params)
  params.layout <- dots[layout.call]

  if(is.null(names(dots)))
    not.grobnames <- FALSE else
      not.grobnames <- names(dots) %in% layout.call

  if(!length(grobs))
  grobs <- dots[! not.grobnames ]

  ## figure out the layout
  n <- length(grobs)
  nm <- n2mfrow(n)

  if(is.null(params.layout$nrow) & is.null(params.layout$ncol)) 
  {
    params.layout$nrow = nm[1]
    params.layout$ncol = nm[2]
  }
  if(is.null(params.layout$nrow))
    params.layout$nrow = ceiling(n/params.layout$ncol)
  if(is.null(params.layout$ncol))
    params.layout$ncol = ceiling(n/params.layout$nrow)

  if(is.null(params.layout$widths))
    params.layout$widths <- unit(rep(1, params.layout$ncol), "null")
  if(is.null(params.layout$heights))
    params.layout$heights <- unit(rep(1,params.layout$nrow), "null")

  positions <- expand.grid(row = seq_len(params.layout$nrow), 
                           col = seq_len(params.layout$ncol))
  if(as.table) # fill table by rows
    positions <- positions[order(positions$row),]

  positions <- positions[seq_along(grobs), ] # n might be < ncol*nrow

  ## build the gtable, similar steps to gtable_matrix

  gt <- gtable(name="table")
  gt <- gtable_add_cols(gt, params.layout$widths)
  gt <- gtable_add_rows(gt, params.layout$heights)
  gt <- gtable_add_grobs(gt, grobs, t = positions$row, 
                            l = positions$col)

  ## titles given as strings are converted to text grobs
  if (is.character(top)) 
    top <- textGrob(top)
  if (is.character(bottom)) 
    bottom <- textGrob(bottom)
  if (is.character(right)) 
    right <- textGrob(right, rot = -90)
  if (is.character(left)) 
    left <- textGrob(left, rot = 90)

  if(!is.null(top)){
    gt <- gtable_add_rows(gt, heights=grobHeight(top), 0)
    gt <- gtable_add_grobs(gt, top, t=1, l=1, r=ncol(gt))
  }
  if(!is.null(bottom)){
    gt <- gtable_add_rows(gt, heights=grobHeight(bottom), -1)
    gt <- gtable_add_grobs(gt, bottom, t=nrow(gt), l=1, r=ncol(gt))
  }
  if(!is.null(left)){
    gt <- gtable_add_cols(gt, widths=grobWidth(left), 0)
    gt <- gtable_add_grobs(gt, left, t=1, b=nrow(gt), l=1, r=1)
  }
  if(!is.null(right)){
    gt <- gtable_add_cols(gt, widths=grobWidth(right), -1)
    gt <- gtable_add_grobs(gt, right, t=1, b=nrow(gt), l=ncol(gt), r=ncol(gt))
  }

  if(draw){
   grid.newpage()
   grid.draw(gt)
  }
  gt

}

# load needed libraries
library(ggplot2)

# Set loop counter and create list to store objects
imax=37
plist <- list()
p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_line() 

for(i in 1:imax){
  plist[[i]] <- p + ggtitle(i)
}

# build list of grobs
grob.list <- lapply(plist, ggplotGrob)

# prepare titles
title.main <- textGrob("Main title")
title.sub <- textGrob("Subtitle")

# then arrange as required
g <- gtable_arrange(ncol=6, grobs=grob.list, 
                    top=title.main, bottom=title.sub, draw=FALSE)
ann <- grobTree(rectGrob(), textGrob("Annotation box here"))
g <- gtable_add_grobs(g, ann, t=nrow(g)-1, l=2, r=ncol(g))

# save it all together
png(file = "out.png",width=1000, height=710, units = "px")
grid.draw(g)
dev.off()