Блог

У меня есть набор данных с командами Формулы-1 и набранными ими очками с начала с 203 строками.

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

Найдите данные ниже. Код, который я использую для построения графика до сих пор:

 ggplot(data=top_constructors[1:input$top1,], aes(x=reorder(name, total_points), y=total_points, fill=name))   
      geom_bar(stat = "identity")  
      coord_flip()  
      xlab("Constructor")  
      ylab("Total points")  
      scale_fill_manual(values=c("#999999", "#E69F00", "#56B4E9", rep("black", 200)))
 

Приведенный выше код раскрашивает 3 первых значения в алфавитном порядке, и я хотел бы установить определенные цвета для определенных команд, например. красный для Ferrari и т.д.

Спасибо за вашу помощь.

dput(top_constructors) дает такой вывод:

 structure(list(name = c("Ferrari", "Mercedes", "McLaren", "Red Bull", 
"Williams", "Renault", "Force India", "Team Lotus", "Benetton", 
"Tyrrell", "Lotus F1", "Brabham", "Sauber", "BRM", "Toro Rosso", 
"Ligier", "Cooper-Climax", "Maserati", "BMW Sauber", "Jordan", 
"Racing Point", "Lotus-Climax", "Alfa Romeo", "Toyota", "BAR", 
"Lotus-Ford", "Haas F1 Team", "Brabham-Repco", "Brawn", "Honda", 
"March", "McLaren-Ford", "Arrows", "Kurtis Kraft", "Matra-Ford", 
"Vanwall", "AlphaTauri", "Cooper-Maserati", "Wolf", "Brabham-Climax", 
"Brabham-Ford", "Shadow", "Surtees", "Matra", "Cooper", "Porsche", 
"Jaguar", "Hesketh", "Stewart", "Fittipaldi", "Epperly", "Minardi", 
"March-Ford", "Watson", "Prost", "Lotus-BRM", "Lola", "Toleman", 
"Footwork", "Gordini", "Talbot-Lago", "Penske", "Larrousse", 
"Kuzma", "Cooper-BRM", "Ensign", "Brabham-Alfa Romeo", "Connaught", 
"Dallara", "Brabham-BRM", "Eagle-Weslake", "BRP", "Lesovsky", 
"Deidt", "Shadow-Ford", "Lancia", "Leyton House", "ATS", "Phillips", 
"Onyx", "Rial", "Parnelli", "Iso Marlboro", "McLaren-BRM", "Osella", 
"Simca", "Super Aguri", "Eagle-Climax", "Embassy Hill", "Frazer Nash", 
"Sherman", "Cooper-Castellotti", "AGS", "Zakspeed", "Theodore", 
"HWM", "Schroeder", "Marussia", "Spyker", "Tecno", "Trevis", 
"McLaren-Serenissima", "Manor Marussia", "MF1", "Spyker MF1", 
"Forti", "Pacific", "Simtek", "Fondmetal", "Andrea Moda", "Lambo", 
"Coloni", "Euro Brun", "Life", "RAM", "Spirit", "Merzario", "Kauhsen", 
"Rebaque", "Martini", "LEC", "McGuire", "Boro", "Apollon", "Kojima", 
"Maki", "Lyncar", "Trojan", "Amon", "Token", "Politoys", "Connew", 
"Bellasi", "De Tomaso", "LDS", "Protos", "Shannon", "Scirocco", 
"RE", "Derrington", "Gilby", "Stebro", "Emeryson", "ENB", "JBW", 
"Ferguson", "MBM", "Behra-Porsche", "Scarab", "Meskowski", "Christensen", 
"Ewing", "Aston Martin", "Moore", "Dunn", "Elder", "Sutton", 
"Fry", "Tec-Mec", "Alta", "OSCA", "Stevens", "Bugatti", "Pawl", 
"Pankratz", "Arzani-Volpini", "Nichels", "Bromme", "Klenk", "Turner", 
"Del Roy", "Veritas", "BMW", "EMW", "AFM", "ERA", "Aston Butterworth", 
"Cisitalia", "Hall", "Marchese", "Langley", "Rae", "Olson", "Wetteroth", 
"Adams", "Snowberger", "Milano", "HRT", "Virgin", "Cooper-OSCA", 
"Cooper-Borgward", "Lotus-Maserati", "De Tomaso-Osca", "De Tomaso-Alfa Romeo", 
"Lotus-Borgward", "Cooper-Alfa Romeo", "De Tomaso-Ferrari", "LDS-Climax", 
"LDS-Alfa Romeo", "Cooper-Ford", "Cooper-Ferrari", "Cooper-ATS", 
"BRM-Ford", "McLaren-Alfa Romeo", "March-Alfa Romeo", "Lotus-Pratt amp;amp; Whitney", 
"Shadow-Matra", "Lotus", "Caterham"), total_points = c(9292.77, 
5824.14, 5723.5, 5043.5, 3567, 1777, 1098, 995, 861.5, 711, 706, 
631, 557, 537.5, 500, 388, 336.5, 313.14, 308, 291, 283, 281, 
279, 278.5, 227, 209, 200, 175, 172, 156, 148, 143, 142, 130, 
130, 108, 107, 83, 79, 78, 68, 59, 54, 54, 52, 50, 49, 48, 47, 
44, 44, 38, 37, 36, 35, 29, 27, 26, 25, 25, 25, 23, 22, 21, 20, 
19, 18, 17, 15, 13, 13, 11, 10, 10, 9.5, 9, 8, 7, 7, 6, 6, 6, 
6, 6, 5, 5, 4, 4, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0)), row.names = c(NA, -209L), class = c("tbl_df", "tbl", "data.frame"
))
 

Вы могли бы определить именованные цвета (или просто подмножество с указанными цветами) и использовать scale_fill_identity :

 library(ggplot2)
library(dplyr)
topN <- 30 # limit graph to the 30 teams with most points
t2020 <- c("Mercedes", "Red Bull", "McLaren", "Racing Point", "Renault", "Ferrari",
           "AlphaTauri", "Alfa Romeo", "Haas F1 Team", "Williams") # 2020 teams
top_constructors <- mutate(top_constructors, active_in_2020 = ifelse(name %in% t2020, T, F))
rest <- filter(top_constructors, !active_in_2020)$name # non-2020 teams
teamcolors <- c(setNames(scales::hue_pal()(length(t2020)), t2020),
                setNames(rep("black", length(rest)), rest)) # only color 2020 teams
teamcolors[c("Ferrari", "Mercedes")] <- c("red", "grey70") # change colors for some teams                   
arrange(top_constructors, desc(total_points)) %>% 
  slice_head(n=topN) %>%
  mutate(name=factor(name, name), 
         clr=teamcolors[as.character(name)]) %>% 
  ggplot(aes(x=name, y=total_points, fill=clr))  
  geom_col() 
  scale_x_discrete(limits=rev)   
  coord_flip()  
  labs(x="Constructor", y="Total points")  
  scale_fill_identity()
 

^{Создано 2020-12-22 пакетом reprex (версия 0.3.0)}

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

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

 library(gghighlight)

top1 <- 10 # looks like you're calling input$top1 for this value but didn't share it

top_constructors %>%
  slice_max(order_by = total_points, n = top1) %>%
  ggplot(aes(
    x = reorder(name, total_points),
    y = total_points,
    fill = name
  ))  
  geom_col()   
  gghighlight::gghighlight(
    total_points,
    max_highlight = 3,
    unhighlighted_params = list(fill = alpha("black", 0.4))
  )  
  scale_fill_manual(values = c("#FF0000", "#E69F00", "#56B4E9"))  
  coord_flip()  
  xlab("Constructor")  
  ylab("Total points") 
 

Это приводит к следующему графику:

Несколько замечаний:

1. Вы просили раскрасить все не выделенные строки "black" , поэтому я ввел unhighlighted_params аргумент, чтобы вы могли видеть, как это контролировать, но альфа была просто для примера.
2. Вы упомянули, что Ferrari должна быть "red" , поэтому я изменил предоставленные вами цвета вручную.
3. При использовании gghighlight вам нужно только предоставить достаточное количество цветов для выделенных столбцов scale_fill_manual . Однако, если вы укажете меньше, чем количество выделенных столбцов, это выдаст ошибку.