Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Plot multiple ggplot plots on a single image with left alignment of the plots and a single legend

Tags:

r

ggplot2

r-grid

I would like to place several different ggplot plots into a single image. After much exploring, I am finding that ggplot is fantastic at generating a single plot or a series of plots if the data is formatted correctly. However, when you want to combine multiple plots, there are so many different options to combine them it get confusing and quickly convoluted. I have the following desires for my final plot:

  1. The left axes of all the individual plots are aligned so that the plots can all share a common x-axis present by the bottom most plot
  2. There is a single common legend on the right of the plot (preferably positioned near the top of the plot)
  3. The top two indicator plots do not have any y-axis tics or numbers
  4. There is a minimum amount of space between the plots
  5. The indicator plots (isTraining and isTesting) take up a smaller amount of vertical space so that the remaining three plots can fill the space as needed

I have searched for solutions to meet the above requirements but it just is not working correctly. The following code does a lot of this (albeit in a possibly convoluted way) but falls short of satisfying my above listed requirements. The following are my specific issues:

  1. The code that I found to align the left sides of the plots is not working for some reason
  2. The method that I am currently using to get multiple plots on the same page seems difficult to use and there is most likely a better technique (I am open to suggestions)
  3. The x-axis title is not showing up in the result
  4. The legend is not aligned to the top of the plot (I do not know the easy way to do this at all, so I have not tried. Suggestions are welcome)

Any help in solving any of these issues would be greatly appreciated.

Self Contained Code Example

(It is a bit long but for this question I thought that there could be strange interactions)

# Load needed libraries ---------------------------------------------------

library(ggplot2)
library(caret)
library(grid)

rm(list = ls())

# Genereate Sample Data ---------------------------------------------------

N = 1000
classes = c('A', 'B', 'C', 'D', 'E')
set.seed(37)
ind   = 1:N
data1 = sin(100*runif(N))
data2 = cos(100*runif(N))
data3 = cos(100*runif(N)) * sin(100*runif(N))
data4 = factor(unlist(lapply(classes, FUN = function(x) {rep(x, N/length(classes))})))
data = data.frame(ind, data1, data2, data3, Class = data4)
rm(ind, data1, data2, data3, data4, N, classes)

# Sperate into smaller datasets for training and testing ------------------

set.seed(1976)
inTrain <- createDataPartition(y = data$data1, p = 0.75, list = FALSE)
data_Train = data[inTrain,]
data_Test  = data[-inTrain,]
rm(inTrain)

# Generate Individual Plots -----------------------------------------------

data1_plot = ggplot(data) + theme_bw() + geom_point(aes(x = ind, y = data1, color = Class))
data2_plot = ggplot(data) + theme_bw() + geom_point(aes(x = ind, y = data2, color = Class))
data3_plot = ggplot(data) + theme_bw() + geom_point(aes(x = ind, y = data3, color = Class))
isTraining = ggplot(data_Train) + theme_bw() + geom_point(aes(x = ind, y = 1, color = Class))
isTesting = ggplot(data_Test) + theme_bw() + geom_point(aes(x = ind, y = 1, color = Class))


# Set the desired legend properties before extraction to grob -------------

data1_plot = data1_plot + theme(legend.key = element_blank())

# Extract the legend from one of the plots --------------------------------

getLegend<-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]]
  return(legend)}

leg = getLegend(data1_plot)


# Remove legend from other plots ------------------------------------------

data1_plot = data1_plot + theme(legend.position = 'none')
data2_plot = data2_plot + theme(legend.position = 'none')
data3_plot = data3_plot + theme(legend.position = 'none')
isTraining = isTraining + theme(legend.position = 'none')
isTesting = isTesting + theme(legend.position = 'none')



# Remove the grid from the isTraining and isTesting plots -----------------

isTraining = isTraining + theme(panel.grid.minor=element_blank(), panel.grid.major=element_blank())
isTesting = isTesting + theme(panel.grid.minor=element_blank(), panel.grid.major=element_blank())


# Remove the y-axis from the isTraining and the isTesting Plots -----------

isTraining = isTraining + theme(axis.ticks = element_blank(), axis.text = element_blank())
isTesting = isTesting + theme(axis.ticks = element_blank(), axis.text = element_blank())


# Remove the margin from the plots and set the XLab to null ---------------

tmp = theme(panel.margin = unit(c(0, 0, 0, 0), units = 'cm'), plot.margin = unit(c(0, 0, 0, 0), units = 'cm'))
data1_plot = data1_plot + tmp + labs(x = NULL, y = 'Data 1')
data2_plot = data2_plot + tmp + labs(x = NULL, y = 'Data 2')
data3_plot = data3_plot + tmp + labs(x = NULL, y = 'Data 3')
isTraining = isTraining + tmp + labs(x = NULL, y = 'Training')
isTesting = isTesting + tmp + labs(x = NULL, y = 'Testing')


# Add the XLabel back to the bottom plot ----------------------------------

data3_plot = data3_plot + labs(x = 'Index')

# Remove the X-Axis from all the plots but the bottom one -----------------
# data3 is to the be last plot...

data1_plot = data1_plot + theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())
data2_plot = data2_plot + theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())
isTraining = isTraining + theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())
isTesting = isTesting + theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())


# Store plots in a list for ease of processing ----------------------------

plots = list()
plots[[1]] = isTraining
plots[[2]] = isTesting
plots[[3]] = data1_plot
plots[[4]] = data2_plot
plots[[5]] = data3_plot

# Fix the widths of the plots so that the left side of the axes align ----
# Note: This does not seem to function correctly....
# I tried to adapt from: 
#   http://stackoverflow.com/questions/13294952/left-align-two-graph-edges-ggplot

plotGrobs = lapply(plots, ggplotGrob)
plotGrobs[[1]]$widths[2:5]
maxWidth = plotGrobs[[1]]$widths[2:5]
for(i in length(plots)) {
  maxWidth = grid::unit.pmax(maxWidth, plotGrobs[[i]]$widths[2:5])
}
for(i in length(plots)) {
  plotGrobs[[i]]$widths[2:5] = as.list(maxWidth)
}

plotAtPos = function(x = 0.5, y = 0.5, width = 1, height = 1, obj) {
  pushViewport(viewport(x = x + 0.5*width, y = y + 0.5*height, width = width, height = height))
  grid.draw(obj)
  upViewport()
}

grid.newpage()
plotAtPos(x = 0, y = 0.85, width = 0.9, height = 0.1, plotGrobs[[1]])
plotAtPos(x = 0, y = 0.75, width = 0.9, height = 0.1, plotGrobs[[2]])
plotAtPos(x = 0, y = 0.5, width = 0.9, height = 0.2, plotGrobs[[3]])
plotAtPos(x = 0, y = 0.3, width = 0.9, height = 0.2, plotGrobs[[4]])
plotAtPos(x = 0, y = 0.1, width = 0.9, height = 0.2, plotGrobs[[5]])
plotAtPos(x = 0.9, y = 0, width = 0.1, height = 1, leg)

The visual result of the above is in the following image:

Output of the above code

like image 954
Justace Clutter Avatar asked Jun 15 '14 22:06

Justace Clutter


People also ask

Does par () work with ggplot?

One disadvantage for par() is that it cannot work for ggplot, we can see below that the plot should appear on the upper left of the page, but it just happen as if par() isn't written here.

What is %>% in ggplot?

%>% is a pipe operator reexported from the magrittr package. Start by reading the vignette. Introducing magrittr. Adding things to a ggplot changes the object that gets created. The print method of ggplot draws an appropriate plot depending upon the contents of the variable.

How do I align two plots in R?

If we want to align and then arrange plots, we can call plot_grid() and provide it with an align argument. The plot_grid() function calls align_plots() to align the plots and then arranges them.


1 Answers

Aligning ggplots should be done with rbind.gtable; here it's fairly straight-forward since the gtables all have the same number of columns. Setting the panel heights and adding a legend on the side is also more straight-forward with gtable than with grid viewports, in my opinion.

The only slight annoyance is that rbind.gtable currently doesn't handle unit.pmax to set the widths as required. It's easy to fix though, see the rbind_max function below. enter image description here

require(gtable)
rbind_max <- function(...){

  gtl <- lapply(list(...), ggplotGrob)

  bind2 <- function (x, y) 
  {
    stopifnot(ncol(x) == ncol(y))
    if (nrow(x) == 0) 
      return(y)
    if (nrow(y) == 0) 
      return(x)
    y$layout$t <- y$layout$t + nrow(x)
    y$layout$b <- y$layout$b + nrow(x)
    x$layout <- rbind(x$layout, y$layout)
    x$heights <- gtable:::insert.unit(x$heights, y$heights)
    x$rownames <- c(x$rownames, y$rownames)
    x$widths <- grid::unit.pmax(x$widths, y$widths)
    x$grobs <- append(x$grobs, y$grobs)
    x
  }

  Reduce(bind2, gtl)
}



gp <- do.call(rbind_max, plots)
gp <- gtable_add_cols(gp, widths = sum(leg$widths))
panels <- gp$layout$t[grep("panel", gp$layout$name)]
# set the relative panel heights 1/3 for the top two
gp$heights[panels] <- lapply(c(1,1,3,3,3), unit, "null")
# set the legend justification to top (it's a gtable embedded in a gtable)
leg[["grobs"]][[1]][["vp"]] <- viewport(just = c(0.5,1))
gp <- gtable_add_grob(gp, leg, t = 1, l = ncol(gp))

grid.newpage()
grid.draw(gp)
like image 93
baptiste Avatar answered Oct 16 '22 07:10

baptiste