使用长标签名称设置标准图例键大小 ggplot

Posted 2023-02-16

【中文标题】使用长标签名称设置标准图例键大小 ggplot

【英文标题】：Set standard legend key size with long label names ggplot

【发布时间】：2021-10-21 07:28:00

【问题描述】：

我正在构建一个 ggplot 可视化，其中一些填充美学有很长的变量名，而其他变量名很短。添加长名称会更改对应于长文本的图例键的大小 - 将其延长以匹配文本。我想知道是否有办法标准化所有变量的图例键高度，并更改图例项之间的空格。

我尝试修改 theme(legend.key.height()) 和 theme(legend.key.width()) 但这并没有解决问题。

这里是示例代码：

#load neccesary package
library('ggplot2')

#create the dataframe
df <- data.frame(year = as.integer(c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2)),
                 class = c('A', 'B', 'C', 'D', 'E'), 
                 value = c(50, 50))

#Create plot
g <- ggplot(df, aes(x = year, y = value, fill = class)) + 
  geom_col(position = 'stack') + 
  scale_fill_discrete(labels = c('This is an\nextremely\nlong label\nname', 'short label1', 'Another\nlong\nlabel\nname', 'short label3', 'short label4'))

情节：

我想要的是所有变量都具有相同的键大小，键之间的空格会发生变化以适应长文本。所以看起来像这样：

正在尝试g + theme(legend.key.height = unit(3, 'mm'), legend.key.width = unit(3, 'mm'))

不能解决问题。

有什么想法吗？

【问题讨论】：

尝试添加theme(legend.key.height=unit(2, "cm"))

@Duck，谢谢，但这只会使所有图例键变大。我想让它们都变小（我有大量的变量来适应图像）。

在这种情况下，您将不得不调整图例中文本的大小！

@Duck：我尝试编辑问题以更清楚地说明我想要什么作为解决方案。本质上，我想保持所有内容相同，但只需将密钥设为通用大小，这将需要在标题名称较长的情况下扩展空格。

对于那些可能希望获得较少参与的解决方案的人，这是github.com/tidyverse/ggplot2/issues/3669 跟踪的一个已知问题。目前（2021 年 11 月）它在 ggplot 3.4.0 里程碑中开放。

【参考方案1】：

制作自定义指南的另一种方法是为图例字形制作自定义绘图功能。相对于draw_key_polygon() 的变化是宽度和高度设置为"snpc" 单位，而不是"npc" 单位。

#load neccesary package
library(ggplot2)
library(grid)
library(rlang)

draw_square <- function(data, params, size) 
  if (is.null(data$size)) 
    data$size <- 0.5
  
  lwd <- min(data$size, min(size) /4)
  grid::rectGrob(
    width  = unit(1, "snpc") - unit(lwd, "mm"),
    height = unit(1, "snpc") - unit(lwd, "mm"),
    gp = gpar(
      col = data$colour %||% NA,
      fill = alpha(data$fill %||% "grey20", data$alpha),
      lty = data$linetype %||% 1,
      lwd = lwd * .pt,
      linejoin = params$linejoin %||% "mitre",
      lineend = if (identical(params$linejoin, "round")) "round" else "square"
    )
  )


#create the dataframe
df <- data.frame(year = as.integer(c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2)),
                 class = c('A', 'B', 'C', 'D', 'E'), 
                 value = c(50, 50))

#Create plot
g <- ggplot(df, aes(x = year, y = value, fill = class)) + 
  geom_col(position = 'stack', key_glyph = draw_square) + 
  scale_fill_discrete(labels = c('This is an\nextremely\nlong label\nname', 'short label1', 'Another\nlong\nlabel\nname', 'short label3', 'short label4'))
g

^{由reprex package (v1.0.0) 于 2021 年 8 月 19 日创建}

【参考方案2】：

您可以通过定义自己的图例类来做到这一点。这当然比主题中的简单选项更冗长，了解一些 gtable/grid 会很方便，但它可以完成工作。

library(ggplot2)
library(grid)

#create the dataframe
df <- data.frame(year = as.integer(c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2)),
                 class = c('A', 'B', 'C', 'D', 'E'), 
                 value = c(50, 50))

labs <-  c('This is an\nextremely\nlong label\nname', 'short label1', 
           'Another\nlong\nlabel\nname', 'short label3', 'short label4')

guide_squarekey <- function(...) 
  # Constructor just prepends a different class
  x <- guide_legend(...)
  class(x) <- c("squarekey", class(x))
  x


guide_gengrob.squarekey <- function(guide, theme) 
  # Make default legend
  legend <- NextMethod()

  # Find the key grobs
  is_key <- startsWith(legend$layout$name, "key-")
  is_key <- is_key & !endsWith(legend$layout$name, "-bg")

  # Extract the width of the key column
  key_col <- unique(legend$layout$l[is_key])
  keywidth <- convertUnit(legend$widths[2], "mm", valueOnly = TRUE)

  # Set the height of every key to the key width
  legend$grobs[is_key] <- lapply(legend$grobs[is_key], function(key) 
    key$height <- unit(keywidth - 0.5, "mm") # I think 0.5mm is default offset
    key
  )
  legend


ggplot(df, aes(x = year, y = value, fill = class)) + 
  geom_col(position = 'stack') + 
  scale_fill_discrete(labels = labs,
                      guide = "squarekey")

^{由reprex package (v0.3.0) 于 2021-01-20 创建}

编辑：如果您也想编辑键背景：

guide_gengrob.squarekey <- function(guide, theme) 
  legend <- NextMethod()
  is_key <- startsWith(legend$layout$name, "key-")
  is_key_bg <- is_key & endsWith(legend$layout$name, "-bg")
  is_key <- is_key & !endsWith(legend$layout$name, "-bg")
  
  key_col <- unique(legend$layout$l[is_key])
  keywidth <- convertUnit(legend$widths[2], "mm", valueOnly = TRUE)
  
  legend$grobs[is_key] <- lapply(legend$grobs[is_key], function(key) 
    key$height <- unit(keywidth - 0.5, "mm")
    key
  )
  legend$grobs[is_key_bg] <- lapply(legend$grobs[is_key_bg], function(bg) 
    bg$height <- unit(keywidth, "mm")
    bg
  )
  legend

【讨论】：

谢谢。这就是我想要的。非常有帮助。将不得不花一些时间来处理代码。感谢您为此付出的时间。

只需在 guide_gengrob 方法代码中的某处使用x <<- legend，运行绘图，x 是图例对象，但现在在您的全局环境中；您是否希望检查所有子集和东西的作用。

这太好了，谢谢@teunbrand！ guide_squarekey() 作为 fill = guide_legend() 的替代品。