11.ggplot2——色阶与图例（二）

Posted 2023-05-05

参考技术A 离散颜色和填充出现在许多情况下。一个典型的例子是一个条形图，它将位置和填充都编码为相同的变量。

离散颜色的默认方法是 scale_fill_discrete() 默认值， scale_fill_hue() 也能生成相同的图：

这个默认比例有一些限制（稍后讨论），将首先讨论用于生成更好的离散调色板的工具。

scale_colour_brewer() 是一个离散的色阶，它和连续的模拟 scale_colour_distiller() 和分箱模拟 scale_colour_fermenter() 一起使用，从 http://colorbrewer2.org/ 中精心挑选的“ColorBrewer”颜色。这些颜色在各种情况下都能很好地工作，尽管重点是在地图上，所以颜色往往在大区域显示时效果更好。有很多不同的选择：

第一组调色板是顺序刻度，当离散刻度是有序（例如，排名数据）时非常有用，并且可用于使用 scale_colour_distiller() 用于连续数据。对于无序分类数据，最感兴趣的调色板是第二组中的调色板。'Set1' 和 'Dark2' 对点特别有用，'Set2'、'Pastel1'、'Pastel2' 和 'Accent' 对区域效果很好。

请注意，没有任何调色板对所有图形都适用。散点图通常使用小的绘图标记，明亮的颜色往往比微妙的效果更好：

条形图通常包含大块颜色，明亮的颜色可能会让人难以抗拒。在这种情况下，微妙的颜色往往效果更好：

默认配色方案在 HCL 色轮周围选择均匀分布的色调。这适用于多达大约八种颜色，但之后就很难区分不同的颜色。您可以使用 h 、 c 和 l 参数控制默认色度和亮度以及色调范围：

默认配色方案的一个缺点是，因为所有颜色都具有相同的亮度和色调，所以当您以黑白方式打印它们时，它们都显示为相同的灰色阴影。请注意，如果您打算以黑白打印离散色阶，最好使用 scale_fill_grey() 将离散数据映射到灰色，从浅到深：

如果挑选的调色板都不适合，或者您有自己喜欢的颜色，您可以使用 scale_fill_manual() 手动设置颜色。如果您希望选择突出二级分组结构的颜色或引起对不同比较的注意，这会很有用：

您还可以使用命名向量来指定要分配给每个级别的颜色，这允许您按您喜欢的任何顺序指定级别：

色阶也能进行分箱。默认标度 scale_fill_binned() ，转换为 scale_fill_steps() 。这些标度有一个 n.breaks 参数来控制由比例创建的离散颜色类别的数量。与直觉相反，因为人类的视觉系统非常擅长检测边缘，这有时会使连续的颜色梯度更容易被感知：

在其他方面 scale_fill_steps() 类似于 scale_fill_gradient() ，并允许您构建自己的双色渐变。还有一种三色变体 scale_fill_steps2() 和 n 色标度变体 scale_fill_stepsn() ，它们的行为与其连续对应物相似：

也存在用于分级的 brewer analog ，称为 scale_fill_fermenter() ：

注意,如离散函数 scale_fill_brewer() 、连续函数 scale_fill_distiller() 与分箱函数 scale_fill_fermenter() 不会在brewer颜色之间进行插值，如果您设置 n.breaks 的颜色大于调色板中的颜色数量，则会出现警告消息，并且不会显示某些颜色。

Alpha标度将阴影的透明度映射到数据中的一个值。它们通常不是很有用，但可以是一种方便的方法，可以直观地减轻不太重要的观察。 Scale_alpha() 是 scale_alpha_continuous() 的别名，因为这是alpha最常用的用法，它可以节省一些输入。

ggplot2中的中心对齐图例标题和图例键以获取长图例标题

【中文标题】ggplot2中的中心对齐图例标题和图例键以获取长图例标题

【英文标题】：Center-align legend title and legend keys in ggplot2 for long legend titles

【发布时间】：2018-06-08 13:51:37

【问题描述】：

当图例标题很长时，我很难使图例的标题相对于图例键居中对齐。 a year ago 有一个问题适用于短标题，但似乎不适用于长标题。

例如，先用一个简短的图例标题：

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"，但似乎没有人将键从图例框中的最左侧位置移动。

几个cmets：

我正在运行几天前的ggplot2开发版v2.2.1.9000。

我特别需要连续色阶调色板的解决方案。

【参考方案1】：

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 月 4 日创建}

原答案：

我找到了解决方案。它需要对 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)

【参考方案2】：

我破解了类似于 baptiste 在上述 cmets 中描述的方式的源代码：将颜色条/标签/刻度 grobs 放入子 gtable 中，并将其定位为具有相同的行跨度/列跨度（取决于在图例的方向上）作为标题。

这仍然是一个 hack，但我想将其视为“整个会话一次 hack”的方法，而不必为每个情节手动重复这些步骤。

不同标题宽度/标题位置/图例方向的演示：

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”被列为可接受的参数值，但事实证明，底层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。

【参考方案3】：

您必须更改源代码。目前它在视口（gtable）中computes the widths for the title grob and the bar+labels 和left-justifies the bar+labels。这是硬编码的。

【讨论】：

谢谢，这正是我所担心的。我将首先打开一个问题。

问题有其自身的问题；如果你做得过火，可能会有unfortunate consequences。

啊，我明白了，它需要带有拉取请求。也许再过一天，如果不添加另一个主题参数，我不会立即看到如何解决这个问题。

你能想出一个简单的方法来编辑图例 grob 来解决这个 ggplot2 漏洞吗？

指南代码对我来说意义不大，据我所知并没有太多解释，但from what I vaguely recall 使用 gtable 处理理由的一般策略是使其成为子 gtable并将其相应地定位在其父级中（再一次，查看输出指南 grobs 已经是嵌套 gtables 的俄罗斯娃娃，因此添加一层可能不是一个好主意）。