‘bullet graph’ ou graphique à puce

/ Johanie Fournier, agr.

Au menu, visualisation des données avec un graphique à puce ou bullet graph. Le #Tidytuesday de cette semaine concerne les empereurs romains. Je visualise donc les règnes des différents empereurs en fonction de leur âge avec un graphique à puce.



CONTEXTE

Les données de cette semaine sont disponible sur wikipedia. L’article de blog qui a inspiré le sujet de cette semaine peut être consulté ici.

L’empereur Auguste fut le premier empereur romain en 27 av. Il a mis fin au règne républicain à Rome. Pendant les années qui suivirent, le territoire sous le commandement de l’empereur occupant la majeure partie de l’Europe et des parties de l’Afrique du Nord et de l’Asie occidentale.



OBJECTIFS

  1. Calculer l’âge du début du règne, de la fin du règne et l’âge du décès de chaque empereur
  2. Visualiser le règne de chaque empereur selon son age avec un graphique à puce ou bullet graph



IMPORTER

emperors <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-08-13/emperors.csv")
FALSE Parsed with column specification:  
FALSE cols(  
FALSE   index = col_double(),  
FALSE   name = col_character(),  
FALSE   name_full = col_character(),  
FALSE   birth = col_date(format = ""),  
FALSE   death = col_date(format = ""),  
FALSE   birth_cty = col_character(),  
FALSE   birth_prv = col_character(),  
FALSE   rise = col_character(),  
FALSE   reign_start = col_date(format = ""),  
FALSE   reign_end = col_date(format = ""),  
FALSE   cause = col_character(),  
FALSE   killer = col_character(),  
FALSE   dynasty = col_character(),  
FALSE   era = col_character(),  
FALSE   notes = col_character(),  
FALSE   verif_who = col_character()  
FALSE 
)



EXPLORER

glimpse(emperors)
## Observations: 68  
## Variables: 16  
## $ index       <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1…  
## $ name        <chr> "Augustus", "Tiberius", "Caligula", "Claudius", "Ner…  
## $ name_full   <chr> "IMPERATOR CAESAR DIVI FILIVS AVGVSTVS", "TIBERIVS C…  
## $ birth       <date> 0062-09-23, 0041-11-16, 0012-08-31, 0009-08-01, 003…  
## $ death       <date> 0014-08-19, 0037-03-16, 0041-01-24, 0054-10-13, 006…  
## $ birth_cty   <chr> "Rome", "Rome", "Antitum", "Lugdunum", "Antitum", "T…  
## $ birth_prv   <chr> "Italia", "Italia", "Italia", "Gallia Lugdunensis", …  
## $ rise        <chr> "Birthright", "Birthright", "Birthright", "Birthrigh…  
## $ reign_start <date> 0026-01-16, 0014-09-18, 0037-03-18, 0041-01-25, 005…  
## $ reign_end   <date> 0014-08-19, 0037-03-16, 0041-01-24, 0054-10-13, 006…  
## $ cause       <chr> "Assassination", "Assassination", "Assassination", "…  
## $ killer      <chr> "Wife", "Other Emperor", "Senate", "Wife", "Senate",…  
## $ dynasty     <chr> "Julio-Claudian", "Julio-Claudian", "Julio-Claudian"…  
## $ era         <chr> "Principate", "Principate", "Principate", "Principat…  
## $ notes       <chr> "birth, reign.start are BCE. Assign negative for cor…  
## $ verif_who   <chr> "Reddit user zonination", "Reddit user zonination", …

Toutes les dates sont stockées sous le bon format, reste juste à calculer les âges. Attention ici, ce sont des dates de avant Jésus-Christ, à prendre en considération dans les calculs.



PRÉPARER:

data<-emperors %>%
     mutate(annee_naiss=year(birth)) %>%
     mutate(annee_mort=year(death)) %>%
     mutate(annee_deb=year(reign_start)) %>%
     mutate(annee_fin=year(reign_end)) %>%
     mutate(age_mort=abs(annee_mort-annee_naiss)) %>%
     mutate(age_deb=abs(annee_deb-annee_naiss)) %>%
     mutate(age_fin=abs(annee_fin-annee_naiss)) %>%
     mutate(duree=abs(age_fin-age_deb)) %>%
     mutate(remove=ifelse(age_deb==age_mort, 'retirer', NA)) %>%
     filter(!age_mort %in% NA,!age_deb %in% NA,!age_fin %in% NA,
            !age_mort %in% 4, !remove %in% "retirer") %>%
     select(name, age_deb, age_fin, age_mort, duree)



VISUALISER:

#Graphique  
gg<-ggplot(data, aes(x=reorder(name, -age_mort), y=age_mort))  
gg <- gg + geom_bar(stat="identity", position="stack", width=0.65, fill="#6D7C83", alpha=0.4)  
gg <- gg + geom_segment(aes(y = age_deb,
                            x = name,
                            yend = age_fin,
                            xend = name),
                            color = "#175676",
                            size=2.3, 
                            alpha=0.8)   
gg <- gg + geom_errorbar(aes(y=age_mort, x=name, ymin=age_mort, ymax=age_mort), color="black", width=0.85)   
gg <- gg + geom_point(aes(name, age_mort), colour="black", size=0.75)   
gg <- gg + coord_flip()  
#ajuster les axes   
gg <- gg + scale_y_continuous(breaks=seq(0,80,10), limits = c(0,80))  
gg <- gg + expand_limits(x=c(0, 56))  
#modifier le thème  
gg <- gg +  theme(panel.border = element_blank(),
                      panel.background = element_blank(),
                      plot.background = element_blank(),
                      panel.grid.major.x= element_line(size=0.2,linetype="dotted", color="#6D7C83"),
                      panel.grid.major.y= 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=" ",
              subtitle="",
              y=" ",
              x=" ")  
gg<-gg + theme(plot.title    = element_blank(),
                   plot.subtitle = element_blank(),
                   axis.title.y  = element_blank(),
                   axis.title.x  = element_blank(),
                   axis.text.y   = element_text(hjust=1, vjust=0.5, size=12, color="#6D7C83", face="bold"),
                    axis.text.x   = element_text(hjust=0.5, vjust=0, size=12, color="#6D7C83", face="bold"))  
#Faire des flèches  
arrows <- tibble(    
x1 = c(50, 16, 53.5, 53.5, 53.5),    
x2 = c(49, 15,   51,   51,   51),    
y1 = c(35, 70,    5,   25,   40),    
y2 = c(22, 61,    0,   13,   19)  
)  
gg<-gg +    geom_curve(data = arrows, aes(x = x1, y = y1, xend = x2, yend = y2),
                              arrow = arrow(length = unit(0.1, "inch")),
                              size = 0.3, color = "#6D7C83", curvature = -0.3)  
#ajouter les étiquettes de données  
gg<-gg + annotate(geom="text", x=50,y=35, label="Le plus jeune à\ndevenir Empereur", color="#6D7C83", size=3, hjust=0,vjust=0.5, fontface="bold")  
gg<-gg + annotate(geom="text", x=18,y=70, label="Son reigne\na pris fin\navant\nson décès", color="#6D7C83", size=3, hjust=0.5,vjust=0.5, fontface="bold")  
gg<-gg + annotate(geom="text", x=54,y=5, label="Naissance", color="#6D7C83", size=3, hjust=0.5,vjust=0.5, fontface="bold")  
gg<-gg + annotate(geom="text", x=55,y=25, label="Début du\nreigne", color="#6D7C83", size=3, hjust=0.5,vjust=0.8, fontface="bold")
gg<-gg + annotate(geom="text", x=54,y=40, label="Décès", color="#6D7C83", size=3, hjust=0.5,vjust=0.5, fontface="bold")

Voici ce que ça donne:


CONCLUSION:

On constate rapidement que, pour la plupart des empereurs, c’est le décès qui est la cause de la fin du règne et que quand même plusieurs empereurs sont mis en position avant l’âge de 20 ans. De plus, la durée du règne de chaque empereur est variable.

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

Une réflexion sur “‘bullet graph’ ou graphique à puce”

  1. Pingback: ADV13 - Faciliter la compréhension d’un visuel complexe | Johanie Fournier, agr.

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.