r - ggplot2:在绘图顶部添加二次变换的 x 轴

Question

[ 2016 年 4 月编辑:此线程中的解决方案不再正确显示添加的轴 - 关于此问题的新线程已在 ggplot2 2.1.0 broke my code? Secondary transformed axis now appears incorrectly 打开]

我正在处理缩放的 x 数据，并且需要在图的顶部添加一个未缩放的 x 轴以便于解释。我遇到了一种在 How can I put a transformed scale on the right side of a ggplot2? 处添加辅助 y 轴的方法。 .但是，我无法让它在 x 轴上正常工作。我确定我不理解代码的某些部分，但我似乎无法弄清楚它是什么。我试过查看 ggplot2 帮助文件，以及 Wickham 的书 ggplot2: Elegant Graphics For Data Analysis，但如果有人能指点我一些相关文档，我将不胜感激!

我正在处理温度数据，但我将使用上面链接中的湖数据，因为代码是为此编写的。这是该链接的原始代码:

library(ggplot2)
library(gtable)
library(grid)
LakeLevels<-data.frame(Day=c(1:365),Elevation=sin(seq(0,2*pi,2*pi/364))*10+100)
p1 <- ggplot(data=LakeLevels) + geom_line(aes(x=Day,y=Elevation)) + 
      scale_y_continuous(name="Elevation (m)",limits=c(75,125))

p2<-ggplot(data=LakeLevels)+geom_line(aes(x=Day, y=Elevation))+
    scale_y_continuous(name="Elevation (ft)", limits=c(75,125),           
    breaks=c(80,90,100,110,120),
             labels=c("262", "295", "328", "361", "394"))

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

ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)

# draw it
grid.draw(g)

为了测试添加 x 轴而不是 y 轴的方法，我切换了 x 和 y 轴并更改了 axis-l至 axis-b给予:

library(ggplot2)
library(gtable)
library(grid)
LakeLevels<-data.frame(Day=c(1:365),Elevation=sin(seq(0,2*pi,2*pi/364))*10+100)
p1 <- ggplot(data=LakeLevels) + geom_line(aes(x=Elevation,y=Day)) + 
scale_x_continuous(name="Elevation (m)",limits=c(75,125))

p2<-ggplot(data=LakeLevels)+geom_line(aes(x=Elevation, y=Day))+
scale_x_continuous(name="Elevation (ft)", limits=c(75,125),           
                   breaks=c(80,90,100,110,120),
                   labels=c("262", "295", "328", "361", "394"))

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

ia <- which(g2$layout$name == "axis-b")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)

# draw it
grid.draw(g)

这会产生一个新的 x 轴，但有几个问题:
1)它在情节的中间
2)它不会为“海拔(英尺)”生成新的x标签

我需要轴出现在图的顶部，我需要一个关联的轴标签。谁能告诉我我做错了什么？

此外，如上所述，我正在处理缩放温度数据，因此理想情况下，刻度不会像本例中那样在顶部和底部轴上对齐。有什么办法可以在 ggplot2 中做到这一点？ 网络上的一个任意示例是这样的:

Answer 1

问题的根源在于您正在修改列而不是行。

设置，在第二个图的 X 轴上带有缩放标签:

## 'base' plot
p1 <- ggplot(data=LakeLevels) + geom_line(aes(x=Elevation,y=Day)) + 
    scale_x_continuous(name="Elevation (m)",limits=c(75,125))

## 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]]

现在，您需要确保正在修改正确的尺寸。因为新轴是水平的(一行而不是一列)， whatever_grob$heights是要修改以更改给定行中的垂直空间量的向量。如果要添加新空间，请确保添加行而不是列(即使用 gtable_add_rows() )。

如果您正在修改 grobs 本身(在这种情况下，我们正在更改刻度的垂直对齐方式)，请务必修改 y (垂直位置)而不是 x (水平位置)。

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

我会顺便提一下 gtable_show_layout()是一个非常非常方便的功能，用于弄清楚发生了什么。