【问题标题】：How to align multiple ggplot2 plots and add shadows over all of them如何对齐多个ggplot2图并在所有图上添加阴影
【发布时间】：2013-02-22 04:44:42
【问题描述】：

目标：像这样绘制图像：

特点： 1.两个不同的时间序列； 2. 下面板有一个反向的y轴； 3. 两个地块上的阴影。

可能的解决方案：
1. 刻面不合适 - (1) 不能只使一个刻面的 y 轴反转而保持其他刻面不变。 (2) 难以一一调整个别方面。
2. 使用视口排列单独的绘图，使用以下代码：

library(ggplot2)
library(grid)
library(gridExtra)

##Import data
df<- read.csv("D:\\R\\SF_Question.csv")

##Draw individual plots
#the lower panel
p1<- ggplot(df, aes(TIME1, VARIABLE1)) + geom_line() + scale_y_reverse() + labs(x="AGE") + scale_x_continuous(breaks = seq(1000,2000,200), limits = c(1000,2000))
#the upper panel
p2<- ggplot(df, aes(TIME2, V2)) + geom_line() + labs(x=NULL) + scale_x_continuous(breaks = seq(1000,2000,200), limits = c(1000,2000)) + theme(axis.text.x=element_blank())

##For the shadows
#shadow position
rects<- data.frame(x1=c(1100,1800),x2=c(1300,1850),y1=c(0,0),y2=c(100,100))
#make shadows clean (hide axis, ticks, labels, background and grids)
xquiet <- scale_x_continuous("", breaks = NULL)
yquiet <- scale_y_continuous("", breaks = NULL)
bgquiet<- theme(panel.background = element_rect(fill = "transparent", colour = NA))
plotquiet<- theme(plot.background = element_rect(fill = "transparent", colour = NA))
quiet <- list(xquiet, yquiet, bgquiet, plotquiet)
prects<- ggplot(rects,aes(xmin=x1,xmax=x2,ymin=y1,ymax=y2))+ geom_rect(alpha=0.1,fill="blue") + coord_cartesian(xlim = c(1000, 2000)) + quiet

##Arrange plots
pushViewport(viewport(layout = grid.layout(2, 1)))
vplayout <- function(x, y) 
  viewport(layout.pos.row = x, layout.pos.col = y)
#arrange time series
print(p2, vp = vplayout(1, 1))
print(p1, vp = vplayout(2, 1))
#arrange shadows
print(prects, vp=vplayout(1:2,1))

问题：

x 轴未正确对齐；
阴影位置错误（因为 x 轴排列不正确）。

谷歌搜索后：

我首先注意到“来自 ggExtra 的 align.plots()”可以完成这项工作。但是，它已被作者弃用；
然后我尝试了gglayout solution，但没有运气 - 我什至无法安装“尖端”包；

最后，我使用以下代码尝试了gtable solution：

gp1<- ggplot_gtable(ggplot_build(p1))
gp2<- ggplot_gtable(ggplot_build(p2))
gprects<- ggplot_gtable(ggplot_build(prects))
maxWidth = unit.pmax(gp1$widths[2:3], gp2$widths[2:3], gprects$widths[2:3])
gp1$widths[2:3] <- maxWidth
gp2$widths[2:3] <- maxWidth
gprects$widths[2:3] <- maxWidth
grid.arrange(gp2, gp1, gprects)

现在，上下面板的 x 轴确实对齐了。但影子位置仍然是错误的。更重要的是，我不能在两个时间序列上重叠阴影图。经过几天的尝试，我几乎放弃了……

有人可以帮帮我吗？

【问题讨论】：

这种类型的图你要经常做吗？在我看来，您发布的原件似乎只是有 MS Paint 或其他类似照片编辑软件的叠加层。
你可以把两张图放在一起，用grid包覆盖矩形。
@Brandon：是的，作为一个古气候学专家，经常需要比较几个时间序列并在一个情节上标记有趣的部分。通常，我使用 Golden Software Grapher 来完成这项工作。这很耗时，因为您必须一次又一次地设置如此多的属性。这就是我尝试 R 的原因。@sebastian：非常感谢您提供图片，这真的很有帮助！而且我对 Grid 包不是很熟悉。不管怎样，我一定会试一试的。

标签： r ggplot2

【解决方案1】：

您也可以仅使用基本绘图功能来实现此特定绘图。

#Set alignment for tow plots. Extra zeros are needed to get space for axis at bottom.
layout(matrix(c(0,1,2,0),ncol=1),heights=c(1,3,3,1))

#Set spaces around plot (0 for bottom and top)
par(mar=c(0,5,0,5))

#1. plot
plot(df$V2~df$TIME2,type="l",xlim=c(1000,2000),axes=F,ylab="")

#Two rectangles - y coordinates are larger to ensure that all space is taken  
rect(1100,-15000,1300,15000,col="red",border="red")
rect(1800,-15000,1850,15000,col="red",border="red")

#plot again the same line (to show line over rectangle)
par(new=TRUE)
plot(df$V2~df$TIME2,type="l",xlim=c(1000,2000),axes=F,ylab="")

#set axis
axis(1,at=seq(800,2200,200),labels=NA)
axis(4,at=seq(-15000,10000,5000),las=2)


#The same for plot 2. rev() in ylim= ensures reverse axis.
plot(df$VARIABLE1~df$TIME1,type="l",ylim=rev(range(df$VARIABLE1)+c(-0.1,0.1)),xlim=c(1000,2000),axes=F,ylab="")
rect(1100,-15000,1300,15000,col="red",border="red")
rect(1800,-15000,1850,15000,col="red",border="red")
par(new=TRUE)
plot(df$VARIABLE1~df$TIME1,type="l",ylim=rev(range(df$VARIABLE1)+c(-0.1,0.1)),xlim=c(1000,2000),axes=F,ylab="")
axis(1,at=seq(800,2200,200))
axis(2,at=seq(-6.4,-8.4,-0.4),las=2)

更新 - ggplot2 的解决方案

首先，制作两个包含矩形信息的新数据框。

rect1<- data.frame (xmin=1100, xmax=1300, ymin=-Inf, ymax=Inf)
rect2 <- data.frame (xmin=1800, xmax=1850, ymin=-Inf, ymax=Inf)

修改了您的原始情节代码 - 将 data 和 aes 移至 geom_line() 内部，然后添加了两个 geom_rect() 调用。最重要的部分是theme() 中的plot.margin=。对于每个情节，我将其中一个边距设置为-1 线（p1 的上界和p2 的下界） - 这将确保该情节将加入。所有其他边距应该相同。对于p2，还删除了轴刻度。然后将两个图放在一起。

library(ggplot2)
library(grid)
library(gridExtra)
p1<- ggplot() + geom_line(data=df, aes(TIME1, VARIABLE1)) + 
  scale_y_reverse() + 
  labs(x="AGE") + 
  scale_x_continuous(breaks = seq(1000,2000,200), limits = c(1000,2000)) + 
   geom_rect(data=rect1,aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),alpha=0.1,fill="blue")+
   geom_rect(data=rect2,aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),alpha=0.1,fill="blue")+
   theme(plot.margin = unit(c(-1,0.5,0.5,0.5), "lines"))

p2<- ggplot() + geom_line(data=df, aes(TIME2, V2)) + labs(x=NULL) + 
  scale_x_continuous(breaks = seq(1000,2000,200), limits = c(1000,2000)) + 
  scale_y_continuous(limits=c(-14000,10000))+
  geom_rect(data=rect1,aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),alpha=0.1,fill="blue")+
  geom_rect(data=rect2,aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),alpha=0.1,fill="blue")+
  theme(axis.text.x=element_blank(),
        axis.title.x=element_blank(),
        plot.title=element_blank(),
        axis.ticks.x=element_blank(),
        plot.margin = unit(c(0.5,0.5,-1,0.5), "lines"))


gp1<- ggplot_gtable(ggplot_build(p1))
gp2<- ggplot_gtable(ggplot_build(p2))
maxWidth = unit.pmax(gp1$widths[2:3], gp2$widths[2:3])
gp1$widths[2:3] <- maxWidth
gp2$widths[2:3] <- maxWidth
grid.arrange(gp2, gp1)

【讨论】：

亲爱的 Didzis，非常感谢您的帮助！但是，我仍然想知道是否有任何方法可以使用 ggplot2（网格系统）来做到这一点。非常感谢！
谢谢！我们就快到了。您对视口方法有什么想法或意见吗？
@Didzis：我注意到上面板中的 y 值没有完全显示（缺少 1500 附近的数据）。我知道我可以更改 y 限制来修改它。但是，是否可以控制 y 轴限制并同时使 y 轴反转（在某些情况下是必要的）？非常感谢！
@bearcat 更新了我的解决方案 - 包括上图的 scale_y_continuous() 以确保显示所有值。您也可以在 scale_y_reverse() 内设置限制，只有这些限制也应该是相反的顺序。关于视口，很遗憾我帮不上忙。
@Didzis：非常感谢！干杯！

【解决方案2】：

这是 Didzis 解决方案的一种变体，它保留了中间的 x 轴，并且原则上允许在顶部图中反转 y 轴（但我没有实现）。结果是这个图：

这里是代码。它在底部可能看起来有点复杂，但那是因为我试图将它写得尽可能通用。如果愿意在 gtable 中硬编码适当的单元格位置等，则代码可以短得多。此外，不是通过 gtable 切掉图形的各个部分，而是可以修改主题，这样一开始就不会绘制这些部分。这也可能更短。

require(cowplot)
data <- read.csv("SF_Question.csv")
# create top plot
p2 <- ggplot(data, aes(x=TIME2, y=V2)) + geom_line() + xlim(1000, 2000) +
  ylab("Variable 2") + theme(axis.text.x = element_blank())
# create bottom plot
p1 <- ggplot(data = data, aes(x=TIME1, y=VARIABLE1)) + geom_line() + 
  xlim(1000, 2000) + ylim(-6.4, -8.4) + xlab("Time") + ylab("Variable 1")
# create plot that will hold the shadows
data.shadows <- data.frame(xmin = c(1100, 1800), xmax = c(1300, 1850), ymin = c(0, 0), ymax = c(1, 1))
p.shadows <- ggplot(data.shadows, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax)) + 
  geom_rect(fill='blue', alpha='0.5') +
  xlim(1000, 2000) + scale_y_continuous(limits = c(0, 1), expand = c(0, 0))

# now combine everything via gtable
require(gtable)

# Table g2 will be the top table. We chop off everything below the axis-b
g2 <- ggplotGrob(p2)
index <- subset(g2$layout, name == "axis-b") 
names <- g2$layout$name[g2$layout$t<=index$t]
g2 <- gtable_filter(g2, paste(names, sep="", collapse="|"))
# set height of remaining, empty rows to 0
for (i in (index$t+1):length(g2$heights))
{
  g2$heights[[i]] <- unit(0, "cm")
}

# Table g1 will be the bottom table. We chop off everything above the panel
g1 <- ggplotGrob(p1)
index <- subset(g1$layout, name == "panel") 
# need to work with b here instead of t, to prevent deletion of background
names <- g1$layout$name[g1$layout$b>=index$b]
g1 <- gtable_filter(g1, paste(names, sep="", collapse="|"))
# set height of remaining, empty rows to 0
for (i in 1:(index$b-1))
{
  g1$heights[[i]] <- unit(0, "cm")
}

# bind the two plots together
g.main <- rbind(g2, g1, size='first')

# add the grob that holds the shadows
g.shadows <- gtable_filter(ggplotGrob(p.shadows), "panel") # extract the plot panel containing the shadows
index <- subset(g.main$layout, name == "panel") # locate where we want to insert the shadows
# find the extent of the two panels
t <- min(index$t)
b <- max(index$b)
l <- min(index$l)
r <- max(index$r)
# add grob
g.main <- gtable_add_grob(g.main, g.shadows, t, l, b, r)

# plot is completed, show
grid.newpage()
grid.draw(g.main)

我们可以使用here.所示的方法反转顶部y轴

【讨论】：