在How can I put a transformed scale on the right side of a ggplot2?,展示了如何通过操纵和将ggplot2对象与gtable合并在同一图中添加两个y轴。 从示例中我设法扩展它以使用facet_wrap。请参阅下面的示例。
然而,有三件事并不完美。scales="free_y"
放入facet_wrap
)如果有一种聪明的方法可以解决这些小问题吗?
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)
答案 0 :(得分: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乘3面板加3个垂直轴。然后添加一列以满足第二个轴的要求,并获得15
的宽度。数字12选择在底部图的rhs上。选择数字9以将第二轴放置在那里。我想。