自动为条形图旁边的标签留出足够的空间

Question

我正在制作一个水平条形图ggplot2，标签位于条形右侧。我要为标签留出足够的空间，这样它们就不会从图表上掉下来吗？

这个问题以前已经被问过很多次了，但我的问题是关于自动的，这意味着无需手动调整，条形图旁边的空间即可为标签留出足够的空间。

该用例是一个闪亮的应用程序，其中：

• 我们事先不知道条形的宽度
• 我们不知道文本标签的长度
• 我们不知道文字大小

例子：

library(ggplot2)

data <- data.frame(
  weight = c("short","longer label","medium lab"),
  speed = sample(50:150,3)
)

ggplot(data, aes(x = weight, y = speed, label = weight)) +
  coord_flip(clip = 'off') +
  theme_minimal() +
  geom_bar(stat = "identity") + 
  geom_text(hjust = -0.1, size = 4) +
  ylim(c(0, 1.07 * max(data$speed)))

重新运行代码，您会发现标签有时会从右侧图表中脱落）。

到目前为止，我的解决方案“某种”有效的是为ylim乘数（此处为 1.07）提供一些估计器，以留出足够的空间。我当然可以使用非常高的值，但这样我们就会创建太多的空白。

我还尝试通过 计算 grob 的宽度grid::grobWidth，主要基于这篇文章： How can I accessDimensions of labelsplotted by `geom_text` in `ggplot2`?

然而，为了用这种方法计算文本（或其他）元素的实际大小，我们需要知道cexin gpar，但我们只有sizein 的参数geom_text。我不明白它们有什么关系（？）。

我也查看了ggprepel其内部代码，但无法理解如何将他们的方法应用于这个特定问题。

非常感谢任何帮助/指示！

Answer 1

grid人们可以使用和中的各种工具来测量面板、面板范围和文本大小ggplot2。这允许重新计算绘图中所需的上限。

我们可以将其放入函数中，如下所示：

library(ggplot2)
library(grid)

fix_labels <- function(p) {
  tl <- which(sapply(p$layers, function(x) any(grepl("Text", class(x$geom)))))
  g <- ggplot_build(p)
  range <- g$layout$panel_params[[1]]$x.range
  dat <- g$data[[tl]][order(factor(g$data[[tl]]$label)),]
  label_pos <- dat$x
  labels <- dat$label
  
  str_width <- sapply(labels, function(x) {
    textGrob(x, gp = gpar(fontsize = p$layers[[tl]]$aes_params$size * .pt)) |>
      grobWidth() |>
      convertWidth("cm", TRUE)
  })
  
  panel_width <- (unit(1, 'npc') - sum(ggplotGrob(p)$widths[-5])) |>
         convertWidth('cm', TRUE)
  
  units_per_cm <- diff(range) / panel_width
  
  new_x <- str_width * units_per_cm + label_pos 
  
  expansion_factor <- (max(new_x) - min(range))/diff(range)
  xval <- expansion_factor^2 * (max(new_x) - max(label_pos)) + max(label_pos)
  
  p + xlim(NA, xval)
}

我们可以在您自己的示例中对此进行测试，但我们应该通过删除不必要的代码coord_flip并将其更改geom_bar(stat = "identity")为等效的geom_col().

我们还将使用随机种子来提高再现性，并使用更大的字体来说明问题。

set.seed(123)

data <- data.frame(
  weight = c("short","longer label","medium lab"),
  speed = sample(50:150,3)
)

p <- ggplot(data, aes(x = speed, y = weight, label = weight)) +
  theme_minimal() +
  geom_col() +
  geom_text(hjust = -0.1, size = 8) 

p

但现在我们可以这样做：

fix_labels(p)

这似乎适用于小文本（这里只是相同的代码，但文本大小为 4）：

甚至是毫无意义的大标签（此处为 16 号）