Multiple plots with subplot in R

I’m in the middle of creating a poster and wanted to compresss the content by transforming some of the charts into subplots of other charts.

I made a little survey and found that there is a TeachingDemos library in CRAN that fits my needs. Well, the parameterization of the functions is a bit tricky but after a few tries you get used to it.

However, there is a minor flaw in the code of version 2.7: when I wanted to use multiple plots on one layout (e.g., next to each other to use a common legend), it always drew the charts into the first plotting area. A bit of Googling helped, my solution is based on this thread on the R-help list since October, 2010. If you manage to install version 2.8, the problem is solved automatically. On the other side, if you want a quick solution, add the following code segment to your script (so it is shadowing the original function definition).

Only change the first 3 lines of the code, leave the other untouched (you can verify it by diffing this code and entering subplot into the R console).

subplot <- function (fun, x, y = NULL, size = c(1, 1), vadj = 0.5, hadj = 0.5, 
  inset = c(0, 0), type = c("plt", "fig"), pars = NULL) 
{
#------------------------------------------------------
# Version 2.7 has a minor issue here:
# old.par <- par(no.readonly = TRUE)
# on.exit(par(old.par))
# type <- match.arg(type)
#------------------------------------------------------
# Change to this in order to solve the issue
 # HACK HERE!
 print("Hacked")
 type <- match.arg(type) 
 old.par <- par( c(type, 'usr', names(pars) ) ) 
#------------------------------------------------------
# The remaining part is untouched
 on.exit(par(old.par))
 
 if (missing(x)) 
  x <- locator(2)
 if (is.character(x)) {
  if (length(inset) == 1) 
   inset <- rep(inset, 2)
  x.char <- x
  tmp <- par("usr")
  x <- (tmp[1] + tmp[2])/2
  y <- (tmp[3] + tmp[4])/2
  if (length(grep("left", x.char, ignore.case = TRUE))) {
   x <- tmp[1] + inset[1] * (tmp[2] - tmp[1])
   if (missing(hadj)) 
    hadj <- 0
  }
  if (length(grep("right", x.char, ignore.case = TRUE))) {
   x <- tmp[2] - inset[1] * (tmp[2] - tmp[1])
   if (missing(hadj)) 
    hadj <- 1
  }
  if (length(grep("top", x.char, ignore.case = TRUE))) {
   y <- tmp[4] - inset[2] * (tmp[4] - tmp[3])
   if (missing(vadj)) 
    vadj <- 1
  }
  if (length(grep("bottom", x.char, ignore.case = TRUE))) {
   y <- tmp[3] + inset[2] * (tmp[4] - tmp[3])
   if (missing(vadj)) 
    vadj <- 0
  }
 }
 xy <- xy.coords(x, y)
 if (length(xy$x) != 2) {
  pin <- par("pin")
  tmp <- cnvrt.coords(xy$x[1], xy$y[1], "usr")$plt
  x <- c(tmp$x - hadj * size[1]/pin[1], tmp$x + (1 - hadj) * 
      size[1]/pin[1])
  y <- c(tmp$y - vadj * size[2]/pin[2], tmp$y + (1 - vadj) * 
      size[2]/pin[2])
  xy <- cnvrt.coords(x, y, "plt")$fig
 }
 else {
  xy <- cnvrt.coords(xy, , "usr")$fig
 }
 par(pars)
 if (type == "fig") {
  par(fig = c(xy$x, xy$y), new = TRUE)
 }
 else {
  par(plt = c(xy$x, xy$y), new = TRUE)
 }
 fun
 tmp.par <- par(no.readonly = TRUE)
 return(invisible(tmp.par))
}

There is a second workaround suggested in the aforementioned thread, namely managing par('mfg') by hand before and after executing the subplot() function, but it didn't work for me. The third option (wait a few days until the CRAN packages are updated to 2.8) seems to take a bit longer. 🙂 Anyway, it is working so I'm happy.