在facet_wrap情节加上“浮动”轴标签(add “floating” axis labels

2019-06-21 01:01发布

我也有同样的问题,因为这个用户- I有一个“锯齿状”刻面积,其中,所述底部行具有比其它行少的面板,我想有x轴蜱每列的底部。

对于此问题建议的解决方案是设置scales="free_x" 。 (在ggplot 0.9.2.1,我相信我在寻找早期版本是默认的行为),这是在我的情况较差的解决方案:我的实际轴标签将是相当长的,所以把他们每一行下会占用太多房间。 结果是这样的:

 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))

在评论在这里 ,Andrie表明,它可以在手动完成grid ,但我不知道如何让开始的。

Answer 1:

如果我没记错的话,有两个如何将所有的标签添加到同一行的最后一栏下,如何解除这些最后标签到下一行的问题。 因此,这里是这两种情况的功能:

编辑:由于这是像一个替代print.ggplot (见getAnywhere(print.ggplot)我已经添加了从它的一些线路保护功能。

编辑2:我已经改善多一点:无需指定nrowncol所有的面板了,地块可得打印。

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:

这是一种替代解决方案,上面的一个是细为好。

有一些问题,当一个人想使用ggsave连同facetAdjust 。 类的的曲线ggplot是必需的因为两个部分中的源代码ggsaveprint(plot)default_name(plot)的情况下,一个没有手动提供(根据文件名?ggsave它似乎是不应该工作,虽然)。 因此,给定一个文件名,有一种解决方法(可能在某些情况下的副作用):

首先,让我们考虑单独的函数的实现浮动轴的重要作用。 通常情况下,它会返回一个gtable对象,但是我们使用class(gtable) <- c("facetAdjust", "gtable", "ggplot") 通过这种方式,它允许使用ggsaveprint(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
}

仅通过从几行不同的打印功能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


文章来源: add “floating” axis labels in facet_wrap plot