web-dev-qa-db-ja.com

facet_wrapプロットに「フローティング」軸ラベルを追加します

this userと同じ問題があります-「ギザギザ」のファセットプロットがあり、一番下の行のパネルが他の行よりも少なく、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))

enter image description here

コメント ここ で、Andrieはgridで手動で実行できることを示唆していますが、それを開始する方法がわかりません。

rggplot2facet-wrap
42
Drew Steen

私の記憶が正しければ、最後の列の下の同じ行にすべてのラベルを追加する方法と、これらの最後のラベルを次の行に持ち上げる方法の両方について質問がありました。したがって、両方の場合の関数は次のとおりです。

編集：これは_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)
}
_

そして、これがどのように見えるかです

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

enter image description here

_facetAdjust(d, "down")
_

enter image description here

編集3：

これは代替ソリューションであり、上記のソリューションも問題ありません。

ggsaveをfacetAdjustと一緒に使用したい場合にいくつかの問題があります。 ggplotのソースコードにはprint(plot)とdefault_name(plot)の2つの部分があるため、ggsaveのクラスのプロットが必要です。ファイル名を手動で（_?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()
  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
_
61
Julius Vainora