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

Question

[ 编辑2016年4月:此线程中的解决方案不再正确显示添加的轴 - 此问题的新线程已在ggplot2打开2.1.0打破了我的代码？二次变换轴现在显示不正确 ]

我正在使用缩放的x数据,并且需要在绘图顶部添加一个未缩放的x轴以便于解释.我遇到了一个添加辅助y轴的方法我如何在ggplot2的右侧放置一个转换后的比例？.但是,我无法让它在x轴上正常工作.我确定我不理解代码的某些部分,但我似乎无法弄清楚它是什么.我已经尝试过查看ggplot2帮助文件,以及Wickham书籍ggplot2:数据分析的优雅图形,但如果有人能指出我的一些相关文档,我会非常感激!

我正在使用温度数据,但是我将使用上面链接中的湖泊数据作为代码.以下是该链接的原始代码:

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的中间2)它不会为"Elevation(ft)"生成新的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()).

如果你自己修改凹凸(在这种情况下我们正在改变刻度的垂直对齐),一定要修改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()是一个非常非常方便的功能,用于弄清楚发生了什么.