Маркировка графика плотности в ggplot2 с подсчетами - PullRequest
Новая
       94

Маркировка графика плотности в ggplot2 с подсчетами

1 голос
/ 11 апреля 2020

Вопрос

Как добавить метки, показывающие количество наблюдений вдоль график плотности?

Данные

Мой набор данных: 

mwe <- structure(list(Gender = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L), .Label = c("Female", "Male"), class = "factor"), 
    Age = c(23, 23, 23, 23, 23, 23, 39, 39, 39, 39, 39, 39, 30, 
    30, 30, 30, 30, 30, 30, 30, 24, 24, 24, 24, 24, 24, 24, 24, 
    18, 18, 18, 18, 18, 18, 23, 23, 23, 23, 23, 23, 23, 23, 26, 
    26, 26, 26, 26, 26, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 
    23, 23, 23, 23, 30, 30, 30, 30, 30, 30, 20, 20, 20, 20, 20, 
    20, 25, 25, 25, 25, 25, 25, 25, 25, 23, 23, 23, 23, 23, 23, 
    23, 23, 38, 38, 38, 38, 38, 38, 22, 22, 22, 22, 22, 22, 29, 
    29, 29, 29, 29, 29, 21, 21, 21, 21, 21, 21, 23, 23, 23, 23, 
    23, 23, 25, 25, 25, 25, 25, 25, 24, 24, 24, 24, 24, 24, 21, 
    21, 21, 21, 21, 21, 27, 27, 27, 27, 27, 27, 24, 24, 24, 24, 
    24, 24, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 23, 
    23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 21, 21, 
    21, 21, 27, 27, 27, 27, 27, 27, 34, 34, 34, 34, 34, 34, 26, 
    26, 26, 26, 26, 26, 26, 26, 28, 28, 28, 28, 28, 28, 39, 39, 
    39, 39, 39, 39, 26, 26, 26, 26, 26, 26), KmEuc = structure(c(1L, 
    1L, 1L, 1L, 3L, 3L, 2L, 2L, 3L, 3L, 2L, 3L, 2L, 2L, 3L, 3L, 
    3L, 3L, 3L, 3L, 3L, 2L, 3L, 3L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 
    3L, 3L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 
    1L, 1L, 3L, 2L, 1L, 1L, 1L, 1L, 3L, 2L, 3L, 3L, 3L, 2L, 3L, 
    2L, 2L, 2L, 3L, 2L, 3L, 2L, 2L, 2L, 3L, 3L, 2L, 3L, 2L, 2L, 
    3L, 2L, 3L, 3L, 2L, 3L, 2L, 2L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 
    2L, 3L, 3L, 2L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 
    3L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 3L, 3L, 3L, 3L, 3L, 2L, 
    2L, 3L, 3L, 2L, 2L, 2L, 2L, 3L, 3L, 2L, 2L, 2L, 3L, 3L, 3L, 
    2L, 3L, 2L, 2L, 3L, 3L, 3L, 3L, 2L, 2L, 3L, 3L, 3L, 3L, 2L, 
    2L, 3L, 3L, 3L, 3L, 2L, 2L, 3L, 3L, 2L, 2L, 2L, 2L, 3L, 3L, 
    3L, 2L, 3L, 3L, 2L, 2L, 3L, 3L, 3L, 2L, 2L, 2L, 3L, 3L, 2L, 
    2L, 3L, 3L, 2L, 2L, 3L, 2L, 3L, 3L, 3L, 3L, 2L, 2L, 3L, 3L, 
    3L, 2L, 3L, 3L, 2L, 3L, 3L, 3L, 3L, 3L, 2L, 3L, 2L, 2L, 2L, 
    2L, 2L, 2L, 2L, 3L, 3L, 3L), .Label = c("1", "2", "3"), class = "factor")), class = "data.frame", row.names = c(NA, 
-218L))

Я хочу показать распределение по возрасту, используя график плотности:

Код 

p1 <- ggplot() +
  geom_freqpoly(aes(x = Age, color = KmEuc), stat = 'density', position = 'dodge', data=mwe) +
  scale_color_manual(guide = guide_legend(),name = 'Clusters',values = c("#E31A1C","#332288", "#66A61E"), labels = c("Pie", "Carrot", "Rice")) +
  theme_light(base_size=14) +
  facet_grid(facets = Gender ~ .) +
  theme(axis.title.x = element_blank(),axis.title.y = element_blank())

enter image description here

Trial

Чтобы добавить метки счетчиков, я попробовал следующее: 

dfLabels <- mwe %>%
  select(c(Age, Gender, KmEuc)) %>%
  group_by(Age, Gender, KmEuc) %>%
  dplyr::summarise(N = n())

p1 + geom_label(data = dfLabels, aes(x = Age, y = 0.01, label = N), size = 3, vjust = 0, hjust = 0)

С y=0.01 Я мог бы показать N только на фиксированной линии по оси Y, как заставить N появляться вдоль функции плотности в этом случае?

1 Ответ

1 голос
/ 11 апреля 2020

Попробуйте это. Помимо вычисления количества я также вычисляю плотность для каждого возраста. Я заимствовал общую идею у здесь , но адаптировал ее к вашей проблеме и использовал tidyverse подход. 

library(ggplot2)
library(purrr)
library(dplyr)
library(tidyr)

dfLabels <- mwe %>%
  select(Age, Gender, KmEuc) %>%
  group_by(Gender, KmEuc) %>%
  nest() %>% 
  # Compute density
  mutate(dens = purrr::map(data, ~ density(.$Age))) %>% 
  # Unique Ages
  mutate(age_uniq = purrr::map(data, ~ unique(.$Age))) %>%
  unnest(age_uniq)

dfLabels1 <- dfLabels %>%
  # Compute "y" by interpolation and count 
  mutate(label.y = purrr::map2_dbl(age_uniq, dens, ~approx(.y$x, .y$y, .x)$y),
         label.n = purrr::map2_dbl(age_uniq, data, ~ sum(.y$Age == .x))) %>% 
  select(Gender, KmEuc, Age = age_uniq, label.y, label.n)

p1 <- ggplot() +
  geom_freqpoly(aes(x = Age, color = KmEuc), stat = 'density', position = 'dodge', data=mwe) +
  geom_text(aes(x = Age, y = label.y, color = KmEuc, label = label.n), 
            position = 'dodge', vjust = 0, show.legend = FALSE, data=dfLabels1) +
  scale_color_manual(guide = guide_legend(),name = 'Clusters',values = c("#E31A1C","#332288", "#66A61E"), labels = c("Pie", "Carrot", "Rice")) +
  theme_light(base_size=14) +
  facet_grid(facets = Gender ~ .) +
  theme(axis.title.x = element_blank(),axis.title.y = element_blank())
p1
#> Warning: Width not defined. Set with `position_dodge(width = ?)`

#> Warning: Width not defined. Set with `position_dodge(width = ?)`

Создано на 2020-04-11 представительный пакет (v0.3.0)

...