r – 在单个图像上绘制多个ggplot图,左对齐图和单个图例

我想将几个不同的ggplot图放入单个图像中.经过多次探索,我发现如果数据格式正确,ggplot可以很好地生成单个图或一系列图.但是,当您想要组合多个图时,有许多不同的选项可以将它们组合起来,这会让人感到困惑和快速复杂.对于我的最终情节,我有以下愿望:

>对齐所有单个图的左轴,使得图可以共享最底部图中存在的共同x轴
>图的右侧有一个常见的图例(最好位于图的顶部附近)
>前两个指标图没有任何y轴抽动或数字
>地块之间的空间最小
>指标图(isTraining和isTesting)占用较小的垂直空间,以便其余三个图可以根据需要填充空间

我已经搜索了满足上述要求的解决方案,但它无法正常工作.下面的代码做了很多这方面的工作(尽管可能是一种复杂的方式),但是不能满足我上面列出的要求.以下是我的具体问题:

>我找到的用于对齐图表左侧的代码由于某种原因不起作用
>我目前用于在同一页面上获取多个图的方法似乎很难使用,并且很可能是一种更好的技术(我愿意接受建议)
> x轴标题未显示在结果中
>传说没有与情节的顶部对齐(我根本不知道这样做的简单方法,所以我没有尝试过.欢迎提出建议)

任何帮助解决任何这些问题将不胜感激.

自包含代码示例

(这有点长,但对于这个问题,我认为可能会有奇怪的互动)

# 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: 
#   https://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)

以上视觉效果如下图所示:

最佳答案
使用rbind.gtable来对齐ggplots;这里它非常简单,因为gtables都有相同数量的列.在我看来,设置面板高度并在侧面添加图例也更简单,gtable比使用网格视口更直接.

唯一的轻微烦恼是rbind.gtable currently doesn’t handle unit.pmax to set the widths as required.虽然很容易修复,但请参阅下面的rbind_max函数.

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)

转载注明原文:r – 在单个图像上绘制多个ggplot图,左对齐图和单个图例 - 代码日志