ggplot2：geom_text 使用 geom_bar 内的绘图和 force/fit 文本调整大小

Question

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

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

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

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

但是还有另一个问题，即使标签适合条形图，调整图的大小也会弄乱一切。查看它，我还在 ggplot documentation 中发现

labels do have height and width, but they are physical units, not data units. The amount of space they occupy on that plot is not constant in data units: when you resize a plot, labels stay the same size, but the size of the axes changes.

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

同时让我完善我的第一个问题。是否可以强制 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

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

由此代码创建：

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()

技巧分三步完成：

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

Answer 2

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

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()

ggplot2：geom_text 使用 geom_bar 内的绘图和 force/fit 文本调整大小

ggplot2: geom_text resize with the plot and force/fit text within geom_bar

r

ggplot2

geom-bar

geom-text

ggproto