Center-align ggplot2 中用于长图例标题的图例标题和图例键
Center-align legend title and legend keys in ggplot2 for long legend titles
当图例标题很长时，我很难使图例标题 center-aligned 相对于图例键。 有一个问题适用于短标题，但似乎不适用于长标题。
示例，首先带有简短的图例标题：
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)
一切如预期，图例标题在图例键上方居中。
现在长图例标题也一样：
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)
我们可以看到文本与自身居中对齐，但与图例键无关。我尝试修改其他主题选项，例如 legend.justification = "center"，但 none 似乎将键从其在图例框中的 left-most 位置移开。
一些评论：
我是运行前几天的ggplot2 v2.2.1.9000开发版
我特别需要一个连续色阶调色板的解决方案。
您必须更改源代码。当前它 computes the widths for the title grob and the bar+labels, and left-justifies the bar+labels 在视口 (gtable) 中。这是硬编码的。
2019 年 10 月 4 日更新：
不久前，我根据大约两年前在这里发布的原始想法编写了一个相当通用的函数。该函数在 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")))
由 reprex package (v0.3.0)
于 2019-10-04 创建
原回答：
我找到了解决办法。它需要深入挖掘 grob 树，如果有多个图例，它可能无法工作，但除此之外，这似乎是一个合理的解决方案，直到出现更好的解决方案。
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)
我破解了源代码，类似于 baptiste 在上述评论之一中描述的方式：将颜色条/标签/刻度 grobs 放入 child gtable，并将其放置在同一行跨度/列跨度（取决于图例的方向）作为标题。
它仍然是一个 hack，但我想将其视为一种 'hack once for the whole session' 方法，而不必为每个绘图手动重复这些步骤。
不同标题宽度/标题位置/图例方向的演示：
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)
这也适用于多个颜色条图例：
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")
(旁注：需要 legend.box.just = "center" 才能正确对齐两个图例。我担心了一会儿，因为只有 "top"、"bottom"、"left" 和"right" 目前被列为可接受的参数值，但事实证明 "center" / "centre" 也被基础 grid::valid.just 接受。我不确定为什么会这样?theme 帮助文件中未明确提及；尽管如此，它确实有效。）
要更改源代码，运行:
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.
当图例标题很长时，我很难使图例标题 center-aligned 相对于图例键。
示例，首先带有简短的图例标题：
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)
一切如预期，图例标题在图例键上方居中。
现在长图例标题也一样：
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)
我们可以看到文本与自身居中对齐，但与图例键无关。我尝试修改其他主题选项，例如 legend.justification = "center"，但 none 似乎将键从其在图例框中的 left-most 位置移开。
一些评论：
我是运行前几天的ggplot2 v2.2.1.9000开发版
我特别需要一个连续色阶调色板的解决方案。
您必须更改源代码。当前它 computes the widths for the title grob and the bar+labels, and left-justifies the bar+labels 在视口 (gtable) 中。这是硬编码的。
2019 年 10 月 4 日更新：
不久前，我根据大约两年前在这里发布的原始想法编写了一个相当通用的函数。该函数在 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")))
由 reprex package (v0.3.0)
于 2019-10-04 创建原回答：
我找到了解决办法。它需要深入挖掘 grob 树，如果有多个图例，它可能无法工作，但除此之外，这似乎是一个合理的解决方案，直到出现更好的解决方案。
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)
我破解了源代码，类似于 baptiste 在上述评论之一中描述的方式：将颜色条/标签/刻度 grobs 放入 child gtable，并将其放置在同一行跨度/列跨度（取决于图例的方向）作为标题。
它仍然是一个 hack，但我想将其视为一种 'hack once for the whole session' 方法，而不必为每个绘图手动重复这些步骤。
不同标题宽度/标题位置/图例方向的演示：
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)
这也适用于多个颜色条图例：
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")
(旁注：需要 legend.box.just = "center" 才能正确对齐两个图例。我担心了一会儿，因为只有 "top"、"bottom"、"left" 和"right" 目前被列为可接受的参数值，但事实证明 "center" / "centre" 也被基础 grid::valid.just 接受。我不确定为什么会这样?theme 帮助文件中未明确提及；尽管如此，它确实有效。）
要更改源代码，运行:
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.