Объединение перекрывающихся групп для включения в сюжет скрипки / коробчатый сюжет в R

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

В частности, на оси x я хотел бы сначала разделить непрерывные данные Sepal.Length на группы: группа A = Sepal.Length ‹4,7, группа B = Sepal.Length 4,7 - 5, группа C = Sepal.Length 5-5,2 и группа D = сепал. длина> 5.2.

Затем я хотел бы нанести четыре скрипки / коробки на оси x, одиночные / перекрывающиеся группы: «B», «A + C», «D», «A + C + D». Ось Y - это просто длина лепестка.

Я также включаю код, чтобы показать размер выборки (n) для каждой скрипки.

Буду признателен за любые предложения. Спасибо.

library(dplyr)
library(ggplot2)
library(ggpubr)
# Define order of violins on x-axis.
order <- c("B", "AC", "D", "ACD")
# Function to display sample size (n) for each violin.
give.n <- function(x){return(c(y = min(Petal.Length), label = length(x)))}
iris %>% 
  filter(Species == "setosa") %>% 
  mutate(sub_a = case_when( Sepal.Length < 4.7~"A",
                        Sepal.Length < 5~ "B",
                        Sepal.Length < 5.2~ "C",
                        TRUE~"D")) %>% 
  mutate(collapsed = c((ifelse(sub_a %in% c("A", "C"), "AC", sub_a)), (ifelse(sub_a %in% c("AC", "D"), "ACD", sub_a)))) %>% 
  ggviolin(iris[iris$Species == "setosa", ], x=collapsed, y=Petal.Length) + scale_x_discrete(limits=order) + stat_summary(fun.data = give.n, geom = "text")

Изменить

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

введите здесь описание изображения


r grouping ggplot2 violin-plot ggpubr
person Sylvia Rodriguez    schedule 23.05.2019    source источник
comment
Можете ли вы добавить текущий сюжет и нарисовать ожидаемый результат в Paint / Word / PPT?   -  person Tung    schedule 23.05.2019
comment
@Tung - Спасибо за вопрос. См. Редактирование выше.   -  person Sylvia Rodriguez    schedule 23.05.2019

Ответы (1)


arrow_upward
3
arrow_downward

Я не вижу, как сделать это как единую цепочку, но вот решение методом перебора, которое использует cut, а затем bind_rows

setosa <- iris %>% filter(Species == "setosa")  %>% 
  mutate(group = cut(Sepal.Length, breaks = c(0, 4.7, 5, 5.2, Inf), labels = c("A", "B", "C", "D"), right = FALSE))

bind_rows(B = setosa %>% filter(group == "B"),
          AC =  setosa %>% filter(group %in% c("A", "C")),
          D =  setosa %>% filter(group == "D"),
          ACD = setosa %>% filter(group %in% c("A", "C", "D")),
          .id = "group2"
          ) %>% 
  mutate(group2 = factor(group2, levels = c("B", "AC", "D", "ACD"))) %>% 
  ggplot(aes(x = group2, y = Petal.Length)) + 
  geom_violin()
person Richard Telford    schedule 23.05.2019
comment
Спасибо, Ричард. Именно на то, на что я надеялся! - person Sylvia Rodriguez; 23.05.2019