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()是一個非常非常方便的函數，用於確定發生了什么。

Answer 2

您可以使用sec_axis或dup_axis 。

library(ggplot2)

ggplot(mtcars, aes(x=disp, y=mpg, color=as.factor(cyl))) +
  geom_point() +
  labs(x="displacement (cubic inches)", col="# of cylinders") +
  scale_x_continuous(sec.axis=sec_axis(trans=~ . * 0.0163871, name="displacement (L)"))

ggplot2版本3.1.1