ggplot2 2.1.0破坏了我的代码？现在，辅助变换轴显示不正确
前一段时间，我询问是否要在ggplot中添加辅助变换的x轴，Nate Pope提供了ggplot2中描述的出色解决方案：在plot顶部添加辅助变换的x轴。
该解决方案对我来说非常有效，我又返回了它，希望它可以用于新项目。不幸的是，该解决方案在ggplot2的最新版本中无法正常工作。现在，运行完全相同的代码将导致轴标题“剪切”，以及刻度线和标签重叠。这是一个示例，问题以蓝色突出显示：
可以使用以下代码来复制此示例（这是Nate Pope以前工作出色的代码的精确副本）：
library(ggplot2)
library(gtable)
library(grid)
LakeLevels<-data.frame(Day=c(1:365),Elevation=sin(seq(0,2*pi,2*pi/364))*10+100)
## 'base' plot
p1 <- ggplot(data=LakeLevels) + geom_line(aes(x=Elevation,y=Day)) +
scale_x_continuous(name="Elevation (m)",limits=c(75,125)) +
ggtitle("stuff") +
theme(legend.position="none", plot.title=element_text(hjust=0.94, margin = margin(t = 20, b = -20)))
## plot with "transformed" axis
p2<-ggplot(data=LakeLevels)+geom_line(aes(x=Elevation, y=Day))+
scale_x_continuous(name="Elevation (ft)", limits=c(75,125),
breaks=c(90,101,120),
labels=round(c(90,101,120)*3.24084) ## labels convert to feet
)
## extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
## overlap the panel of the 2nd plot on that of the 1st plot
pp <- c(subset(g1$layout, name=="panel", se=t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name=="panel")]], pp$t, pp$l, pp$b,
pp$l)
g <- gtable_add_grob(g1, g1$grobs[[which(g1$layout$name=="panel")]], pp$t, pp$l, pp$b, pp$l)
## steal axis from second plot and modify
ia <- which(g2$layout$name == "axis-b")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
## switch position of ticks and labels
ax$heights <- rev(ax$heights)
ax$grobs <- rev(ax$grobs)
ax$grobs[[2]]$y <- ax$grobs[[2]]$y - unit(1, "npc") + unit(0.15, "cm")
## modify existing row to be tall enough for axis
g$heights[[2]] <- g$heights[g2$layout[ia,]$t]
## add new axis
g <- gtable_add_grob(g, ax, 2, 4, 2, 4)
## add new row for upper axis label
g <- gtable_add_rows(g, g2$heights[1], 1)
g <- gtable_add_grob(g, g2$grob[[6]], 2, 4, 2, 4)
# draw it
grid.draw(g)
运行上面的代码会导致两个关键问题，我正在尝试解决这些问题：
1）如何调整添加到图顶部的x轴，以解决“剪切”和重叠的问题？
2）如何将ggtitle("stuff")添加到p1最终绘图中的第一个绘图中？
我一直在努力解决所有问题，但似乎无法解决。任何帮助深表感谢。谢谢！
更新到 ggplot2 v 2.2.1，但更易于使用sec.axis- 请参阅此处
原来的
ggplot2从版本 2.1.0 开始，移动轴变得更加复杂。此解决方案借鉴了旧解决方案和cowplot包中的代码。
关于你的第二个问题，为“Stuff”标题构建一个单独的文本grob（而不是处理ggtitle它的边距）更容易。
library(ggplot2) #v 2.2.1
library(gtable) #v 0.2.0
library(grid)
LakeLevels <- data.frame(Day = c(1:365), Elevation = sin(seq(0, 2*pi, 2 * pi/364)) * 10 + 100)
## 'base' plot
p1 <- ggplot(data = LakeLevels) +
geom_path(aes(x = Elevation, y = Day)) +
scale_x_continuous(name = "Elevation (m)", limits = c(75, 125)) +
theme_bw()
## plot with "transformed" axis
p2 <- ggplot(data = LakeLevels) +
geom_path(aes(x = Elevation, y = Day))+
scale_x_continuous(name = "Elevation (ft)", limits = c(75, 125),
breaks = c(80, 90, 100, 110, 120),
labels = round(c(80, 90, 100, 110, 120) * 3.28084)) + ## labels convert to feet
theme_bw()
## Get gtable
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
## Get the position of the plot panel in g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Title grobs have margins.
# The margins need to be swapped.
# Function to swap margins -
# taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
vinvert_title_grob <- function(grob) {
heights <- grob$heights
grob$heights[1] <- heights[3]
grob$heights[3] <- heights[1]
grob$vp[[1]]$layout$heights[1] <- heights[3]
grob$vp[[1]]$layout$heights[3] <- heights[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$y <- unit(1, "npc") - grob$children[[1]]$y
grob
}
# Copy "Elevation (ft)" xlab from g2 and swap margins
index <- which(g2$layout$name == "xlab-b")
xlab <- g2$grobs[[index]]
xlab <- vinvert_title_grob(xlab)
# Put xlab at the top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t-1)
g1 <- gtable_add_grob(g1, xlab, pp$t, pp$l, pp$t, pp$r, clip = "off", name="topxlab")
# Get "feet" axis (axis line, tick marks and tick mark labels) from g2
index <- which(g2$layout$name == "axis-b")
xaxis <- g2$grobs[[index]]
# Move the axis line to the bottom (Not needed in your example)
xaxis$children[[1]]$y <- unit.c(unit(0, "npc"), unit(0, "npc"))
# Swap axis ticks and tick mark labels
ticks <- xaxis$children[[2]]
ticks$heights <- rev(ticks$heights)
ticks$grobs <- rev(ticks$grobs)
# Move tick marks
ticks$grobs[[2]]$y <- ticks$grobs[[2]]$y - unit(1, "npc") + unit(3, "pt")
# Sswap tick mark labels' margins
ticks$grobs[[1]] <- vinvert_title_grob(ticks$grobs[[1]])
# Put ticks and tick mark labels back into xaxis
xaxis$children[[2]] <- ticks
# Add axis to top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t)
g1 <- gtable_add_grob(g1, xaxis, pp$t+1, pp$l, pp$t+1, pp$r, clip = "off", name = "axis-t")
# Add "Stuff" title
titleGrob = textGrob("Stuff", x = 0.9, y = 0.95, gp = gpar(cex = 1.5, fontface = "bold"))
g1 <- gtable_add_grob(g1, titleGrob, pp$t+2, pp$l, pp$t+2, pp$r, name = "Title")
# Draw it
grid.newpage()
grid.draw(g1)
经过一番思考，我确认问题 #1 源于对最新版本 ggplot2 的更改，并且我还提出了一个临时解决方法 - 安装旧版本的 ggplot2。
在安装旧版本的 R 软件包以安装 ggplot2 1.0.0之后，我使用安装了 ggplot2 1.0.0
packageurl <- "http://cran.r-project.org/src/contrib/Archive/ggplot2/ggplot2_1.0.0.tar.gz"
install.packages(packageurl, repos=NULL, type="source")
我用它验证了
packageDescription("ggplot2")$Version
然后，重新运行上面发布的确切代码，我能够生成一个绘图，其中添加的 x 轴正确显示：
这显然不是一个非常令人满意的答案，但至少在比我更聪明的人能够解释为什么这种方法在最新版本的 ggplot2 中不起作用之前它是有效的。:)
所以上面的问题 #1 已经解决了。 我仍然没有解决上面的问题#2，所以希望对此有任何见解。