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

q1qsirdb 于 2023-01-15 发布在其他

关注(0)|答案(1)|浏览(119)

我正在用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）留有足够的空间，当然我可以使用一个非常高的值，但这样会产生太多的空白。
我也尝试过通过grid::grobWidth计算grob的宽度，主要基于这篇文章：How can I access dimensions of labels plotted by geom_text in ggplot2?
然而，为了用这种方法计算文本（或其他）元素的实际大小，我们需要知道gpar中的cex，但我们在geom_text中只有一个size参数，我看不出它们是如何关联的（？）。
我也看过ggprepel及其内部代码，但不能理解如何将他们的方法应用于这个特定的问题。
非常感谢任何帮助/指点!

r

来源：https://stackoverflow.com/questions/75098826/automatically-leave-enough-room-for-a-label-next-to-a-barplot

1条答案

按热度按时间

wh6knrhe1#

您可以使用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