Combiner des histogrammes

Cette semaine, le #Tidytuesday traite des remboursements des prêts étudiants aux États-Unis. J’ai choisi de visualiser le tout avec des pourcentages pour représenter l’évolution du remboursement de cette dette.



CONTEXTE

Les données de cette semaine proviennent de Department of Education des États-Unis et nous sont partagées par Dignity and Debt.



OBJECTIFS

  1. Calculer le montant total de la dette et le pourcentage de la dette qui est remboursée à chaque trimestre.
  2. Visualiser l’évolution dans le temps



IMPORTER

loans <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-11-26/loans.csv")
FALSE Parsed with column specification:  
FALSE cols(  
FALSE   agency_name = col_character(),  
FALSE   year = col_double(),  
FALSE   quarter = col_double(),  
FALSE   starting = col_double(),  
FALSE   added = col_double(),  
FALSE   total = col_double(),  
FALSE   consolidation = col_double(),  
FALSE   rehabilitation = col_double(),  
FALSE   voluntary_payments = col_double(),  
FALSE   wage_garnishments = col_double()  
FALSE 
)



EXPLORER

summary(loans)
##  agency_name             year          quarter         starting          
##  Length:291         Min.   :15.00   Min.   :1.000   Min.   :4.964e+07    
##  Class :character   1st Qu.:16.00   1st Qu.:1.500   1st Qu.:9.311e+08    
##  Mode  :character   Median :17.00   Median :2.000   Median :2.801e+09    
##                     Mean   :16.74   Mean   :2.543   Mean   :3.878e+09    
##                     3rd Qu.:17.00   3rd Qu.:4.000   3rd Qu.:6.615e+09    
##                     Max.   :18.00   Max.   :4.000   Max.   :1.119e+10    
##                                                     NA's   :9            
##      added               total           consolidation       
##  Min.   :2.918e+08   Min.   :   212828   Min.   :   74574    
##  1st Qu.:5.430e+08   1st Qu.: 32888118   1st Qu.: 2977484    
##  Median :9.127e+08   Median : 72669212   Median : 9508287    
##  Mean   :1.305e+09   Mean   :106005716   Mean   :14950255    
##  3rd Qu.:1.652e+09   3rd Qu.:167945568   3rd Qu.:23702274    
##  Max.   :9.459e+09   Max.   :395249672   Max.   :52340470    
##  NA's   :160                                                 
##  rehabilitation      voluntary_payments wage_garnishments   
##  Min.   :      -26   Min.   :   19833   Min.   :     517    
##  1st Qu.: 24843043   1st Qu.: 1270194   1st Qu.: 2527537    
##  Median : 54501827   Median : 3464174   Median : 6317306    
##  Mean   : 81592767   Mean   : 4590299   Mean   : 7956659    
##  3rd Qu.:123045718   3rd Qu.: 8019843   3rd Qu.:11321348    
##  Max.   :337310727   Max.   :14687278   Max.   :28107801    
##  NA's   :11



PRÉPARER

data <- loans %>%
    group_by(year, quarter) %>%
    summarise(dette=sum(starting, na.rm=TRUE),
              remboursement=sum(total, na.rm=TRUE)) %>% 
    mutate(pourcentage=(remboursement/dette),
           aug_dette=(dette/113325957209)) %>%
    ungroup() %>%
    add_column(cent=20) %>%
    unite(annee, "cent", "year", sep="") %>%
    unite(date, annee, quarter, sep="-")



VISUALISER

#Graphique  
gg<- ggplot(data=data,aes(x = date, y=aug_dette, group=1))  
gg <- gg +  geom_bar(stat="identity", width = 0.75, fill="#C8C8C8")  
gg <- gg +  geom_bar(aes(x=date, y=pourcentage),stat="identity", width = 0.60, fill="#FB5012")  
#retirer la légende  
gg <- gg +  theme(legend.position = "none")  
#ajuster les axes  
gg<-gg + scale_y_continuous(breaks=seq(0,1,0.20), limits=c(0, 1), labels=scales::percent)  
#ajouter les étiquettes  
gg<-gg + geom_text(data=data, aes(x=date, y=pourcentage, label=paste0(round(data$pourcentage*100,1),"%", sep="")),                       color="#FB5012", size=3, position = position_stack(vjust = 2.5), fontface="bold")  
#retourner le graphique  
gg<-gg + coord_flip()  
#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.5, color = "#C8C8C8", linetype = "dotted"),
                      panel.grid.major.y= element_blank(),
                      panel.grid.minor = element_blank(),
                      axis.line.x = element_blank(),
                      axis.line.y =element_blank(),
                      axis.ticks.x = element_blank(),
                       axis.ticks.y = element_blank())  
#ajouter les titres  
gg<-gg + labs(title="Les <span style='color:#C8C8C8'>**prêts étudiants**</span> augmentent mais pas le <span style='color:#FB5012'>**remboursement**</span>",
                subtitle = "\nLe montant des prêts étudiants a augmenté de 47% aux États-Unis, mais le remboursement a diminué de 0.8%.\n",
              x=" ",
              y=" ",
              caption="\nSOURCE: US Department of Education   |  DESIGN: Johanie Fournier, agr.")  
gg<-gg + theme(  plot.title    =  element_markdown(lineheight = 1.1,size=17.8, hjust=1,vjust=0.5, face="bold", color="#333333"),                   plot.subtitle = element_text(size=10.3, hjust=1,vjust=0.5, color="#333333"),
                 plot.caption  = element_text(size=10, hjust=1,vjust=0.5, color="#333333"),
                 axis.title.y  = element_blank(),                   axis.title.x  = element_blank(),
                 axis.text.y   = element_text(size=12, hjust=0,vjust=0.5, color="#333333"),
                 axis.text.x   = element_text(size=12, hjust=0.5,vjust=0.5, color="#333333"))

Voici ce que ça donne:





CONCLUSION

Finalement, on voit bien que le remboursement ne suit pas l’évolution de la dette.

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.

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.