ggplot2：geom_text 使用绘图和强制/适合 geom_bar 中的文本调整大小

Question

这实际上是两个问题合二为一（不确定是否违反 SO 规则，但无论如何）。

第一个问题是如何强制geom_text 适合geom_bar？ （根据绘制的值动态）

环顾四周，我发现的解决方案是改变标签的大小。这当然有效，但并非适用于所有情况。您可以更改特定绘图的大小以使文本适合条形图，但是当数据更改时，您可能需要再次手动更改文本的大小。我的现实问题是我需要为不断变化的数据（每天）生成相同的图，所以我不能真正手动调整每个图的大小。

我尝试将标签的大小设置为数据的函数。它有点工作，但并不完美，但适用于许多情况。

但这里还有另一个问题，即使标签适合条形图，调整绘图大小也会使一切变得混乱。查了一下，我也在ggplot documentation那个

标签确实有高度和宽度，但它们是物理单位，而不是数据 单位。他们在该地块上占据的空间量在 数据单位：调整绘图大小时，标签保持相同大小，但 轴的大小发生变化。

这让我想到了我的第二个问题：是否可以更改此默认行为并让/使标签随情节调整大小？

还让我完善我的第一个问题。是否可以强制geom_text 适应geom_bar，使用物理单元和数据单元之间的巧妙关系动态设置文本大小？

因此，为了遵循良好的做法，这是我的可重现示例：

set.seed(1234567)
data_gd <- data.frame(x = letters[1:5], 
                      y = runif(5, 100, 99999))

ggplot(data = data_gd,
       mapping = aes(x = x, y = y, fill = x)) +
    geom_bar(stat = "identity") +
    geom_text(mapping = aes(label = y, y = y/2))

此代码生成此图：

如果我只是调整绘图的大小，“labels stay the same size, but the size of the axes changes”从而使标签适合条形（现在可能标签甚至太小了）。

所以，这是我的第二个问题。标签也可以调整大小并保持与条相关的纵横比会很好。任何想法如何实现这一点或是否有可能？

好的，但是回到如何在条形中放置标签，最简单的解决方案是设置标签的大小。

ggplot(data = data_gd,
       mapping = aes(x = x, y = y, fill = x)) +
    geom_bar(stat = "identity") +
    geom_text(mapping = aes(label = y, y = y/2), size = 3)

同样，它的工作原理如下所示，但它不可维护/对数据的变化也不健壮。

例如，使用不同数据生成绘图的相同代码会产生灾难性的结果。

data_gd <- data.frame(x = letters[1:30], 
                      y = runif(30, 100, 99999))
ggplot(data = data_gd,
       mapping = aes(x = x, y = y, fill = x)) +
    geom_bar(stat = "identity") +
    geom_text(mapping = aes(label = y, y = y/2), size = 3)

我可以继续示例，将标签的大小设置为 x 轴上类别数量的函数，依此类推。但你明白了，也许你们中的一位ggplot2 专家可以给我一些想法。

Answer 1

一个选项可能是编写一个geom，它使用带有自定义drawDetails方法的textGrob来适应分配的空间，由条形宽度设置。

library(grid)
library(ggplot2)

fitGrob <- function(label, x=0.5, y=0.5, width=1){
  grob(x=x, y=y, width=width, label=label, cl = "fit")
}
drawDetails.fit <- function(x, recording=FALSE){
  tw <- sapply(x$label, function(l) convertWidth(grobWidth(textGrob(l)), "native", valueOnly = TRUE))
  cex <- x$width / tw
  grid.text(x$label, x$x, x$y, gp=gpar(cex=cex), default.units = "native")
}


`%||%` <- ggplot2:::`%||%`

GeomFit <- ggproto("GeomFit", GeomRect,
                   required_aes = c("x", "label"),

                   setup_data = function(data, params) {
                     data$width <- data$width %||%
                       params$width %||% (resolution(data$x, FALSE) * 0.9)
                     transform(data,
                               ymin = pmin(y, 0), ymax = pmax(y, 0),
                               xmin = x - width / 2, xmax = x + width / 2, width = NULL
                     )
                   },
                   draw_panel = function(self, data, panel_scales, coord, width = NULL) {
                     bars <- ggproto_parent(GeomRect, self)$draw_panel(data, panel_scales, coord)
                     coords <- coord$transform(data, panel_scales)    
                     width <- abs(coords$xmax - coords$xmin)
                     tg <- fitGrob(label=coords$label, y = coords$y/2, x = coords$x, width = width)

                     grobTree(bars, tg)
                   }
)

geom_fit <- function(mapping = NULL, data = NULL,
                     stat = "count", position = "stack",
                     ...,
                     width = NULL,
                     binwidth = NULL,
                     na.rm = FALSE,
                     show.legend = NA,
                     inherit.aes = TRUE) {

  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomFit,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      width = width,
      na.rm = na.rm,
      ...
    )
  )
}


set.seed(1234567)
data_gd <- data.frame(x = letters[1:5], 
                      y = runif(5, 100, 99999))

ggplot(data = data_gd,
       mapping = aes(x = x, y = y, fill = x, label=round(y))) +
  geom_fit(stat = "identity") +
  theme()

Answer 2

如果水平条形图没问题，那么问题不是标签的大小而是位置。我的解决方案是

由此代码创建：

library(ggplot2)
data_gd <- data.frame(x = letters[1:26], 
                      y = runif(26, 100, 99999))
ymid <- mean(range(data_gd$y))
ggplot(data = data_gd,
       mapping = aes(x = x, y = y, fill = x)) +
  geom_bar(stat = "identity") +
  geom_text(mapping = aes(label = y, y = y, 
            hjust = ifelse(y < ymid, -0.1, 1.1)), size = 3) +
  coord_flip()

诀窍分三步完成：

1. coord_flip 制作水平条形图。
2. geom_text 中的映射也使用 hjust，具体取决于 y 的值。如果条形短于 y 范围的一半，则文本将打印在条形之外（y 值的右侧）。如果条长于 y 范围的一半，则文本将打印在条内（y 值的左侧）。这样可以确保文本始终打印在绘图区域内（如果不是太长的话）。
3. 我在栏和文本之间添加了一些额外的空间。如果您希望文本直接在 y 值处开始或结束，您可以使用 hjust = ifelse(y < ymid, 0, 1))。