在facet_wrap图中添加“浮动”轴标签
我与这个用户有同样的问题 – 我有一个“锯齿状”的小平面图，其中最下面一排的面板比其他行less，我希望每列的底部都有x轴刻度。
build议的解决scheme是设置scales="free_x" 。 （在ggplot 0.9.2.1;我相信我所寻找的行为在早期版本中是默认的）。在我的情况下，这是一个糟糕的解决scheme：我的实际轴标签将会相当长，所以把它们放在每一行下方将占用太多房间。 结果是这样的：
x <- gl(3, 1, 15, labels=paste("this is a very long axis label ", letters[1:5])) y <- rnorm(length(x)) l <- gl(5, 3, 15) d <- data.frame(x=x, y=y, l=l) ggplot(d, aes(x=x, y=y)) + geom_point() + facet_wrap(~l, scales="free_x") + theme(axis.text.x=element_text(angle=90, hjust=1))
在这里的评论中，Andriebuild议可以通过grid手动完成，但我不知道如何开始。
如果我没有记错的话，那么如何将所有标签添加到最后一列下面的同一行以及如何将最后一个标签提升到下一行，都是有问题的。 所以这里是这两种情况下的function：
编辑：因为这就像是一个替代print.ggplot （见getAnywhere(print.ggplot) ）我已经添加了一些行来保存function。
编辑2：我改进了一点：不需要再指定nrow和nrow ，也可以打印所有面板的graphics。
library(grid) # pos - where to add new labels # newpage, vp - see ?print.ggplot facetAdjust <- function(x, pos = c("up", "down"), newpage = is.null(vp), vp = NULL) { # part of print.ggplot ggplot2:::set_last_plot(x) if(newpage) grid.newpage() pos <- match.arg(pos) p <- ggplot_build(x) gtable <- ggplot_gtable(p) # finding dimensions dims <- apply(p$panel$layout[2:3], 2, max) nrow <- dims[1] ncol <- dims[2] # number of panels in the plot panels <- sum(grepl("panel", names(gtable$grobs))) space <- ncol * nrow # missing panels n <- space - panels # checking whether modifications are needed if(panels != space){ # indices of panels to fix idx <- (space - ncol - n + 1):(space - ncol) # copying x-axis of the last existing panel to the chosen panels # in the row above gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]]) if(pos == "down"){ # if pos == down then shifting labels down to the same level as # the x-axis of last panel rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"), gtable$layout$name) lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name) gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")] } } # again part of print.ggplot, plotting adjusted version if(is.null(vp)){ grid.draw(gtable) } else{ if (is.character(vp)) seekViewport(vp) else pushViewport(vp) grid.draw(gtable) upViewport() } invisible(p) }
这是它的外观
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) + xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) + facet_wrap(~ color) facetAdjust(d)
facetAdjust(d, "down")
编辑3：
这是一个替代解决scheme，上面的也是好的。
当想要使用ggsave和facetAdjust时，有一些问题。 由于ggplot的源代码中有两部分： print(plot)和default_name(plot) ，所以需要ggplot类的一个图，以防手动提供文件名（根据?ggsave ，似乎不应该工作，虽然）。 因此，给定一个文件名，有一个解决方法（在某些情况下可能带有副作用）：
首先，让我们考虑实现浮动轴的主要效果的分离function。 通常，它会返回一个gtable对象，但是我们使用class(gtable) <- c("facetAdjust", "gtable", "ggplot") 。 通过这种方式，可以根据需要使用ggsave和print(plot)工作（参见下面的print.facetAdjust ）
facetAdjust <- function(x, pos = c("up", "down")) { pos <- match.arg(pos) p <- ggplot_build(x) gtable <- ggplot_gtable(p); dev.off() dims <- apply(p$panel$layout[2:3], 2, max) nrow <- dims[1] ncol <- dims[2] panels <- sum(grepl("panel", names(gtable$grobs))) space <- ncol * nrow n <- space - panels if(panels != space){ idx <- (space - ncol - n + 1):(space - ncol) gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]]) if(pos == "down"){ rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"), gtable$layout$name) lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name) gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")] } } class(gtable) <- c("facetAdjust", "gtable", "ggplot"); gtable }
打印的function与ggplot2:::print.ggplot只有几行不同：
print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) { if(newpage) grid.newpage() if(is.null(vp)){ grid.draw(x) } else { if (is.character(vp)) seekViewport(vp) else pushViewport(vp) grid.draw(x) upViewport() } invisible(x) }
例：
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) + xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) + facet_wrap(~ color) p <- facetAdjust(d) # No output print(p) # The same output as with the old version of facetAdjust() ggsave("name.pdf", p) # Works, a filename is necessary
