双 y 轴和 facet_wrap

Question

How can I put a transformed scale on the right side of a ggplot2? 展示了如何通过操纵 ggplot2 对象并将其与 gtable 合并来在同一个图中添加两个 y 轴。 从那里的示例中，我设法将其扩展为与 facet_wrap 一起使用。请参阅下面的示例。

然而，有三件事并不完美。

1. 天平总是放在最右边。如果能和最后一行的情节联系起来就更好了
2. 如果所有图上分别有 y 轴（即您将 scales="free_y" 放入 facet_wrap），则它不起作用
3. 如果我将网格线保留在（被注释掉的线）中，则第二个绘图的网格线出现在第一个绘图的前面。

如果有解决这些公认的小问题的聪明方法有什么想法吗？

library(ggplot2)
library(gtable)
library(grid)

p1 <- ggplot(diamonds, aes(y=carat,x=price))
p1 <- p1 + geom_point(color="red")
p1 <- p1 + facet_wrap(~ color)
p1 <- p1 + theme_bw()  %+replace%  theme(panel.background = element_rect(fill = NA)) # use white theme and set bg to transparent so they can merge nice
#p1 <- p1 + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) # remove gridlines
p1


p2 <- ggplot(diamonds, aes(x=price))
p2 <- p2 + geom_histogram( binwidth = 1000)
p2 <- p2 +  facet_wrap(~ color)
p2 <- p2 + theme_bw()  %+replace%  theme(panel.background = element_rect(fill = NA))
#p2 <- p2 + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())

p2



## Putting plots together ##################
# extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))

# overlap the panel of 2nd plot on that of 1st plot
pp <- c(subset(g1$layout, grepl("panel",name) , se = t:r))
g <- gtable_add_grob(g1, g2$grobs[grep("panel",g2$layout$name)], pp$t, 
                     pp$l, pp$b, pp$l)



# axis tweaks
ia <- which(grepl("axis_l",g2$layout$name) |  grepl("axis-l",g2$layout$name)     )
ga <- g2$grobs[ia]


axis_idx <- as.numeric(which(sapply(ga,function(x) !is.null(x$children$axis))))

for(i in 1:length(axis_idx)){
  ax <- ga[[axis_idx[i]]]$children$axis
  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[axis_idx[i]], ]$l], length(g$widths) - 1)
  g <- gtable_add_grob(g, ax, pp$t[axis_idx[i]], length(g$widths) - i, pp$b[axis_idx[i]])
}



# Plot!
grid.newpage()
grid.draw(g)

Answer 1

这是一个调整，您应该能够进一步调整到您满意的程度。想出一些更精确和更笼统的东西会比我现在剩下的时间还多。但我认为你可以毫不费力地采取额外的步骤。

前几个步骤不变。

在这里，我复制了前 2 个行面板的过程，而不是在底部添加调整后的轴：

# do not add back the bottom lhs axis
for(i in 1:(length(axis_idx)-1)) {
    ax <- ga[[axis_idx[i]]]$children$axis
    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[axis_idx[i]], ]$l], length(g$widths) - 1)
    g <- gtable_add_grob(g, 
        ax, pp$t[axis_idx[i]], length(g$widths) - i, pp$b[axis_idx[i]])
}

这里我将最下面一行分开处理。这是我没有概括的地方。您需要稍微调整刻度和垂直轴之间的距离。对于底部只有一个图、2 个图等的情况，您还需要概括索引。

# Here I fix the index ``i`` to 3, to cater for your example.
i <- length(axis_idx)
    ax <- ga[[axis_idx[i]]]$children$axis
    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[3], 12)
    g <- gtable_add_grob(g, ax, pp$t[axis_idx[i]], length(g$widths) - 9, pp$b[axis_idx[i]])

需要概括的位是数字 12 和 9。可能需要调整的位是 unit(0.15, "cm") 的行，以获得比目前看起来更多的空间。

首先，g 对象的宽度为 12，即 3 x 3 面板加上 3 个垂直轴。然后添加一列以适应第二个轴，并获得15 的宽度。选择数字 12 位于底部图的 rhs 上。选择数字 9 来放置第二个轴。我想。