Résumer en 2 graphiques


Cette semaine le #Tidytuesday nous fait découvrir les blessures survenues dans les parcs d’attractions aux Texas. Pour avoir une image globale de ces incidents, j’ai choisi de monter un visuel composé de 2 gaphiques.



CONTEXTE

Les données sont disponibles sur le site de data.world.



OBJECTIFS

  1. Créer un visuel qui montre un portrait global des éléments les plus pertinents qu’on retrouve dans les données en utilisant 2 graphiques pour présenter les données.



IMPORTER

tx_injuries <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-09-10/tx_injuries.csv")
FALSE Parsed with column specification:  
FALSE cols(  
FALSE   injury_report_rec = col_double(),  
FALSE   name_of_operation = col_character(),  
FALSE   city = col_character(),  
FALSE   st = col_character(),  
FALSE   injury_date = col_character(),  
FALSE   ride_name = col_character(),  
FALSE   serial_no = col_character(),  
FALSE   gender = col_character(),  
FALSE   age = col_character(),  
FALSE   body_part = col_character(),  
FALSE   alleged_injury = col_character(),  
FALSE   cause_of_injury = col_character(),  
FALSE   other = col_character()  
FALSE 
)
code<-read.csv('~/Documents/ENTREPRISE/Projets R/Tidytuesday/codes_us.csv', header = TRUE, sep=";")



EXPLORER

summary(tx_injuries)
##  injury_report_rec name_of_operation      city            
##  Min.   :  55.0    Length:542         Length:542          
##  1st Qu.: 253.0    Class :character   Class :character    
##  Median : 300.0    Mode  :character   Mode  :character    
##  Mean   : 738.6                                           
##  3rd Qu.: 837.0                                           
##  Max.   :2919.0                                           
##       st            injury_date         ride_name          
##  Length:542         Length:542         Length:542          
##  Class :character   Class :character   Class :character    
##  Mode  :character   Mode  :character   Mode  :character    
##                                                            
##                                                            
##                                                            
##   serial_no            gender              age             
##  Length:542         Length:542         Length:542          
##  Class :character   Class :character   Class :character    
##  Mode  :character   Mode  :character   Mode  :character    
##                                                            
##                                                            
##                                                            
##   body_part         alleged_injury     cause_of_injury     
##  Length:542         Length:542         Length:542          
##  Class :character   Class :character   Class :character    
##  Mode  :character   Mode  :character   Mode  :character    
##                                                            
##                                                            
##                                                            
##     other            
##  Length:542          
##  Class :character    
##  Mode  :character    
##                      
##                      
## 

Toutes les informations nécessaire sont déjà dans la base de donnée mais, pour arriver à faire le visuel que j’ai en tête, il faudra sérieusement nettoyer les données. Les dates sont stockées sous différents formats dans la même colonne. De plus, on devra travailler le texte inclus dans la variable body_part pour obtenir les parties du corps touchées



PRÉPARER

# Corriger le format des dates  
data<-tx_injuries %>%   
mutate(janitor_date = as.numeric(injury_date) %>%         
janitor::excel_numeric_to_date(.),         
lubridate_date = lubridate::mdy(injury_date),         
real_date = coalesce(janitor_date, lubridate_date)) %>%    
select(-injury_date,           
       -janitor_date,
       -lubridate_date) %>%     
unnest_tokens(word, body_part) %>%    
anti_join(stop_words) %>%  
filter(!is.na(real_date),!is.na(word), !gender %in% c("N/A", "n/a")) %>%     
select(real_date, word, gender, st) %>%     
mutate(annee=year(real_date), mois=month(real_date)) 

#Données pour le premier graphique:  
by_country<-data %>%     
mutate(Abbreviation=st) %>%     
left_join(code, by="Abbreviation") %>%     
filter(!State %in% c("Arizona", "Florida")) %>%     
select(-st, -Abbreviation, -gender, -word) %>%     
group_by(mois, annee) %>%     
summarise(nb=dplyr::n())           

#Données pour le deuxième graphique:  
blessure <- data %>%      
group_by(gender, word) %>%       
summarise(nb=dplyr::n()) %>%      
ungroup() %>%      
mutate(gender=ifelse(gender=="m", "M", gender)) %>%       
filter(gender %in% c("M", "F"))%>%     
filter(word %in% c("head", "shoulder", "neck", "ankle", "elbow", "foot", "arm", "mouth", "forearm")) %>%     
mutate(word=ifelse(word=="head","Tête",word))%>%    
mutate(word=ifelse(word=="shoulder","Épaule",word))%>%    
mutate(word=ifelse(word=="neck","Cou",word))%>%    
mutate(word=ifelse(word=="ankle","Cheville",word))%>%    
mutate(word=ifelse(word=="elbow","Coude",word))%>%    
mutate(word=ifelse(word=="foot","Pied",word))%>%    
mutate(word=ifelse(word=="arm","Bras",word))%>%    
mutate(word=ifelse(word=="mouth","Bouche",word))%>%    
mutate(word=ifelse(word=="forearm","Avant-Bras",word))    

blessure_h <- blessure  
blessure_h$nb <- ifelse(blessure_h$gender == "F", blessure_h$nb  * -1, blessure_h$nb)



VISUALISER

#Graphique 1  
gg<-ggplot(by_country, aes(x=factor(mois), y=nb, group=annee, color=factor(annee)))  
gg<-gg + geom_line(size = 2, show.legend = F)   
gg<-gg + geom_point(shape = 21, fill = "#FFFBF4", size = 4, show.legend = F)   
gg<-gg + scale_color_manual(values = c("#406D8C", "#F08805", "#406D8C", "#406D8C", "#406D8C"))  
#étiquette  
gg <- gg +  geom_text(aes(y = 28, x = 4.5),label = "2014", size = 5, family = "Tw Cen MT",  color="#F08805", hjust=0.5, fontface="bold")  
#modifier le thème  
gg <- gg +  theme(panel.border = element_blank(),
                  panel.background = element_rect(fill="#F5F5F5"),
                  plot.background = element_rect(fill ="#F5F5F5"),
                  panel.grid.major.x= element_blank(),
                  panel.grid.major.y= element_blank(),
                  panel.grid.minor = element_blank(),
                  axis.line.x = element_line(size=1, color="#38607A"),
                  axis.line.y = element_line(size=1, color="#38607A"),    
                  axis.ticks = element_blank())  
#ajouter les titres  
gg<-gg + labs(title="<br><span style='color:#F08805'>**Été 2014**</span><span style='color:#38607A'>: il y a eu moins d'incidents dans les parcs.</span>",
              y="nombre d'incidents",
              x="Mois")  
gg<-gg + theme(  plot.title    = element_markdown(lineheight = 1.1,size=23.5, hjust=0,vjust=0, family="Tw Cen MT"),
                 axis.title.y  = element_text(size=14, hjust=1,vjust=0.5, family="Tw Cen MT", color="#38607A")
,                axis.title.x  = element_text(size=14, hjust=0,vjust=0.5, family="Tw Cen MT", color="#38607A"),
                 axis.text.x   = element_text(size=14, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="#38607A"),
                 axis.text.y   = element_text(size=14, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="#38607A"))
#Graphique 2  
female = intToUtf8(9792)  
male = intToUtf8(9794)    
gg<-ggplot(data=blessure_h, aes(x=reorder(word,desc(-abs(nb))), y=nb, fill=gender))   
gg<-gg + geom_bar(stat = "identity", show.legend = F)   
gg<-gg + facet_share(~gender, dir = "h", scales = "free", reverse_num = TRUE)   
gg<-gg + coord_flip()   
gg<-gg + scale_fill_manual(values = c("#406D8C", "#406D8C"))  
#retirer les titres du facet_wrap  
gg<-gg + theme(strip.background = element_blank(),
               strip.text.x = element_blank())  
#Ajouter des étiquettes  
gg<-gg + geom_text(x = 4, y = -30, label = female, hjust = 0.5, size = 25, color = "#38607A",family = "Tw Cen MT", fontface = "bold")   
gg<-gg +   geom_text(x = 4, y = 30, label = male, hjust = 0.5, size = 25, color = "#38607A", family = "Tw Cen MT", fontface = "bold")  
#modifier le thème  
gg <- gg +  theme(panel.border = element_blank(),
                  panel.background = element_rect(fill="#F5F5F5"),
                  plot.background = element_rect(fill ="#F5F5F5"),
                  panel.grid.major.x= element_blank(),
                  panel.grid.major.y= element_blank(),
                  panel.grid.minor = element_blank(),
                  axis.line.x = element_line(size=1, color="#38607A"),
                  axis.line.y = element_line(size=1, color="#38607A"), 
                  axis.ticks = element_blank())  
#ajouter les titres  
gg<-gg + labs(title="\nQuelles sont les parties du corps les plus touchées ?",
              y="nombre d'incidents\n")  
gg<-gg + theme(  plot.title    = element_text(size=23, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="#38607A"),
                 axis.title.x  = element_text(size=14, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="#38607A"),
                 axis.title.y  = element_blank(),
                 axis.text.x   = element_text(size=14, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="#38607A"),
                 axis.text.y   = element_text(size=14, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="#38607A"))

Voici ce que ça donne:





CONCLUSION

Le graphique montre clairement que le nombre d’incidents survenu à l’été 2014 se distingue des autres années et que les parties du corps les plus blessées sont la tête, les épaules et le cou.



Alors, tu veux en savoir plus sur ma démarche? Un épisode de podcast est 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.

Publicités

Laisser un commentaire

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.