创建按绘图类型包装的 ggplot2 图表答案

【问题标题】：Creating ggplot2 charts that are facetwrapped by plot type创建按绘图类型包装的 ggplot2 图表
【发布时间】：2014-01-07 21:35:06
【问题描述】：

我正在尝试创建一个由绘图类型包裹的 ggplot2 构面。我使用了grid.arrange，但我正在尝试最大化绘图区域，使用 grid.arrange 由于 y 轴和图例的重复，我松散了区域。

具体来说，我正在尝试创建一个左侧有 BoxPlot 的图，右侧有相同数据的时间序列（相同的 Y 轴）。然后我会有一个 Y 轴和一个图例 - 这可能吗？

代码：

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)

【问题讨论】：

虚拟刻面变量？ github.com/hadley/ggplot2/wiki/Align-two-plots-on-a-page
@baptiste 我不确定是否可以在这里应用虚拟分面，因为 Op 已经使用 facet_wrap..
@agstudy 从概念上讲，我认为虚拟变量可以处理这种情况，但它可能不是很直观
在这种情况下，虚拟分面可能也可以工作，但是 x 比例属于不同的类，所以它可能太棘手了。

标签： r plot ggplot2

【解决方案1】：

这不是最终答案，但应该是一个好的开始。

我愿意

将时间轴格式化为有效的日期类型
移除 p1 和 p2 的 x 轴标签旋转。如果要保持轴旋转，则应调整另一个 grob 的大小以匹配 y 轴。
删除 p1 图例
移除 p2 y 轴标签

例如：

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)

编辑提取图例 grob 以获得更大的灵活性：

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))

【讨论】：

谢谢 - 对 grid.arrange 的简单添加正在做我需要的事情，它没有摆脱第二个 Y 轴，但是从第二个图中删除了图例和 y 轴标题给了我现在有更多空间。

【解决方案2】：

你可以玩 gtable，但是缺少一些功能，

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)

【讨论】：