Visualiser des pourcentages avec un histogramme

/ Johanie Fournier, agr.

Au menu du #Tidytuesday:  pourcentage, histogramme et data viz en noir et blanc toute simple. Est-ce que vous prenez souvent l’avion? Pour ma part, pas vraiment, mais les fois où je l’ai fait je suis vraiment contente de ne pas avoir expérimenté de collision avec des oiseaux. Cette semaine, on regarde le nombre d’impact entre les vols enregistrés aux États-Unis et les animaux sauvages.



CONTEXTE

La base de données de la FAA Wildlife Strike contient les enregistrements des impacts entre les avions et les animaux de la faune qui ont été signalés depuis 1990. La déclaration des impacts se fait sur une base volontaire. Par conséquent, cette base de données ne représente que les informations qui ont été fournies par les compagnies aériennes, les aéroports, les pilotes et les autres sources qui désiraient fournir l’information. Pour simplifier les choses, on travaille seulement avec les données de American Airlines, Delta, Southwest et United, ce qui représentent environ 70% des passagers aux États-Unis.

Pour mettre en perspective ces données, j’ai été sur le site de US departement of transportation pour obtenir le nombre de vols totaux qui out eu lieu aux États-Unis par année depuis 2002.



OBJECTIFS

  1. Visualiser la proportion des vols aux États-Unis qui entrent en collision avec des oiseaux à l’aide d’un histogramme.
  2. Créer une visualisation de données la plus simple possible



IMPORTER

wildlife_impacts <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-07-23/wildlife_impacts.csv")
FALSE Parsed with column specification:  
FALSE cols(  
FALSE   .default = col_character(),  
FALSE   incident_date = col_datetime(format = ""),  
FALSE   num_engs = col_double(), 
FALSE   incident_month = col_double(),  
FALSE   incident_year = col_double(),  
FALSE   time = col_double(),  
FALSE   height = col_double(),  
FALSE   speed = col_double(),  
FALSE   cost_repairs_infl_adj = col_double()  
FALSE )
FALSE See spec(...) for full column specifications.
total_flight <- read_xls("Flights_7_26_2019 2_47_33 PM.xls")



EXPLORER

glimpse(wildlife_impacts)
## Observations: 56,978  
## Variables: 21  
## $ incident_date         <dttm> 2018-12-31, 2018-12-29, 2018-12-29, 2018-…  
## $ state                 <chr> "FL", "IN", "N/A", "N/A", "N/A", "FL", "FL…  
## $ airport_id            <chr> "KMIA", "KIND", "ZZZZ", "ZZZZ", "ZZZZ", "K…  
## $ airport               <chr> "MIAMI INTL", "INDIANAPOLIS INTL ARPT", "U…  
## $ operator              <chr> "AMERICAN AIRLINES", "AMERICAN AIRLINES", …  
## $ atype                 <chr> "B-737-800", "B-737-800", "UNKNOWN", "B-73…  
## $ type_eng              <chr> "D", "D", NA, "D", "D", "D", "D", "D", "D"…  
## $ species_id            <chr> "UNKBL", "R", "R2004", "N5205", "J2139", "…  
## $ species               <chr> "Unknown bird - large", "Owls", "Short-ear…  
## $ damage                <chr> "M?", "N", NA, "M?", "M?", "N", "N", "N", …  
## $ num_engs              <dbl> 2, 2, NA, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…  
## $ incident_month        <dbl> 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12…  
## $ incident_year         <dbl> 2018, 2018, 2018, 2018, 2018, 2018, 2018, …  
## $ time_of_day           <chr> "Day", "Night", NA, NA, NA, "Day", "Night"…  
## $ time                  <dbl> 1207, 2355, NA, NA, NA, 955, 948, NA, NA, …  
## $ height                <dbl> 700, 0, NA, NA, NA, NA, 600, NA, NA, 0, NA…  
## $ speed                 <dbl> 200, NA, NA, NA, NA, NA, 145, NA, NA, 130,…  
## $ phase_of_flt          <chr> "Climb", "Landing Roll", NA, NA, NA, "Appr…  
## $ sky                   <chr> "Some Cloud", NA, NA, NA, NA, NA, "Some Cl…  
## $ precip                <chr> "None", NA, NA, NA, NA, NA, "None", NA, NA…  
## $ cost_repairs_infl_adj <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
summary(wildlife_impacts$incident_year)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.   
##    1990    2001    2009    2008    2015    2018
glimpse(total_flight)
## Observations: 18  
## Variables: 5  
## $ Year          <dbl> 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 20…  
## $ Month         <chr> "TOTAL", "TOTAL", "TOTAL", "TOTAL", "TOTAL", "TOTA…  
## $ DOMESTIC      <dbl> 8085083, 9458818, 9968047, 10038373, 9712750, 9839…  
## $ INTERNATIONAL <dbl> 1023994, 1129990, 1220679, 1267681, 1299209, 13359…  
## $ TOTAL         <dbl> 9109077, 10588808, 11188726, 11306054, 11011959, 1…
summary(total_flight$Year)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.   
##    2002    2006    2010    2010    2015    2019
summary(total_flight$TOTAL)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max.   
##  3227150  9715495  9984400  9800752 10684955 11306054



Pour ce qui est du nombre total de vol réalisés aux États-Unis, on dispose des données de 2002 à 2019. Toutefois, ce ne sont pas des années complètes, on ne peut dont pas les conservées. Avant de faire le travail de visualisation, il faut aussi sélectionner les mêmes périodes dans les deux bases de données.



PRÉPARER:

nb_impact<-wildlife_impacts %>%
    mutate(Year=incident_year) %>%
     select(Year) %>%
     filter(Year >= 2003 & Year <=2018 & !Year %in% NA)%>%
    group_by(Year)%>%
     summarise(nb_impact=dplyr::n())      

nb_vol<-total_flight %>%
    filter(Year >= 2003 & Year <=2018 & !Year %in% NA) %>%
     select(Year, TOTAL) %>%
     left_join(nb_impact,by="Year") %>%
     mutate(pct=(nb_impact/TOTAL*100))



VISUALISER

#Graphique   
gg<-ggplot(data=nb_vol, aes(x = Year, y=pct))  
gg<-gg + geom_bar(stat="identity", position="stack", width=0.80, color="#000505", fill="#000505")  
#Ajouter les étiquettes de données   
gg<-gg + geom_text(data=nb_vol, aes(x=Year, y=pct, label=paste0(round(nb_vol$pct,2),"%", sep="")),
                       color=c("#FFFFFF", "#FFFFFF", "#FFFFFF", "#FFFFFF", "#FFFFFF", "#FFFFFF", "#FFFFFF", "#FFFFFF", "#FFFFFF", "#FFFFFF","#FFFFFF", "#FFFFFF", "#FFFFFF","#FFFFFF", "#FFFFFF", "#FFFFFF" ), size=4, vjust=1.6, family="Calibri", fontface="bold")  
#ajuster les axes   
gg<-gg + scale_y_continuous(breaks=seq(0,0.05,0.01), limits = c(0, 0.05))  
gg<-gg + scale_x_continuous(breaks=seq(2003,2018,1), limits = c(2002.5, 2018.5))  
#modifier le thème  
gg<-gg +theme(panel.border = element_blank(),
                panel.background = element_blank(),
                plot.background = element_blank(),
                panel.grid.major.y= element_blank(),
                panel.grid.major.x= element_blank(),
                panel.grid.minor = element_blank(),
                axis.line.x = element_blank(),
                axis.line.y = element_blank(),
                axis.ticks.y = element_blank(),
                axis.ticks.x = element_blank())  
#ajouter les titres  
gg<-gg + labs(title="Collision des vols US avec les oiseaux\n  ",
                subtitle="Le nombre d'avion qui heurte des oiseaux est passé de 2/10 000 par année en 2003\nà 4/10 000 en 2018. L'année passée, c'est près de 4 500 vols qui sont entrés en\ncollision avec des oiseaux sur le millions de vols qu'il y a eu au États-Unis.\nCependant, la déclaration des collisions se fait sur une base volontaire.",                
y=" ",
                 x=" ")  
gg<-gg + theme(plot.title    = element_text(hjust=0,size=36, color="#000505", face="bold", family="Arial Rounded MT Bold"),
                 plot.subtitle = element_text(hjust=0,size=12, color="#000505"),
                 axis.title.y  = element_blank(),
                 axis.title.x  = element_blank(),
                 axis.text.y   = element_blank(),
                  axis.text.x   = element_text(hjust=0.5, vjust=15, size=12, color="#FFFFFF", face="bold"))



Voici ce que ça donne:

Histogramme

Alors, tu veux en savoir plus sur ma démarche? Un épisode de podcast sera bientôt disponible dans lequel je t’explique toute la réflexion et les concepts de data visualisation qui ont menés à la création de cette viz.

Leave a Reply

This site uses Akismet to reduce spam. Learn how your comment data is processed.