r - ggplot2:geom_text 使用绘图调整大小，并在 geom_bar 中强制/适合文本

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.

这引出了我的第二个问题:是否可以更改此默认行为并让/使标签随绘图调整大小？

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

一个选择可能是编写一个几何对象，该几何对象使用带有自定义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()