web-dev-qa-db-ja.com

長い凡例タイトルの場合、ggplot2で凡例タイトルと凡例キーを中央揃えにします

凡例のタイトルが長い場合、凡例のタイトルを凡例のキーに対して中央揃えにするのに苦労しています。 1年前 からの質問があります。短いタイトルでは機能しますが、長いタイトルでは機能しないようです。

例、最初に短い凡例のタイトル：

library(ggplot2)
ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width, color=Petal.Width)) + geom_point(size = 3) +
  scale_color_distiller(palette = "YlGn", type = "seq", direction = -1,
                        name = "A") +
  theme(legend.title.align = 0.5)

enter image description here

すべてが期待どおりで、凡例タイトルは凡例キーの上に中央揃えされます。

これで、長い凡例のタイトルが同じになります。

ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width, color=Petal.Width)) + geom_point(size = 3) +
  scale_color_distiller(palette = "YlGn", type = "seq", direction = -1,
                        name = "Long legend heading\nShould be centered") +
  theme(legend.title.align = 0.5)

enter image description here

テキストが中央揃えで配置されているが、凡例キーに対しては配置されていないことがわかります。私はlegend.justification = "center"などの他のテーマオプションを変更しようとしましたが、凡例ボックスの左端の位置からキーを移動するようには見えません。

いくつかのコメント：

  • 数日前から開発バージョンのggplot2、v2.2.1.9000を実行しています。

  • 特に、継続的なカラースケールパレットのソリューションが必要です。

rggplot2r-gridgtable
12
Claus Wilke

2019年10月4日更新：

しばらく前に、ほぼ2年前にここに投稿した元のアイデアに基づいて、かなり一般的な関数を書きました。関数はgithub here にありますが、公式に公開されたパッケージの一部ではありません。次のように定義されます。

align_legend <- function(p, hjust = 0.5)
{
  # extract legend
  g <- cowplot::plot_to_gtable(p)
  grobs <- g$grobs
  legend_index <- which(sapply(grobs, function(x) x$name) == "guide-box")
  legend <- grobs[[legend_index]]

  # extract guides table
  guides_index <- which(sapply(legend$grobs, function(x) x$name) == "layout")

  # there can be multiple guides within one legend box  
  for (gi in guides_index) {
    guides <- legend$grobs[[gi]]

    # add extra column for spacing
    # guides$width[5] is the extra spacing from the end of the legend text
    # to the end of the legend title. If we instead distribute it by `hjust:(1-hjust)` on
    # both sides, we get an aligned legend
    spacing <- guides$width[5]
    guides <- gtable::gtable_add_cols(guides, hjust*spacing, 1)
    guides$widths[6] <- (1-hjust)*spacing
    title_index <- guides$layout$name == "title"
    guides$layout$l[title_index] <- 2

    # reconstruct guides and write back
    legend$grobs[[gi]] <- guides
  }

  # reconstruct legend and write back
  g$grobs[[legend_index]] <- legend
  g
}

関数は非常に柔軟で一般的です。以下に、使用例をいくつか示します。

library(ggplot2)
library(cowplot)
#> 
#> ********************************************************
#> Note: As of version 1.0.0, cowplot does not change the
#>   default ggplot2 theme anymore. To recover the previous
#>   behavior, execute:
#>   theme_set(theme_cowplot())
#> ********************************************************
library(colorspace)

# single legend
p <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Petal.Width)) + geom_point()
ggdraw(align_legend(p)) # centered


ggdraw(align_legend(p, hjust = 1)) # right aligned


# multiple legends
p2 <- ggplot(mtcars, aes(disp, mpg, fill = hp, shape = factor(cyl), size = wt)) + 
   geom_point(color = "white") +
   scale_shape_manual(values = c(23, 24, 21), name = "cylinders") +
   scale_fill_continuous_sequential(palette = "Emrld", name = "power (hp)", breaks = c(100, 200, 300)) +
   xlab("displacement (cu. in.)") +
   ylab("fuel efficiency (mpg)") +
   guides(
     shape = guide_legend(override.aes = list(size = 4, fill = "#329D84")),
     size = guide_legend(
       override.aes = list(shape = 21, fill = "#329D84"),
       title = "weight (1000 lbs)")
     ) +
   theme_half_open() + background_grid()

# works but maybe not the expected result
ggdraw(align_legend(p2))


# more sensible layout
ggdraw(align_legend(p2 + theme(legend.position = "top", legend.direction = "vertical")))

2019-10-04に reprexパッケージ （v0.3.0）によって作成されました

元の答え：

解決策を見つけました。いくつかのグロブツリーを掘り下げる必要があり、複数の凡例がある場合は機能しない可能性がありますが、それ以外の場合は、より良いものが見つかるまでこれは合理的な解決策のようです。

library(ggplot2)
library(gtable)
library(grid)

p <- ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width, color=Petal.Width)) + 
  geom_point(size = 3) +
  scale_color_distiller(palette = "YlGn", type = "seq", direction = -1,
                        name = "Long legend heading\nShould be centered") +
  theme(legend.title.align = 0.5)

# extract legend
g <- ggplotGrob(p)
grobs <- g$grobs
legend_index <- which(sapply(grobs, function(x) x$name) == "guide-box")
legend <- grobs[[legend_index]]

# extract guides table
guides_index <- which(sapply(legend$grobs, function(x) x$name) == "layout")
guides <- legend$grobs[[guides_index]]

# add extra column for spacing
# guides$width[5] is the extra spacing from the end of the legend text
# to the end of the legend title. If we instead distribute it 50:50 on
# both sides, we get a centered legend
guides <- gtable_add_cols(guides, 0.5*guides$width[5], 1)
guides$widths[6] <- guides$widths[2]
title_index <- guides$layout$name == "title"
guides$layout$l[title_index] <- 2

# reconstruct legend and write back
legend$grobs[[guides_index]] <- guides
g$grobs[[legend_index]] <- legend

grid.newpage()
grid.draw(g)

enter image description here

11
Claus Wilke

上記のコメントの1つでbaptisteによって説明された方法と同様にソースコードをハッキングしました：カラーバー/ラベル/目盛りを子gtableに入れ、同じ行スパン/列スパンを持つように配置します（凡例に応じて）方向）タイトルとして。

それはまだハックですが、プロットごとに手動で手順を繰り返す必要がなく、「セッション全体で一度だけハックする」アプローチと考えたいです。

タイトルの幅/タイトルの位置/凡例の方向が異なるデモ：

plot.demo <- function(title.width = 20,
                      title.position = "top",
                      legend.direction = "vertical"){
  ggplot(iris, 
         aes(x=Sepal.Length, y=Sepal.Width, color=Petal.Width)) + 
    geom_point(size = 3) +
    scale_color_distiller(palette = "YlGn",
                          name = stringr::str_wrap("Long legend heading should be centered",
                                                   width = title.width), 
                          guide = guide_colourbar(title.position = title.position),
                          direction = -1) +
    theme(legend.title.align = 0.5,
          legend.direction = legend.direction)
}

cowplot::plot_grid(plot.demo(),
                   plot.demo(title.position = "left"),
                   plot.demo(title.position = "bottom"),
                   plot.demo(title.width = 10, title.position = "right"),
                   plot.demo(title.width = 50, legend.direction = "horizontal"),
                   plot.demo(title.width = 10, legend.direction = "horizontal"),
                   ncol = 2)

demo 1

これは、複数のカラーバーの凡例でも機能します。

ggplot(iris, 
       aes(x=Sepal.Length, y=Sepal.Width, 
           color=Petal.Width, fill = Petal.Width)) + 
  geom_point(size = 3, shape = 21) +
  scale_color_distiller(palette = "YlGn",
                        name = stringr::str_wrap("Long legend heading should be centered",
                                                 width = 20),
                        guide = guide_colourbar(title.position = "top"),
                        direction = -1) +
  scale_fill_distiller(palette = "RdYlBu",
                       name = stringr::str_wrap("A different heading of different length",
                                                width = 40),
                       direction = 1) +
  theme(legend.title.align = 0.5,
        legend.direction = "vertical",
        legend.box.just = "center")

（注意：2つの凡例を適切に配置するにはlegend.box.just = "center"が必要です。現在、許容できるパラメーター値として「上」、「下」、「左」、「右」しかリストされていないため、しばらく心配でしたが、しかし、基になるgrid::valid.justによって、 "center"/"centre"の両方も受け入れられることがわかります。これが?themeヘルプファイルに明示的に記載されていない理由はわかりませんが、それでも、動作します。）

demo 2

ソースコードを変更するには、次のコマンドを実行します。

trace(ggplot2:::guide_gengrob.colorbar, edit = TRUE)

そして、コードの最後のセクションを次のように変更します。

  gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, 
    "cm"))
  ... # omitted
  gt
}

これに：

  # create legend gtable & add background / legend title grobs as before (this part is unchanged)
  gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm"))
  gt <- gtable_add_grob(gt, grob.background, name = "background", 
                        clip = "off", t = 1, r = -1, b = -1, l = 1)
  gt <- gtable_add_grob(gt, justify_grobs(grob.title, hjust = title.hjust, 
                                          vjust = title.vjust, int_angle = title.theme$angle, 
                                          debug = title.theme$debug), name = "title", clip = "off", 
                        t = 1 + min(vps$title.row), r = 1 + max(vps$title.col), 
                        b = 1 + max(vps$title.row), l = 1 + min(vps$title.col))

  # create child gtable, using the same widths / heights as the original legend gtable
  gt2 <- gtable(widths = unit(widths[1 + seq.int(min(range(vps$bar.col, vps$label.col)), 
                                                 max(range(vps$bar.col, vps$label.col)))], "cm"),
                heights = unit(heights[1 + seq.int(min(range(vps$bar.row, vps$label.row)), 
                                                   max(range(vps$bar.row, vps$label.row)))], "cm"))

  # shift cell positions to start from 1
  vps2 <- vps[c("bar.row", "bar.col", "label.row", "label.col")]
  vps2[c("bar.row", "label.row")] <- lapply(vps2[c("bar.row", "label.row")],
                                            function(x) x - min(unlist(vps2[c("bar.row", "label.row")])) + 1)
  vps2[c("bar.col", "label.col")] <- lapply(vps2[c("bar.col", "label.col")],
                                            function(x) x - min(unlist(vps2[c("bar.col", "label.col")])) + 1)

  # add bar / ticks / labels grobs to child gtable
  gt2 <- gtable_add_grob(gt2, grob.bar, name = "bar", clip = "off",
                         t = min(vps2$bar.row), r = max(vps2$bar.col),
                         b = max(vps2$bar.row), l = min(vps2$bar.col))
  gt2 <- gtable_add_grob(gt2, grob.ticks, name = "ticks", clip = "off",
                         t = min(vps2$bar.row), r = max(vps2$bar.col),
                         b = max(vps2$bar.row), l = min(vps2$bar.col))
  gt2 <- gtable_add_grob(gt2, grob.label, name = "label", clip = "off",
                         t = min(vps2$label.row), r = max(vps2$label.col),
                         b = max(vps2$label.row), l = min(vps2$label.col))

  # add child gtable back to original legend gtable, taking tlrb reference from the
  # rowspan / colspan of the title grob if title grob spans multiple rows / columns.
  gt <- gtable_add_grob(gt, justify_grobs(gt2, hjust = title.hjust, 
                                          vjust = title.vjust), 
                        name = "bar.ticks.label", clip = "off", 
                        t = 1 + ifelse(length(vps$title.row) == 1, 
                                       min(vps$bar.row, vps$label.row),
                                       min(vps$title.row)), 
                        b = 1 + ifelse(length(vps$title.row) == 1, 
                                       max(vps$bar.row, vps$label.row),
                                       max(vps$title.row)), 
                        r = 1 + ifelse(length(vps$title.col) == 1, 
                                       min(vps$bar.col, vps$label.col),
                                       max(vps$title.col)), 
                        l = 1 + ifelse(length(vps$title.col) == 1, 
                                       max(vps$bar.col, vps$label.col),
                                       min(vps$title.col)))
  gt
}

変更を元に戻すには、次のコマンドを実行します。

untrace(ggplot2:::guide_gengrob.colorbar)

使用するパッケージバージョン：ggplot2 3.2.1。

11
Z.Lin

ソースコードを変更する必要があります。現在、それは タイトルグロブとbar + labelsの幅を計算します で、ビューポート（gtable）で bar + labelsを左揃えします です。これはハードコーディングされています。

5
baptiste