[解決済み] ggplot2 で、ファセット化されたプロットの空のファセットに凡例をシフトさせる

質問

次のようなプロットを考えてみよう。

library(ggplot2)

p <- ggplot(diamonds, 
            aes(x = carat, fill = cut)) +
  geom_density(position = "stack") +
  facet_wrap(~ color)

この facet_wrap 関数は、一連のファセット化されたパネルを、ほぼ長方形の表示である nrow の行と ncol の列で構成される。しかし、データによっては、実際のコマ数は、数コマ足りないことが多く nrow * ncol に満たないことが多く、プロットに無駄なスペースが残ってしまいます。

プロットに凡例が含まれている場合、状況は悪化します。凡例のためにさらに多くの無駄なスペースがあり、それが右側 (凡例のデフォルト位置) であろうと、他の3方向のうちの1つであろうと、凡例があるためです。

スペースを節約するために、未記入のファセットによって作られたスペースに凡例を移動させたいと思います。

以下はスペース節約策として機能しますが、凡例はプロット領域の隅に固定され、潜在的に多くのスペースが片側に残され、アンバランスな外観を作り出します。

p +
  theme(legend.position = c(1, 0),
        legend.justification = c(1, 0))

を手動で調整することにより、空白領域の中心に向かって凡例を移動させる。 legend.position / legend.justification の値は試行錯誤の問題であり、作業するために多くのファセットプロットを持っている場合、スケールするのが困難です。

要約すると、私は以下のようなメソッドを求めています。

1. ファセット化されたプロットの凡例をシフトする を空のファセットのために作られたスペースに移動します。
2. 結果は になります。 プロットになります。
3. は簡単に 自動化 で、多くのプロットを処理できます。

これは私にとって繰り返し使用するケースであり、他の誰かが役に立つと思うので、私の作業ソリューションと一緒にここに投稿することにしました。私はこのシナリオを見たことがありません。 質問された/回答された Stack Overflow の他の場所でこのシナリオを見たことがありません。もし知っている人がいたら、コメントを残してください。喜んで代わりに回答するか、場合によってはこれを重複としてマークしてもらいます。

どのように解決するのですか?

に対して書いた回答の延長線上にあるものです。 前の質問 に対して書いた答えの拡張版です。

基本的に、私は ggplot/grob で変換されたオブジェクトを ggplotGrob() によって変換され、それが一つでなければgrobに変換し、空のスペースに対応するセルに凡例grobを移動するために基礎となるgrobに掘り下げます。

機能 :

library(gtable)
library(cowplot)

shift_legend <- function(p){

  # check if p is a valid object
  if(!"gtable" %in% class(p)){
    if("ggplot" %in% class(p)){
      gp <- ggplotGrob(p) # convert to grob
    } else {
      message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
      return(p)
    }
  } else {
    gp <- p
  }

  # check for unfilled facet panels
  facet.panels <- grep("^panel", gp[["layout"]][["name"]])
  empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
  empty.facet.panels <- facet.panels[empty.facet.panels]
  if(length(empty.facet.panels) == 0){
    message("There are no unfilled facet panels to shift legend into. Returning original plot.")
    return(p)
  }

  # establish extent of unfilled facet panels (including any axis cells in between)
  empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
  empty.facet.panels <- list(min(empty.facet.panels[["t"]]), min(empty.facet.panels[["l"]]),
                             max(empty.facet.panels[["b"]]), max(empty.facet.panels[["r"]]))
  names(empty.facet.panels) <- c("t", "l", "b", "r")

  # extract legend & copy over to location of unfilled facet panels
  guide.grob <- which(gp[["layout"]][["name"]] == "guide-box")
  if(length(guide.grob) == 0){
    message("There is no legend present. Returning original plot.")
    return(p)
  }
  gp <- gtable_add_grob(x = gp,
                        grobs = gp[["grobs"]][[guide.grob]],
                        t = empty.facet.panels[["t"]],
                        l = empty.facet.panels[["l"]],
                        b = empty.facet.panels[["b"]],
                        r = empty.facet.panels[["r"]],
                        name = "new-guide-box")

  # squash the original guide box's row / column (whichever applicable)
  # & empty its cell
  guide.grob <- gp[["layout"]][guide.grob, ]
  if(guide.grob[["l"]] == guide.grob[["r"]]){
    gp <- gtable_squash_cols(gp, cols = guide.grob[["l"]])
  }
  if(guide.grob[["t"]] == guide.grob[["b"]]){
    gp <- gtable_squash_rows(gp, rows = guide.grob[["t"]])
  }
  gp <- gtable_remove_grobs(gp, "guide-box")

  return(gp)
}

結果 :

library(grid)

grid.draw(shift_legend(p))

空いたスペースの方向を利用して凡例を水平に並べると、より見栄えの良い結果になります。

p.new <- p +
  guides(fill = guide_legend(title.position = "top",
                             label.position = "bottom",
                             nrow = 1)) +
  theme(legend.direction = "horizontal")
grid.draw(shift_legend(p.new))

他の例もあります。

# example 1: 1 empty panel, 1 vertical legend
p1 <- ggplot(economics_long, 
             aes(date, value, color = variable)) +
  geom_line() +
  facet_wrap(~ variable, 
             scales = "free_y", nrow = 2, 
             strip.position = "bottom") +
  theme(strip.background = element_blank(), 
        strip.placement = "outside")
grid.draw(shift_legend(p1))

# example 2: 2 empty panels (vertically aligned) & 2 vertical legends side by side
p2 <- ggplot(mpg,
             aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
  geom_point(size = 3) +
  facet_wrap(~ class, dir = "v") +
  theme(legend.box = "horizontal")
grid.draw(shift_legend(p2))

# example 3: facets in polar coordinates
p3 <- ggplot(mtcars, 
             aes(x = factor(1), fill = factor(cyl))) +
  geom_bar(width = 1, position = "fill") + 
  facet_wrap(~ gear, nrow = 2) +
  coord_polar(theta = "y") +
  theme_void()
grid.draw(shift_legend(p3))