如何使图例颜色条与我的 plot 面板高度相同？

Question

赏金将在 7 天后到期。 此问题的答案有资格获得+100声望赏金。 tjebo正在寻找这个问题的最新答案：

最后一个答案是 2015 年的，在 ggplot2 中做了很多更改。当前的答案不起作用。 寻找一种理想的通用方法，即自动方法。

我在 R 中生成了一个简单的 plot，它显示了一组数据的相关系数。 目前，plot 右侧的图例颜色条是整个 plot 大小的一小部分。

我希望图例颜色条与 plot 的高度相同。我认为我可以使用legend.key.height来做到这一点，但我发现情况并非如此。 我调查了grid package unit function 并发现其中有一些标准化单元，但是当我尝试它们时（ unit(1, "npc") ），颜色条太高并且离开了页面。

如何使图例与 plot 本身的高度相同？

下面是一个完整的自包含示例：

library(ggplot2)

corrs <- structure(list(Var1 = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L), levels = c("Var1", "Var2", "Var3"), class = "factor"), Var2 = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L), levels = c("Var1", "Var2", "Var3"), class = "factor"), value = c(1, -0.11814395012334, -0.91732952510938, -0.969618394505233, 1, -0.00122085912153125, -0.191116513684392, -0.0373711776919663, 1)), class = "data.frame", row.names = c(NA, -9L))

ggplot(corrs, aes(x = Var1, y = Var2, fill = value)) +
  geom_tile() +
  theme(
    panel.border = element_blank(),
    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
    aspect.ratio = 1,
    legend.position = "right",
    legend.key.height = unit(1, "inch")
  )

^{创建于 2022-12-29，使用reprex v2.0.2}

Answer 1

编辑更新到ggplot v3.0.0

这很麻烦，但是基于此答案 ，并深入研究ggplot grob，可以精确定位图例。

# Load the needed libraries
library(ggplot2)
library(gtable)  # 
library(grid)
library(scales)
library(reshape2)

# Generate a collection of sample data
variables = c("Var1", "Var2", "Var3")
data = matrix(runif(9, -1, 1), 3, 3)
diag(data) = 1
colnames(data) = variables
rownames(data) = variables

# Generate the plot
corrs = data
plot  = ggplot(melt(corrs), aes(x = Var1, y = Var2, fill = value)) + 
   geom_tile() +
   theme_bw() + 
   theme(panel.border = element_blank()) +
   theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
   theme(aspect.ratio = 1) +
   # theme(legend.position = "right", legend.key.height = unit(1, "inch")) +
   labs(x = "", y = "", fill = "", title = "Correlation Coefficients") +
   scale_fill_gradient2(limits = c(-1, 1), breaks = c(-1, -.5, 0, .5, 1), expand = c(0,0), 
      low = muted("red"), mid = "black", high = muted("blue")) +  # Modified line
   geom_text(parse = TRUE, aes(label = sprintf("%.2f", value)), size = 3, color = "white") +
   scale_x_discrete(expand = c(0,0)) +  # New line
   scale_y_discrete(expand = c(0,0))    # New line
plot

# Get the ggplot grob
gt = ggplotGrob(plot)

# Get the legend
leg = gtable_filter(gt, "guide-box")

# Raster height
leg[[1]][[1]][[1]][[1]][[1]][[2]]$height = unit(1, "npc")

# Positions for labels and tick marks - five breaks, therefore, five positions
pos = unit.c(unit(0.01,"npc"), unit(.25, "npc"), unit(.5, "npc"), unit(.75, "npc"), unit(.99, "npc"))

# Positions the labels 
leg[[1]][[1]][[1]][[1]][[1]][[3]]$children[[1]]$y = pos

# Positions the tick marks
leg[[1]][[1]][[1]][[1]][[1]][[5]]$y0 = pos
leg[[1]][[1]][[1]][[1]][[1]][[5]]$y1 = pos

# Legend key height ?
leg[[1]][[1]][[1]][[1]]$heights = unit.c(rep(unit(0, "mm"), 3),
                                         unit(1, "npc"),
                                         unit(0, "mm"))
# Legend height
leg[[1]][[1]]$heights[[3]] = sum(rep(unit(0, "mm"), 3),
                                 unit(1, "npc"),
                                 unit(0, "mm"))

# grid.draw(leg)  # Check on heights and y values

# gtable_show_layout(gt) # Manually locate position of legend in layout
gt.new = gtable_add_grob(gt, leg, t = 7, l = 9)

# Draw it
grid.newpage()
grid.draw(gt.new)

Answer 2

似乎很棘手，我最接近的是这个，

## panel height is 1null, so we work it out by subtracting the other heights from 1npc
## and 1line for the default plot margins

panel_height = unit(1,"npc") - sum(ggplotGrob(plot)[["heights"]][-3]) - unit(1,"line")
plot + guides(fill= guide_colorbar(barheight=panel_height))

不幸的是，垂直的理由有些偏离。

Answer 3

以下选项是 function，它采用 plot 并更改颜色条以使其与面板高度相同。 本质上它使用与 Baptiste 相同的技术，但对 ggplot 实现的变化更稳健，并将图例标题移动到更自然的 position，从而使 alignment 更整洁。

panel_sized_colorbar <- function(g) {
  h <- ggplotGrob(g)$heights
  panel <- which(grid::unitType(h) == "null")
  panel_height <- unit(1, "npc") - sum(h[-panel])
  
  g + guides(fill = guide_colorbar(barheight = panel_height,
                                   title.position = "right")) +
      theme(legend.title = element_text(angle = -90, hjust = 0.5))
}

例如：

p1 <- ggplot(corrs, aes(x = Var1, y = Var2, fill = value)) + 
  geom_tile() +
  coord_cartesian(expand = FALSE)

panel_sized_colorbar(p1)

缺点是 function 需要在调整绘图 window 的大小时重新运行。 这有点麻烦，但这是一个相当快速和简单的修复。

Answer 4

问题是 plot 面板在绘图之前没有定义尺寸（“NULL 单位”），但您的图例指南有. 另请参阅ggplot2 中 geom_point 的 npc 坐标或在 ggsave 中计算出给定最终 plot 的面板大小（以显示 geom_dotplot 的计数） 。 我认为绘制与面板大小完全相同的图例指南将非常棘手。

但是，在处理复杂的图例格式时可以使用一个技巧：创建一个假图例。 这里的挑战是调整填充比例以完美匹配您的 plot 的范围（这通常不完全是您的数据值的范围）。 rest 只是 R 语义的一部分。 代码中的一些重要注释。

library(ggplot2)

corrs <- structure(list(Var1 = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L), levels = c("Var1", "Var2", "Var3"), class = "factor"), Var2 = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L), levels = c("Var1", "Var2", "Var3"), class = "factor"), value = c(1, -0.11814395012334, -0.91732952510938, -0.969618394505233, 1, -0.00122085912153125, -0.191116513684392, -0.0373711776919663, 1)), class = "data.frame", row.names = c(NA, -9L))
## to set the scale properly, you will need to set limits and breaks, 
## I am doing this semi-automatically
range_fill <- range(corrs$value)
lim_fill <- c(floor(range_fill[1]), ceiling(range_fill[2]))
## len = 5 and round to 2 is hard coded, depending on the scale breaks that you want
breaks_fill <- round(seq(lim_fill[1], lim_fill[2], len = 5), 2)
## need to rescale the fill to the range of you y values,
## so that your fill scale correctly corresponds to the range of your y 
## however, the actual range of your plot depends if you're in a discrete or continuous range.
## here in a discrete range
lim_y <- range(as.integer(corrs$Var2))
lim_x <- range(as.integer(corrs$Var1))
lim_vals <- lim_y + c(-.5, .5)
## actual rescaling happens here
new_y <- scales::rescale(breaks_fill, lim_vals)
## the position and width of the color bar are defined with
scl_x <- lim_x[2] + .7 # the constant is hard coded
scl_xend <- scl_x + .2 # also hard coded
##  make a data frame for the segments to be created
## using approx so that we have many little segments
approx_fill <- approx(new_y, breaks_fill, n = 1000)
df_seg <- data.frame(y = approx_fill$x, color = approx_fill$y)
## data frame for labels, xend position being hard coded
df_lab <- data.frame(y = new_y, x = scl_xend + .1, label = breaks_fill)
## data frame for separators
sep_len <- .05
df_sep <- data.frame(
  y = new_y, yend = new_y,
  x = rep(c(scl_x, scl_xend - sep_len), each = 5),
  xend = rep(c(scl_x + sep_len, scl_xend), each = 5)
)

ggplot(corrs) +
  geom_tile(aes(x = Var1, y = Var2, fill = value)) +
  geom_segment(
    data = df_seg,
    aes(x = scl_x, xend = scl_xend, y = y, yend = y, color = color)
  ) +
  ## now the labels, the size being hard coded
  geom_text(data = df_lab, aes(x, y, label = label), size = 9 * 5 / 14) +
  ## now make the white little separators
  geom_segment(
    data = df_sep, aes(x = x, xend = xend, y = y, yend = yend),
    color = "white"
  ) +
  ## set both color and fill scales exactly
  scale_fill_continuous(limits = lim_fill, breaks = breaks_fill) +
  scale_color_continuous(limits = lim_fill, breaks = breaks_fill) +
  ## turn off coordinate clipping and limit panel to data area)
  coord_cartesian(xlim = lim_x, ylim = lim_y, clip = "off") +
  ## last but not least remove the other legends and add a bit of margin
  theme(
    legend.position = "none",
    plot.margin = margin(r = 1, unit = "in")
  )

^{创建于 2022-12-29，使用reprex v2.0.2}