R 加上「;浮动;面_包裹图中的轴标签

R 加上「;浮动;面_包裹图中的轴标签,r,ggplot2,facet-wrap,R,Ggplot2,Facet Wrap,我和用户有同样的问题——我有一个“锯齿状”平面图,其中底行的面板比其他行少,我希望在每列的底部有x轴记号 该问题的建议解决方案是设置scales=“free\u x”。(在ggplot 0.9.2.1中;我相信我正在寻找的行为在早期版本中是默认的。)在我的情况下,这是一个糟糕的解决方案:我的实际轴标签将相当长,因此将它们放在每行下面将占用太多的空间。结果如下: x <- gl(3, 1, 15, labels=paste("this is a very long axis label "

我和用户有同样的问题——我有一个“锯齿状”平面图,其中底行的面板比其他行少,我希望在每列的底部有x轴记号

该问题的建议解决方案是设置
scales=“free\u 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))

x如果我没记错的话,关于如何将所有标签添加到最后一列下的同一行,以及如何将这些最后的标签提升到下一行都有问题。这是两种情况下的函数:

编辑:因为这就像是
print.ggplot
的替代品(请参见
getAnywhere(print.ggplot)
),我从中添加了一些行以保留功能

编辑2:我对它做了更多改进:不再需要指定
nrow
ncol
,也可以打印包含所有面板的绘图

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

编辑3:

这是一个替代方案,上面的方案也不错

如果要将
ggsave
facetajust
一起使用,会出现一些问题。需要使用
ggplot
类的绘图,因为
ggsave
的源代码中有两个部分:
print(plot)
default_name(plot)
,如果不手动提供文件名(根据
?ggsave
,它似乎不应该工作)。因此,给定一个文件名,有一个解决方法(在某些情况下可能有副作用):


首先,让我们考虑实现浮轴主要作用的分离函数。通常,它将返回一个

gtable
对象,但是我们使用
class(gtable)是这样吗?:您希望在面板的底部行上仅具有x轴标签,并且希望这些标签延伸到第二行第三列的空面板空间中。该问题现在已在ggplot2的开发版本中修复。参见ggplot2第1607期:非常好!你应该等一天,我本来要悬赏的。@DrewSteen,哎哟。。嗯,我会把这个函数看作是一个赏金。我肯定会自己用的。@Julius,这太神奇了!谢谢你。你不能让哈德利在ggplot2中添加这个功能吗?我想很多人都希望这样……我在github.com/hadley/ggplot2上发布了一个问题:。现已在ggplot2的开发版本中修复。我将在上面的问题下方发表这篇评论。
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")
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
}
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