Creating ggplot2 charts that are facetwrapped by plot type

Question

I am trying to create a ggplot2 facet wrapped by plot type. I've used grid.arrange but I'm trying to maximise the plot area, using the grid.arrange I loose area due to the repeating of the y axis and legends.

Specifically, I am trying to create a plot that has a BoxPlot on the Left with a timeseries of the same data (so same Y axis) on the Right. Then I'd have a single Y Axis and a Single Legend - is this possible?

The code:

library(ggplot2)
library(gridExtra)
Time = c("19/12/2013 10:00","19/12/2013 10:01", "19/12/2013 10:02", "19/12/2013 10:03",    "19/12/2013 10:04",
     "19/12/2013 10:05", "19/12/2013 10:06", "19/12/2013 10:07", "19/12/2013 10:08", "19/12/2013 10:09",
     "19/12/2013 10:10", "19/12/2013 10:11", "19/12/2013 10:12", "19/12/2013 10:13", "19/12/2013 10:14")

test <- data.frame(Time)

test$Factor <- c("t1", "t1", "t1", "t1", "t1", "t1", "t1", "t1", "t1", "t2", "t2", "t2", "t2", "t2", "t2")
test$Values <- c(4,7,2,9,6,9,1,1,5,8,3,4,3,6,7)
test$PROD <- test$PROD <- c("one", "two", "one", "two", "one", "one", "two", "one", "one", 
           "two", "one", "two", "two", "two", "one")

p1 <-ggplot(data=test,aes(Factor,Values )) +
    geom_boxplot(outlier.colour = "red", outlier.size = 3, outlier.shape = 15, fill = "white", colour = "blue") +
    theme(panel.grid.minor = element_line(colour = "grey"), plot.title = element_text(size = rel(2)),axis.text.x = element_text(angle=90, vjust=1), strip.text.x = element_text(size = 8, colour = "black", face = "bold")) +  
    geom_point(alpha = 0.6, position = position_jitter(w = 0.05, h = 0.0), aes(colour=factor(Factor)), size =3) +
    facet_wrap(~PROD, scales = "free") +
    ggtitle("MyTitle") + 
    scale_size_area() + 
    xlab("Tools") + 
    ylab("Values")

p2<-ggplot(data = test, aes(Time,Values )) + 
    ggtitle("MyTitle") + 
    theme(axis.text.x = element_text(angle=90, vjust=1),plot.title = element_text(size = rel(2))) + 
    geom_point(aes(colour=factor(Factor)), size = 3) + 
    facet_wrap(~PROD, scales = "free") + 
    xlab("TIME") + 
    ylab("Values")

grid.arrange(p1,p2,ncol=2)

Answer 1

This is not a final answer , but should be a good start.

I would

• Format Time axis as a valid date type
• Remove the x-axis label rotation for p1 and p2. If you want to keep axis rotation, you should resize the other grob to match y-axis.
• Remove p1 legend
• Remove p2 y axis label

For example:

test$Time <- as.POSIXct(test$Time,format='%d/%m/%Y %H:%M')
## build p1 and p2 using your original code

grid.arrange(p1+theme(legend.position='none'),
             p2+theme(axis.title.y=element_blank()),
             ncol=2)

EDIT extract legend grob for more flexibility:

g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  legend
}
legend1 <- g_legend(p2)
grid.arrange(p1+theme(legend.position='none'),
             p2+theme(axis.title.y=element_blank(),legend.position='none'),
             legend1,
             ncol=3,nrow=1,widths= c(3/7,3/7,1/7))

Answer 2

You can play with gtable, but there are a few features missing,

library(gtable)
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)

## drop some elements by name
## note that trim should check for the sizes if elements still remain
## in the same column(s)/row(s) of the layout...
gtable_drop <- function (x, pattern, fixed = FALSE, trim = TRUE) 
{
  matches <- grepl(pattern, x$layout$name, fixed = fixed)
  drop = x$layout[matches, , drop = FALSE]
  x$layout <- x$layout[!matches, , drop = FALSE]
  x$grobs <- x$grobs[!matches]

  if (trim) {
    x$widths[drop$l] <- replicate(NROW(drop), unit(0,"mm"), simplify=FALSE)
    x <- gtable_trim(x)
  }
  x
}

g1p <- gtable_drop(g1, "guide|axis_l-2")
g2p <- gtable_drop(g2, "axis_l|ylab")
g <- gtable:::cbind_gtable(g1p, g2p, "last") # ideally "max" but buggy
grid.newpage()
grid.draw(g)