添加“浮动"facet_wrap 图中的轴标签 [英] add "floating" axis labels in facet_wrap plot

问题描述

我和的评论中，Andrie 建议可以在 grid 中手动完成，但我不知道如何开始.

解决方案

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

因为这就像 print.ggplot 的替代品(见 getAnywhere(print.ggplot))，我添加了一些行以保留功能.

Edit 2: 我已经改进了一点:不再需要指定 nrow 和 ncol，所有面板的绘图都可以也可以打印.

库(网格)# pos - 添加新标签的位置# newpage, vp - 见?print.ggplotfacetAdjust <- function(x, pos = c("up", "down"),newpage = is.null(vp), vp = NULL){# print.ggplot 的一部分ggplot2:::set_last_plot(x)如果(新页面)grid.newpage()pos <- match.arg(pos)p <- ggplot_build(x)gtable <- ggplot_gtable(p)# 寻找维度暗淡 <- apply(p$panel$layout[2:3], 2, max)nrow <- 暗淡[1]ncol <- 暗淡[2]# 图中面板的数量面板 <- sum(grepl("panel", names(gtable$grobs)))空格 <- ncol * nrow# 缺少面板n <- 空格 - 面板# 检查是否需要修改如果(面板！=空间){# 要修复的面板索引idx <- (空格 - ncol - n + 1):(空格 - ncol)# 将最后一个现有面板的 x 轴复制到所选面板# 在上一行gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])if(pos ==向下"){# 如果 pos == down 则将标签向下移动到与# 最后一个面板的 x 轴行 <- grep(paste0("axis_b\-[", idx[1], "-", idx[n], "]"),gtable$layout$name)lastAxis <- grep(paste0("axis_b\-", panel), gtable$layout$name)gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]}}# 再次是print.ggplot的一部分，绘制调整后的版本if(is.null(vp)){grid.draw(gtable)}别的{if (is.character(vp))寻找视口(副总裁)否则推送视口(vp)grid.draw(gtable)向上视口()}隐形(p)}

这是它的样子

d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +xlim(0, 2) + stat_binhex(na.rm = TRUE) + 主题(aspect.ratio = 1) +facet_wrap(~颜色)facetAdjust(d)

facetAdjust(d, "down")

编辑 3:

这是另一种解决方案，上面的也可以.

当您想将 ggsave 与 facetAdjust 一起使用时，会出现一些问题.由于ggsave的源代码中有两部分:print(plot)和default_name(plot) 如果没有手动提供文件名(根据 ?ggsave 似乎它不应该工作，但是).因此，给定文件名，有一种解决方法(在某些情况下可能会产生副作用):

首先我们考虑实现浮动轴主要效果的分离函数.通常，它会返回一个 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()暗淡 <- apply(p$panel$layout[2:3], 2, max)nrow <- 暗淡[1]ncol <- 暗淡[2]面板 <- sum(grepl("panel", names(gtable$grobs)))空格 <- ncol * nrown <- 空格 - 面板如果(面板！=空间){idx <- (空格 - ncol - n + 1):(空格 - ncol)gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])if(pos ==向下"){行 <- grep(paste0("axis_b\-[", idx[1], "-", idx[n], "]"),gtable$layout$name)lastAxis <- grep(paste0("axis_b\-", panel), gtable$layout$name)gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]}}class(gtable) <- c("facetAdjust", "gtable", "ggplot");表}

打印函数与ggplot2:::print.ggplot:

只有几行不同

print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) {如果(新页面)grid.newpage()if(is.null(vp)){网格绘制(x)} 别的 {if (is.character(vp))寻找视口(副总裁)否则推送视口(vp)网格绘制(x)向上视口()}隐形(x)}

示例:

d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +xlim(0, 2) + stat_binhex(na.rm = TRUE) + 主题(aspect.ratio = 1) +facet_wrap(~颜色)p <- facetAdjust(d) # 无输出print(p) # 与旧版本 facetAdjust() 的输出相同ggsave("name.pdf", p) # 有效，需要文件名

I have the same problem as this user - I have a 'jagged' faceted plot, in which the bottom row has fewer panels than the other rows, and I would like to have x-axis ticks on the bottom of each column.

The suggested solution for that problem was to set scales="free_x". (In ggplot 0.9.2.1; I believe the behavior I'm looking for was default in earlier versions.) That's a poor solution in my case: my actual axis labels will be rather long, so putting them under each row will occupy too much room. The results are something like this:

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

In a comment here, Andrie suggests that it can be done manually in grid but I have no idea how to get started on that.

解决方案

If I remember right, there were questions on both how to add all labels to the same line under the last column and how to lift these last labels up to the next row. So here is the function for both cases:

Edit: since this is like a substitute for print.ggplot (see getAnywhere(print.ggplot)) I have added some lines from it to preserve functionality.

Edit 2: I have improved it a bit more: no need to specify nrow and ncol anymore, plots with all the panels can be printed too.

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

And here is how it looks

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

Edit 3:

This is an alternative solution, the one above is fine as well.

There are some issues when one wants to use ggsave together with facetAdjust. A plot of class of ggplot is required because of two parts in the source code of ggsave: print(plot) and default_name(plot) in case one does not provide a filename manually (according to ?ggsave it seems that it is not supposed to work, though). Hence, given a filename, there is a workaround (possibly with side effects in some cases):

First, let us consider the separate function that achieves the main effect of floating axis. Normally, it would return a gtable object, however we use class(gtable) <- c("facetAdjust", "gtable", "ggplot"). In this way, it is allowed to use ggsave and print(plot) works as required (see below for 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
}

The function for printing which differs only by few lines from 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)
}

Example:

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

这篇关于添加“浮动"facet_wrap 图中的轴标签的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！