Программного способ сюжета суб события топа-событий с использованием ggplot: R

Question

У меня есть ФР так:

library(dplyr) 
library(data.table) 
library(ggplot2) 
library(scales) 

Events <- c("A_1","A_2","A_3","B_1","B_2","B_3","C_1","C_2","C_3","D_1","D_2","D_3","E_1","E_2","E_3") 
Percentage_Occur <- c(4.6,6.5,1.3,3.4,6.6,5.5,7.8,2.2,2.4,2.1,6.6,5.9,4.9,11.1,4.3) 
df1 <- data.frame(Events,Percentage_Occur) 

Я пытаюсь объединяет эти подпункты события в отдельную категорию, чтобы определить верхние 3 события и, следовательно, я это делаю как это:

df2 <- data.frame(df1) 
df2$Events <- gsub("*_.*", "\\1", df2$Events) 
df2 <- df2 %>% group_by(Events) %>% summarise_each(funs(sum(., na.rm = T))) 
df2 <- df2[ order(-df2[,2]), ] 

ggplot(df2, aes(reorder(Events,Percentage_Occur), Percentage_Occur)) + 
    geom_bar(stat = "identity") + coord_flip() + 
    xlab("Events") 

После того, как я могу представить себе лучшие 3 события (в данном случае они являются E, B, D), я хотел бы построить суб события этих верхней 3events в отдельном участке, подобном этому.

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

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

Примечание: Я также хотел бы иметь лучшие цвета.

Answer 1

Для того, чтобы автоматически извлечь первые 3 события, вы можете обрабатывать данные с:

library(data.table) 
library(splitstackshape) 

dt <- cSplit(df1, "Events", sep="_", drop=FALSE)[, tot := sum(Percentage_Occur), Events_1 
               ][order(-tot,Events_1,-Percentage_Occur) 
                ][, top := rleid(tot) 
                ][top <= 3] 

А потом с помощью scale_fill_manual и reorder(), вы получите участок с более хорошими цветами & также заказанные баров в пределах группы:

# create a vector for the labels of the events in the legend 
# this is needed to get the legend in the right order 
lbls <- dt$Events 

# create the plot 
ggplot(dt, aes(x=reorder(Events_1,-tot), y=Percentage_Occur, fill=reorder(Events,-Percentage_Occur), color="black")) + 
    geom_bar(stat="identity", position = position_dodge(width=0.8), width=0.7) + 
    geom_text(aes(y=1, label=Events), position = position_dodge(width=0.8), angle=90) + 
    labs(title="Occurence by Event", x="Events", y="Percentage Occurance") + 
    scale_color_manual(values = "black") + 
    scale_fill_manual("Events", breaks = lbls, 
        values = c('#d53e4f','#3288bd','#fee08b','#ffffbf','#66c2a5','#f46d43','#fdae61','#abdda4','#e6f598')) + 
    guides(color=FALSE) + 
    theme_minimal() 

что приведет к:

Вы можете адаптировать значения цветов в scale_fill_manual к вашим пожеланиям.

---

Подготовка данных также может быть сделано с dplyr/tidyr (хотя вы по-прежнему необходимо data.table для rleid функции):

library(dplyr) 
library(tidyr) 
library(data.table) 

df1 <- df1 %>% separate(Events, c("Event","Subevent"), sep="_", remove=FALSE) %>% 
    ungroup() %>% 
    group_by(Event) %>% 
    mutate(tot = sum(Percentage_Occur)) %>% 
    ungroup() %>% 
    arrange(-tot,-Percentage_Occur) %>% 
    mutate(top = rleid(tot)) %>%  # for this part you need data.table 
    filter(top <= 3)