ggplot2: изменение размера geom_text в зависимости от графика и принудительная вставка текста в geom_bar

Question

Это на самом деле два вопроса в одном (не уверен, что идет против правил SO, но в любом случае).

Первый вопрос: как я могу заставить geom_text вписаться в geom_bar? (динамически в соответствии со значениями, нанесенными на график)

Оглядываясь вокруг, решения, которые я нашел, меняли размер этикетки. Это, конечно, работает, но не для каждого случая. Вы можете изменить размер для определенного графика, чтобы текст поместился на панели, но при изменении данных может потребоваться снова вручную изменить размер текста. Моя реальная проблема заключается в том, что мне нужно создать один и тот же график для постоянно меняющихся данных (ежедневно), поэтому я не могу на самом деле вручную настроить размер для каждого графика.

Я попытался установить размер метки в зависимости от данных. Это вроде работает, не идеально, но работает во многих случаях.

Но вот еще одна проблема, даже когда метка помещается на панели, изменение размера графика все портит. Глядя на это, я также нашел в документации ggplot, что

метки имеют высоту и ширину, но они являются физическими единицами, а не единицами данных. Объем пространства, которое они занимают на этом графике, не является постоянным в единицах данных: когда вы изменяете размер графика, метки остаются неизменными, но размер осей изменяется.

Что подводит меня ко второму вопросу: возможно ли изменить это поведение по умолчанию и разрешить / сделать метки изменяющими размеры в зависимости от графика?

А также позвольте мне уточнить мой первый вопрос. Можно ли заставить 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))

Этот код производит этот график:

Если я просто изменю размер графика, " метки останутся неизменными по размеру, но размер осей изменится", тем самым заставив метки вписаться в столбцы (теперь, возможно, метки даже слишком малы).

Итак, это мой второй вопрос. Было бы неплохо, чтобы метки также менялись и сохраняли соотношение сторон относительно столбцов. Есть идеи, как это сделать или вообще возможно?

Хорошо, но, возвращаясь к тому, как разместить метки в столбцах, самое простое решение - установить размер меток.

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)

И я могу продолжить с примерами, устанавливая размер меток в зависимости от количества категорий на оси х и так далее. Но вы понимаете, и, возможно, один из вас ggplot2 эксперты могут дать мне идеи.

Answer 1

Одним из вариантов может быть написание geom, который использует textGrob с пользовательским методом drawDetails, чтобы поместиться в выделенное пространство, заданное шириной полосы.

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