Как извлечь метки столбцов и их размер из заданного объекта ggplot?

Это продолжение вопроса (и ответа) о динамическом переносе слов в метках оси x.


РЕДАКТИРОВАТЬ - TL; Резюме DR


(A) Резюме

  1. У меня есть объект ggplot, созданный с помощью geom_bar() и ggfittext::geom_bar_text().
  2. Я хочу извлечь ярлыки полос из этого объекта.
  3. Я также хочу извлечь размер шрифта для этих меток.
  4. Я пытаюсь сделать это для двух типов графиков: типичной гистограммы и одной, разделенной на фасеты.

(B) Желаемый результат

  • вектор символов с текстом штриховых меток
  • числовой вектор с размерами штриховых меток

(C) ggplot объектов вопроса
1 - object p

library(ggfittext)
library(tidyverse)

my_cats_df <-
  data.frame(breed = c("Domestic Cat", "Persian", "Siamese", "Maine Coon"),
             weight = c(9, 10, 7, 17),
             breed_description = c("the only domesticated species in the family Felidae",
                                   "a long-haired, round face and short muzzle",
                                   "blue almond-shaped eyes; a triangular head shape",
                                   "the largest domesticated cat breed") )


p <-
  my_cats_df %>%
  ggplot(aes(x = breed, y = weight, fill = breed)) +
  geom_bar(stat = "identity") +
  geom_bar_text(aes(label = breed_description), 
                min.size = 0,
                reflow = TRUE)

2 - объект p_facets_by_var

my_cats_df_by_sex <- data.frame(breed = rep(c("Domestic Cat", "Persian", "Siamese", "Maine Coon"), each = 2),
                                sex = rep(c("male", "female"), 2),
                                weight = c(11, 6, 12, 8, 10, 5, 20, 15),
                                breed_description = rep(c("the only domesticated species in the family Felidae",
                                               "a long-haired, round face and short muzzle",
                                               "blue almond-shaped eyes; a triangular head shape",
                                               "the largest domesticated cat breed"), each = 2))

p_facets_by_var <- 
  my_cats_df_by_sex %>%
  ggplot(aes(x = breed, y = weight, fill = breed)) +
  geom_bar(stat = "identity") +
  geom_bar_text(aes(label = breed_description), 
                min.size = 0,
                reflow = TRUE) +
  facet_wrap(~ sex)

История вопроса

Read if you want context, otherwise skip all sections below.

Проблема

Метки оси x перекрываются. Пример:

library(tidyverse)

mtcars[15:20,] %>% 
  rownames_to_column("cars") %>%
  ggplot(aes(x = cars, y = mpg, fill = cars)) + 
  geom_bar(stat = "identity")

Создано 31 января 2021 года пакетом REPEX (v0.3.0)

Фон

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

Точно так же, если мы печатаем с использованием _9 _ / _ 10_, это означает меньше места для текста, а параметры стиля по умолчанию (например, размер текста) делают его где-то зашифрованным.

Моя идея

Я хочу добиться динамического переноса текста, устойчивого к изменениям размеров графика или при разделении на фасеты. Один из способов сделать это - использовать пакет ggfittext, предназначенный для размещения текста внутри полей. Его алгоритм определяет, сколько места для текста, и соответственно оборачивает текст и / или уменьшает размер текста, чтобы он поместился в поле.

К сожалению, ggfittext в настоящее время предназначен только для geoms, а не имеет подкласса element_text() , что может заставить его работать напрямую с метками scale x.

Я хочу разработать следующий рабочий процесс и, в идеале, заключить его в пользовательскую функцию:

  1. Нарисуйте столбчатую диаграмму и поместите текст внутри полос, используя ggfittext.
  2. Сохраните сюжет в объект p.
  3. Извлеките из p подогнанный текст: формат и размер текста.
  4. Re-plot:
    • pass text extracted in step (3) to scale_x_discrete()
    • передать размер текста, извлеченный на шаге (3), в theme(axis.text.x = element_text(size = ...)
    • не включайте никаких ggfittext geom

Этот ответ приблизил меня к окончательному результату, но я думаю, что он заслуживает отдельного поста, отсюда и текущий.

Пример

library(ggfittext)
#> Warning: package 'ggfittext' was built under R version 4.0.3
library(tidyverse)

my_cats_df <-
  data.frame(breed = c("Domestic Cat", "Persian", "Siamese", "Maine Coon"),
             weight = c(9, 10, 7, 17),
             breed_description = c("the only domesticated species in the family Felidae",
                                   "a long-haired, round face and short muzzle",
                                   "blue almond-shaped eyes; a triangular head shape",
                                   "the largest domesticated cat breed") )


p <-
  my_cats_df %>%
  ggplot(aes(x = breed, y = weight, fill = breed)) +
  geom_bar(stat = "identity") +
  geom_bar_text(aes(label = breed_description), 
                min.size = 0,
                reflow = TRUE)
#> Warning: Ignoring unknown aesthetics: label

p


## the following is using @teunbrand's solution (https://stackoverflow.com/a/65958754/6105259)
## but I don't understand this at all
grob <- grid::makeContent(layer_grob(p, 2)[[1]])$children

grob
#> (fittexttree[GRID.fittexttree.79])

sizes <- vapply(grob, function(x){x$gp$fontsize}, numeric(1))
#> Error in vapply(grob, function(x) {: values must be length 1,
#>  but FUN(X[[1]]) result is length 0

labels <- unname(vapply(grob, function(x){x$label}, character(1)))
#> Error in vapply(grob, function(x) {: values must be length 1,
#>  but FUN(X[[1]]) result is length 0

Создано 31 января 2021 года пакетом REPEX (v0.3.0)

Пример (2) - фасеточный сюжет

library(tidyverse)
library(ggfittext)
#> Warning: package 'ggfittext' was built under R version 4.0.3

my_cats_df_by_sex <- data.frame(breed = rep(c("Domestic Cat", "Persian", "Siamese", "Maine Coon"), each = 2),
                                sex = rep(c("male", "female"), 2),
                                weight = c(11, 6, 12, 8, 10, 5, 20, 15),
                                breed_description = rep(c("the only domesticated species in the family Felidae",
                                               "a long-haired, round face and short muzzle",
                                               "blue almond-shaped eyes; a triangular head shape",
                                               "the largest domesticated cat breed"), each = 2))

p_facets_by_var <- 
  my_cats_df_by_sex %>%
  ggplot(aes(x = breed, y = weight, fill = breed)) +
  geom_bar(stat = "identity") +
  geom_bar_text(aes(label = breed_description), 
                min.size = 0,
                reflow = TRUE) +
  facet_wrap(~ sex)
#> Warning: Ignoring unknown aesthetics: label

p_facets_by_var

Создано 31 января 2021 года пакетом REPEX (v0.3.0)


В обоих случаях выше (p или p_facets_by_var) я хотел бы извлечь текст и размер меток из объекта графика. Вектор символов должен быть передан в scale_x_discrete() для перерисовки.

Что касается меток осей size, в случае, когда ggfittext визуализировал различные размеры для столбцов, мы должны просто взять наименьший и передать его theme(axis.text.x = element_text(size = ...) для повторного построения.

Я надеюсь максимально обобщить этот рабочий процесс, возможно, с помощью функции. К сожалению, я не знаю, как извлекать информацию из данного объекта ggplot. Даже не умею читать (например, grid::makeContent(layer_grob(p, 2)[[1]])$children возвращает (fittexttree[GRID.fittexttree.79])), как с этим бороться?).

Мое желаемое решение состоит в том, чтобы получить некоторую функцию / рабочий процесс для завершения графика с метками масштаба x, отображаемыми ggfittext. Если кто-то может также изложить рекомендации, как работать с базовым механизмом, чтобы обобщить это решение на другие графики (например, как мы можем получить визуализированные метки для geom_boxplot()?), Это было бы очень полезно. Спасибо!


person Emman    schedule 31.01.2021    source источник