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
- 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
- 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.
Pingback: ADV13 - Faciliter la compréhension d’un visuel complexe | Johanie Fournier, agr.