Question

Я пытаюсь добавить средства, используя geom_segment, к графику geom_density_ridges, созданному в ggplot2.

library(dplyr)
library(ggplot2)
library(ggridges)

Fig1 <- ggplot(Figure3Data,  aes(x = `hairchange`, y = `EffortGroup`)) +
  geom_density_ridges_gradient(aes(fill = ..x..), scale = 0.9, size = 1) 

ingredients <- ggplot_build(Fig1) %>% purrr::pluck("data", 1)

density_lines <- ingredients %>%
  group_by(group) %>% filter(density == mean(density)) %>% ungroup()

p <- ggplot(Figure3Data,  aes(x = `hairchange`, y = `EffortGroup`)) +
  geom_density_ridges_gradient(aes(fill = ..x..), scale = 0.9, size = 1) +
  scale_fill_gradientn(  colours = c("#0000FF", "#FFFFFF", "#FF0000"),name = 
  NULL, limits=c(-2,2))+ coord_flip() +
  theme_ridges(font_size = 20, grid=TRUE, line_size=1, 
               center_axis_labels=TRUE) + 
  scale_x_continuous(name='Average Self-Perceived Hair Change', limits=c(-2,2))+ 
  ylab('Total SSM Effort (hours)')+
  geom_segment(data =density_lines, 
               aes(x = x, y = ymin, xend = x, yend = ymin+density*scale*iscale))

print(p)

Однако я получаю сообщение «Ошибка: data должно иметь уникальное имя, но содержит повторяющиеся элементы».Ниже приведен график без средств для набора данных, который у меня есть.Любые предложения о том, как исправить код?

Первые 35 строк данных приведены ниже:

structure(list(MonthsMassage = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 
2, 2, 1, 1), MinutesPerDayMassage = c("0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "11-20 minutes daily", 
"11-20 minutes daily", "11-20 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "0-10 minutes daily", "0-10 minutes daily", 
"0-10 minutes daily", "11-20 minutes daily", "11-20 minutes daily"
), Minutes = c(5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 15, 15, 15, 5, 5, 
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 15, 15), 
    hairchange = c(-1, -1, 0, -1, 0, -1, -1, 0, 0, -1, 0, -1, 
    -1, 0, 0, -1, 0, -1, 0, -1, -1, -1, -1, -1, 0, -1, -1, -1, 
    0, 1, -1, 0, 0, -1, 0), HairType1 = c("Templefrontal", "Templefrontal", 
    "Templefrontal", "Templefrontal", "Templefrontal", "Templefrontal", 
    "Templefrontal", "other", "Templefrontal", "Templefrontal", 
    "Templefrontal", "Templefrontal", "Templefrontal", "Templefrontal", 
    "Templefrontal", "Templefrontal", "Templefrontal", "Templefrontal", 
    "Templefrontal", "Templefrontal", "Templefrontal", "Templefrontal", 
    "Templefrontal", "Templefrontal", "Templefrontal", "other", 
    "other", "other", "Templefrontal", "Templefrontal", "other", 
    "Templefrontal", "other", "Templefrontal", "Templefrontal"
    ), HairType2 = c("other", "other", "other", "other", "other", 
    "other", "other", "other", "other", "Vertexthinning", "Vertexthinning", 
    "other", "Vertexthinning", "other", "other", "Vertexthinning", 
    "other", "Vertexthinning", "Vertexthinning", "other", "other", 
    "other", "Vertexthinning", "other", "Vertexthinning", "other", 
    "other", "other", "other", "other", "other", "Vertexthinning", 
    "other", "other", "other"), HairType3 = c("other", "Diffusethinning", 
    "other", "Diffusethinning", "other", "other", "Diffusethinning", 
    "Diffusethinning", "Diffusethinning", "other", "Diffusethinning", 
    "Diffusethinning", "other", "other", "Diffusethinning", "Diffusethinning", 
    "other", "Diffusethinning", "Diffusethinning", "Diffusethinning", 
    "other", "other", "other", "other", "other", "other", "other", 
    "other", "other", "Diffusethinning", "other", "other", "other", 
    "other", "other"), Effort = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 
    2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 5, 5, 5, 5, 5, 7.5, 7.5), EffortGroup = c("<5", 
    "<5", "<5", "<5", "<5", "<5", "<5", "<5", "<5", "<5", "<5", 
    "<5", "<5", "<5", "<5", "<5", "<5", "<5", "<5", "<5", "<5", 
    "<5", "<5", "<5", "<5", "<5", "<5", "<5", "12.5", "12.5", 
    "12.5", "12.5", "12.5", "12.5", "12.5")), row.names = c(NA, 
-35L), class = c("tbl_df", "tbl", "data.frame"))

Uwe · Answer 1 · 09 октября 2018

Построение горизонтальных линий

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

Выражение

density_lines <- ingredients %>%
  group_by(group) %>% filter(density == mean(density)) %>% ungroup()

возвращает пустой набор данных, поскольку нет записи, в которой значение density точно соответствует mean(density).

Однако оно работает для общего максимума (но не для всехлокальные максимумы)

density_lines <- ingredients %>%
  group_by(group) %>% filter(density == max(density)) %>% ungroup()

, что дает

Найти ближайшее значение

Поскольку точно не существуетсовпадение, ближайшее значение может быть выбрано

density_lines <- ingredients %>%
  group_by(group) %>% 
  top_n(1, -abs(density - mean(density)))

, которое отображается как

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

density_lines <- ingredients %>%
  group_by(group) %>% 
  top_n(4, -abs(density - mean(density)))

мы получаем

Вы можете поиграть с параметром n до top_n(), но ИМХОправильным способом было бы сгруппировать каждую грядовую линию от вершины до долины и от долины до вершины, чтобы получить по одному сегменту для каждой из ветвей кривой.

Найти значение поблизости

В качестве альтернативы, мы можем отфильтровать, используяnear() функция.Эта функция требует указать допуск tol, который нам нужно вычислить из набора данных:

density_lines <- ingredients %>%
  group_by(group) %>% 
  filter(near(
    density, mean(density), 
    tol = ingredients %>% summarise(0.25 * max(abs(diff(density)))) %>% pull()
  ))

Для тщательно выбранного коэффициента 0.25 (проб и ошибок) мы получаем

РЕДАКТИРОВАТЬ: Построение вертикальных линий

Кажется, я неправильно истолковал намерения ОП.Теперь мы попытаемся построить вертикальную линию в mean(density), используя geom_hline (с coord_flip(), geom_hline() создает вертикальную линию).

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

# create plot object
Fig1 <- ggplot(Figure3Data,  aes(x = hairchange, y = EffortGroup)) +
  geom_density_ridges_gradient(aes(fill = ..x..), scale = 0.9, size = 1) +
  scale_fill_gradientn(
    colours = c("#0000FF", "#FFFFFF", "#FF0000"),
    name =
      NULL,
    limits = c(-2, 2)
  ) + coord_flip() +
  theme_ridges(
    font_size = 20,
    grid = TRUE,
    line_size = 1,
    center_axis_labels = TRUE
  ) +
  scale_x_continuous(name = 'Average Self-Perceived Hair Change', limits =
                       c(-2, 2)) +
  ylab('Total SSM Effort (hours)')

# extract plot data and summarise
mean_density <- 
  ggplot_build(Fig1) %>% 
  purrr::pluck("data", 1) %>%
  group_by(group) %>% 
  summarise(density = mean(density), scale = first(scale), iscale = first(iscale))

# add hline and plot
Fig1 +
  geom_hline(aes(yintercept = group + density * scale * iscale),
             data = mean_density)

РЕДАКТИРОВАНИЕ 2: Постройте горизонтальные линии в положении среднего значения самовоспринимаемое изменение волос

У ОП выяснено , что

Я хочу, чтобы было среднее само воспринимаемое изменение волос (данные оси y) для каждой из 10 линий гребня.

Это может быть достигнуто следующими шагами:

Создание объекта ridgeplot.
Вычисление среднего самовоспринимаемого изменения волос для каждогоEffortGroup.
Выберите значения созданных значений плотности из данных графика.
Объедините оба набора данных.
Вычислите значения плотности в местах расположения сред, используяapprox()
Нарисуйте отрезки линии.

Среднее значение самовоспринимаемые волосы change для каждого EffortGroup вычисляется как

Figure3Data %>% 
  group_by(EffortGroup) %>% 
  summarise(x_mean = mean(hairchange))

, что дает (для отправленного подмножества данных OP):

  EffortGroup x_mean
  <chr>        <dbl>
1 <5          -0.643
2 12.5        -0.143

Все шаги вместе:

# create plot object
Fig1 <- ggplot(Figure3Data,  aes(x = hairchange, y = EffortGroup)) +
  geom_density_ridges_gradient(aes(fill = ..x..), scale = 0.9, size = 1) +
  scale_fill_gradientn(
    colours = c("#0000FF", "#FFFFFF", "#FF0000"),
    name = NULL,
    limits = c(-2, 2)) + 
  coord_flip() +
  theme_ridges(
    font_size = 20,
    grid = TRUE,
    line_size = 1,
    center_axis_labels = TRUE) +
  scale_x_continuous(name = 'Average Self-Perceived Hair Change', 
                     limits = c(-2, 2)) +
  ylab('Total SSM Effort (hours)')

density_lines <-
  Figure3Data %>% 
  group_by(EffortGroup) %>% 
  summarise(x_mean = mean(hairchange)) %>% 
  mutate(group = as.integer(factor(EffortGroup))) %>% 
  left_join(ggplot_build(Fig1) %>% purrr::pluck("data", 1), 
            on = "group") %>% 
  group_by(group) %>%
  summarise(x_mean = first(x_mean), 
            density = approx(x, density, first(x_mean))$y, 
            scale = first(scale), 
            iscale = first(iscale))

# add segments and plot
Fig1 +
  geom_segment(aes(x = x_mean,
                   y = group,
                   xend = x_mean,
                   yend = group + density * scale * iscale),
               data = density_lines)

РЕДАКТИРОВАТЬ 3: Изменить порядок горизонтальной оси

ОП имеет попросил изменить порядок горизонтальной оси соответствующим образом.Это можно сделать, предварительно принудив EffortGroup от типа character к factor, если уровни факторов явно указаны в ожидаемом порядке:

# turn EffortGroup into factor with levels in desired order
lvls <- c("<5", "12.5", "22.5", "35", "50", "75", "105", "152", "210", "210+")
Figure3Data <- 
  Figure3Data %>% 
  mutate(EffortGroup = factor(EffortGroup, levels = lvls))

В качестве альтернативы, EffortGroup можно получить непосредственно изданные Effort значения

# create Effort Group from scratch
lvls <- c("<5", "12.5", "22.5", "35", "50", "75", "105", "152", "210", "210+")
brks <- c(-Inf, 5, 12.5, 22.5, 35, 50, 75, 105, 152, 210, Inf)
Figure3Data <- 
  Figure3Data %>% 
  mutate(EffortGroup = cut(Effort, brks, lvls, right = FALSE))

В любом случае , вычисление density_lines должно быть изменено, так как EffortGroup уже является фактором:

density_lines <-
  Figure3Data %>% 
  group_by(EffortGroup) %>% 
  summarise(x_mean = mean(hairchange)) %>% 
  mutate(group = as.integer(EffortGroup)) %>%   # remove call to factor() here
  left_join( ...

С полным набором данных, предоставленным OP (ссылка) график, наконец, становится

Расположениесреднее самоочевидное изменение волос для каждого EffortGroup определяется как

Figure3Data %>% 
  group_by(EffortGroup) %>% 
  summarise(x_mean = mean(hairchange))

# A tibble: 10 x 2
   EffortGroup  x_mean
   <fct>         <dbl>
 1 <5          -0.643 
 2 12.5        -0.393 
 3 22.5        -0.118 
 4 35          -0.0606
 5 50           0.286 
 6 75           0     
 7 105          0.152 
 8 152          0.167 
 9 210          0.379 
10 210+         0.343

Добавление среднего значения для geom_density_ridges

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Построение горизонтальных линий

Найти ближайшее значение

Найти значение поблизости

РЕДАКТИРОВАТЬ: Построение вертикальных линий

РЕДАКТИРОВАНИЕ 2: Постройте горизонтальные линии в положении среднего значения самовоспринимаемое изменение волос

РЕДАКТИРОВАТЬ 3: Изменить порядок горизонтальной оси

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Добавление среднего значения для geom_density_ridges

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Построение горизонтальных линий

Найти ближайшее значение

Найти значение поблизости

РЕДАКТИРОВАТЬ: Построение вертикальных линий

РЕДАКТИРОВАНИЕ 2: Постройте горизонтальные линии в положении среднего значения самовоспринимаемое изменение волос

РЕДАКТИРОВАТЬ 3: Изменить порядок горизонтальной оси

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы