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:
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:
Any help in solving any of these issues would be greatly appreciated.
(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)
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.
%>% 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.
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.
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.
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With