Skip to content

Instantly share code, notes, and snippets.

@coulmont
Created January 11, 2021 10:20
Show Gist options
  • Save coulmont/8fbe93a86c452946ccca0490b22e5cf5 to your computer and use it in GitHub Desktop.
Save coulmont/8fbe93a86c452946ccca0490b22e5cf5 to your computer and use it in GitHub Desktop.
Animation : palmarès des prénoms depuis 1900
# Fichier des prénoms, édition 2019 (jusqu'en 2018)
# voir en bas l'animation Charlie avec paris.opendata 2018
library(tidyverse)
library(stringi)
library(scales)
library(hrbrthemes)
library(glue)
library(lubridate)
# nat2019.csv c'est le fichier des prénoms de l'insee , téléchargeable sur le site de l'insee
# https://www.insee.fr/fr/statistiques/2540004?sommaire=4767262
fpn <- read_csv2("nat2019.csv", locale=locale(encoding = "utf8"), na="" )
# il faut ensuite enlever tous les caractères accentués
fpn <- fpn %>% mutate(preusuel = stri_trans_general(preusuel, "Latin-ASCII"))
# probleme des prénoms accentués : faire la somme
fpn <- fpn %>% group_by(sexe,annais,preusuel) %>%
summarize(nombre = sum(nombre))
fpn <- fpn %>% mutate(taille=nchar(preusuel)) # taille des prénoms
# déterminer le rang des prénoms, en ne considérant pas les _PRENOMS_RARES
# rang par sexe
fpn <- fpn %>% mutate(type= (preusuel=="_PRENOMS_RARES")) %>%
group_by(type,annais,sexe) %>%
mutate(rang = rank(-nombre,ties.method = "random") ) %>%
ungroup() %>%
mutate( rang = case_when(preusuel=="_PRENOMS_RARES" ~ as.integer(25000),
TRUE ~ rang ) ) %>%
group_by(annais,sexe) %>% arrange(rang) %>%
mutate(somme_cum=cumsum(nombre), # somme cumulée)
total_cum=sum(nombre)) %>%
mutate(p_cum=somme_cum/total_cum,
p=nombre/sum(nombre)) %>%
ungroup()
# rang pour les 2 sexes
fpn <- fpn %>% mutate(type= (preusuel=="_PRENOMS_RARES")) %>%
group_by(type,annais) %>%
mutate(rang2s = rank(-nombre,ties.method = "random") ) %>%
ungroup() %>%
mutate( rang2s = case_when(preusuel=="_PRENOMS_RARES" ~ as.integer(25000),
TRUE ~ rang2s ) ) %>%
group_by(annais) %>% arrange(rang2s) %>% #### ATTENTION c'est la somme cumulée à partir du rang
mutate(somme_cum2s=cumsum(nombre), # somme cumulée)
total_cum2s=sum(nombre)) %>%
mutate(p_cum2s=somme_cum2s/total_cum2s,
p2s=nombre/sum(nombre)) %>%
ungroup()
fpn$annais <- as.numeric(as.character(fpn$annais))
# animation du top des prénoms
#
library(gganimate)
prenoms <- fpn %>%
# filter(annais %in% c(1949:1960)) %>%
filter(preusuel!="_PRENOMS_RARES") %>%
filter(!is.na(annais)) %>%
select(preusuel,annais,p,sexe) %>%
mutate(preusuel = str_to_title(preusuel),
sexe = ifelse(sexe==1,"garçons","filles")) %>%
group_by(annais,sexe) %>%
mutate(rang = rank(-p,ties.method = "random")) %>% #filter(rang==1) %>% View()
filter(rang<15) %>%
mutate(couleur = case_when(preusuel == "Marie" ~ "pink",
preusuel == "Jeanne" ~ "cornflowerblue",
preusuel == "Madeleine" ~ "red",
preusuel == "Suzanne" ~ "darkolivegreen",
preusuel == "Monique" ~ "darkorange",
preusuel == "Jacqueline" ~ "darkviolet",
preusuel == "Martine" ~ "firebrick1",
preusuel == "Francoise" ~ "lightblue",
preusuel == "Nathalie" ~ "navyblue",
preusuel == "Valerie" ~ "yellow",
preusuel == "Stephanie" ~ "darkgreen",
preusuel == "Sandrine" ~ "chocolate1",
preusuel == "Celine" ~ "darkseagreen",
preusuel == "Emilie" ~ "cornsilk1",
preusuel == "Aurelie" ~ "deepskyblue",
preusuel == "Elodie" ~ "darkgoldenrod1",
preusuel == "Laura" ~ "aquamarine4",
preusuel == "Pauline" ~ "cadetblue",
preusuel == "Lea" ~ "brown1",
preusuel == "Manon" ~ "hotpink3",
preusuel == "Emma" ~ "green4",
preusuel == "Ines" ~ "indianred4",
preusuel == "Louise" ~ "cyan",
preusuel == "Lina" ~ "gray20",
preusuel == "Jade" ~ "dodgerblue",
preusuel == "Simone" ~ "red",
preusuel == "Sophie" ~ "chartreuse3",
preusuel == "Jean" ~ "pink",
preusuel == "Philippe" ~ "cornflowerblue",
preusuel == "Sebastien" ~ "red",
preusuel == "Julien" ~ "darkolivegreen",
preusuel == "Kevin" ~ "darkorange",
preusuel == "Christophe" ~ "darkviolet",
preusuel == "Lucas" ~ "firebrick1",
preusuel == "Gabriel" ~ "lightblue",
preusuel == "Paul" ~ "navyblue",
preusuel == "Leo" ~ "yellow",
preusuel == "Arthur" ~ "darkgreen",
preusuel == "Louis" ~ "chocolate1",
preusuel == "Henri" ~ "darkseagreen",
preusuel == "Jacques" ~ "cornsilk1",
preusuel == "Guy" ~ "deepskyblue",
preusuel == "Pierre" ~ "darkgoldenrod1",
preusuel == "Thomas" ~ "aquamarine4",
preusuel == "Guillaume" ~ "cadetblue",
preusuel == "Michel" ~ "brown1",
preusuel == "Gerard" ~ "hotpink3",
preusuel == "Patrick" ~ "green4",
preusuel == "Thierry" ~ "indianred4",
preusuel == "Stephane" ~ "cyan",
preusuel == "Nicolas" ~ "gray20",
preusuel == "Enzo" ~ "dodgerblue",
preusuel == "Maxime" ~ "red",
preusuel == "Pascal" ~ "chartreuse3",
preusuel == "Dominique" ~ "black",
TRUE ~ "gray")) %>%
mutate(rang = ifelse(rang>10,rang+2,rang))
p <- prenoms %>%
# filter(annais==1900) %>%
ggplot( aes(y=-rang,group=preusuel,fill = I(couleur)) ) +
geom_tile(aes(x = p/2,
width = p,
height = 0.9), alpha = 0.7) +
geom_text(aes(x = p, label = preusuel), adj=-0.1,size=3.6) +
# text in x-axis (requires clip = "off" in coord_cartesian)
geom_text(aes(x = 0, label = preusuel), adj=1.1,size=3.6) +
coord_cartesian(ylim = c(-10.5,-0.5) ) +
scale_x_continuous(labels=scales::percent_format(accuracy=1),
expand=expansion(mult=c(.25,.25))) +
guides(color=F,fill=F) +
facet_wrap(~sexe,scales = "free_y") +
labs(title='Palmarès en {round(frame_time)}', y = NULL,x="Proportion des naissances",
caption = "Données : Insee, Fichier des prénoms. Animation B. Coulmont") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0, size = 22),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
strip.text = element_text(size=15),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
plot.margin = margin(0,0,0,0))
p <- p +
transition_time(annais) +
enter_grow(size = 0) +
exit_shrink(size = 0) +
exit_fade(alpha = 0) +
view_follow(fixed_y=TRUE)
gganimate::animate(p , nframes= 2700, fps= 20,
width=1200,height=676, end_pause = 100,
res = 130,
renderer = av_renderer(glue("~/Desktop/prenom-top-g-f-{today()}.mp4"), codec = "libx264"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment