Aires sous la courbe

Pour ma troisème participation au #TidyTuesday, nous avons accès aux données des dépenses fédérales en recherche et développement pour les différents département aux États Unis. Ce ne sera surement pas une surprise si je vous dit que mon choix c’est arrêté sur le USDA (Département d’agricutlure des États Unis). Les données brutes sont disponibles sur le site de l’AAAS.


IMPORTER

usda<- read_excel("USDA.xlsx",
                      sheet="Data",
                      range="A3:T12", #conserver seulement les données pertinentes
                      col_names = TRUE, #identifier la première ligne comme nom de colonne
                      col_types = NULL)



PRÉPARER

usda_depenses<-usda%>%
    rename(departement="Fiscal Years", "2018"="2018**")%>% #corriger les noms de colonnes
    filter(!is.na(departement), !departement=="USDA Total R&D")%>% #retirer les lignes vides et la somme
     mutate(departement=ifelse(departement=="AFRI", "National Institute of Food and Agriculture", departement))%>% #modifier le nom 
   mutate(departement=str_replace(departement,"\\*", ""))  %>% #retirer *
    mutate(departement=as.factor(departement)) %>% #additionner les deux ligne pour NIFA
    group_by(departement)%>%
    summarise_all(sum, na.rm=TRUE)%>%
    mutate_at(vars("2000":"2018"), funs(./sum(.)*100)) %>% #générer des pourcentages
    gather(key=annee, value=valeur, -departement) #changer la mise en page pour analyse



EXPLORER

str(usda_depenses)
## Classes 'tbl_df', 'tbl' and 'data.frame':    95 obs. of  3 variables:  
##  $ departement: Factor w/ 5 levels "Agricultural Research Service",..: 1 2 3 4 5 1 2 3 4 5 ...  
##  $ annee      : chr  "2000" "2000" "2000" "2000" ...  
##  $ valeur     : num  51.2 2.45 3.61 12.11 30.64 ...
summary(usda_depenses)
##                                      departement    annee            
##  Agricultural Research Service             :19   Length:95           
##  All Other                                 :19   Class :character    
##  Economic Research Service                 :19   Mode  :character    
##  Forest Service                            :19                       
##  National Institute of Food and Agriculture:19                       
##                                                                      
##      valeur        
##  Min.   : 1.330    
##  1st Qu.: 2.939    
##  Median :12.809    
##  Mean   :20.000    
##  3rd Qu.:39.306    
##  Max.   :57.529

Nous disposons donc de 19 années (2000 à 2018) de données pour lesquels les 5 catégories des dépenses fédérales en recherche et développement sont disponibles. Ancune donnée n’est manquante.


VISUALISER

#Ordonner les départements pour l'affichage dans le graphique
usda_depenses$departement <- factor(usda_depenses$departement,levels=c("Agricultural Research Service","National Institute of Food and Agriculture","Forest Service","Economic Research Service","All Other"))
    
#Graphique  
gg<-ggplot(data=usda_depenses, aes(x=annee, y=valeur, group=departement))  
gg<-gg + geom_line()  
gg<-gg + geom_area(aes(fill=departement))  
gg<-gg + scale_fill_manual(values = c("#1E6583", "#4B93B1", "#73ABC2", "#AFCFDC", "#D7E7ED"))  
#ajuster les axes   
gg<-gg + facet_grid(~departement)  
gg<-gg + scale_y_continuous(breaks=seq(0,60,10), limits = c(0, 60))  
gg<-gg + scale_x_discrete(breaks=c(2000,2018))  
#modifier la légende  
gg<-gg + theme(legend.position="none")  
#modifier le thème  
gg<-gg +theme(panel.border = element_blank(),
                panel.background = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
                plot.background = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
                panel.grid.major.y= element_blank(),
                panel.grid.major.x= element_blank(),
                panel.grid.minor = element_blank(),
                axis.line = element_line(size = 0.5, linetype = "solid", colour = "#8B8B8B"),
                axis.ticks.y = element_line(size=0.5, linetype="solid", colour = "#8B8B8B"),
                axis.ticks.x = element_blank())  
#ajouter les titres  
gg<-gg + labs(subtitle="USDA: Évolution des dépenses en R&D des différents départements depuis 2000",
                y="% du budget annuel")  
gg<-gg + theme(plot.subtitle = element_text(hjust=0,size=20, color="#000000"),
                 axis.title.y  = element_text(hjust=1,size= 10, colour = "#8B8B8B"),
                 axis.title.x  = element_blank(),
                 axis.text.y   = element_text(hjust=0.5,size= 10, colour = "#8B8B8B"),
                  axis.text.x   = element_text(hjust=0.5,size= 6, colour = "#8B8B8B"))

Pour visualiser les données de chaque catégorie et les comparer entre elles, j’ai choisi de présenter les données avec des graphiques linéaires et des aires sous les courbes en les plaçant côte à côte. Pour faciliter la comparaison entre les années, j’ai choisi de présenter le budget de chaque catégorie en pourcentage par rapport au budget total comme on sait que celui-ci change à chaque année.

Sur le graphique, on voit bien l’évolution et l’importance dans le budget de chacune des catégories, mais la visualisation manque d’un petit quelque chose… peut-être attriblable au fait qu’il y a beaucoup d’information. C’est pourquoi j’ai choisi de pousser la visualisation un peu plus loin et de me concentrer sur la comparaison entre les deux postes de dépenses les plus importants. Voici ce que ca donne:

#Sélectionner 2 départements pour second graphique:  
usda_max_dep<-usda_depenses%>%
    filter(departement %in% c("Agricultural Research Service","National Institute of Food and Agriculture"))%>%
    arrange(annee, departement)

#Générer un sous ensemble de données pour faire afficher en couleur la zone entre les deux graphiques  
usda_max_dep_rebon<-usda_max_dep%>%
    group_by(annee)%>%
      mutate(max = max(valeur),
             min = min(valeur))    

#Graphique  
gg<-ggplot(data=usda_max_dep, aes(x=annee, y=valeur, group=departement, color=departement))  
#ajouter la couleur entre les deux lignes  
gg<-gg + geom_ribbon(data=usda_max_dep_rebon,aes(x = annee, ymin= min, ymax = max), fill= "#8B8B8B", alpha = 0.4)  
gg<-gg + geom_line(size=2)  
gg<-gg + scale_color_manual(values = c("#679436", "#427AA1"))  
#ajuster les axes   
gg<-gg + scale_y_continuous(breaks=seq(0,70,10), limits = c(0, 70))  
gg<-gg + scale_x_discrete(breaks=c(2000,2018))  
#modifier la légende  
gg<-gg + theme(legend.position="none")  
#modifier le thème  
gg<-gg +theme(panel.border = element_blank(),
                panel.background = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
                plot.background = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
                panel.grid.major.y= element_blank(),
                panel.grid.major.x= element_blank(),
                panel.grid.minor = element_blank(),
                axis.line = element_blank(),
                axis.ticks.y = element_blank(),
                axis.ticks.x = element_blank())  
#ajouter les titres  gg<-gg + labs(subtitle="USDA: comment on évolué les dépenses en R&D depuis 2000?",
                y="% du budget annuel")  
gg<-gg + theme(plot.subtitle = element_text(hjust=0,size=16, color="#000000"),
                 axis.title.y  = element_text(hjust=0.60,size= 10, colour = "#8B8B8B"),
                 axis.title.x  = element_blank(),
                 axis.text.y   = element_blank(),
                  axis.text.x   = element_text(hjust=0.5,size= 10, colour = "#8B8B8B"))  
#ajouter des étiquettes de données  
gg<-gg + annotate(geom="text", x=1,y=54, label="51%", color="#679436", size=4, hjust=0.5, fontface="bold")  
gg<-gg + annotate(geom="text", x=1,y=27, label="31%", color="#427AA1", size=4, hjust=0.5, fontface="bold")  
gg<-gg + annotate(geom="text", x=19,y=47, label="43%", color="#679436", size=4, hjust=0.5, fontface="bold")  
gg<-gg + annotate(geom="text", x=19,y=39, label="43%", color="#427AA1", size=4, hjust=0.5, fontface="bold")  
gg<-gg + annotate(geom="text", x=3,y=60, label="ARS", color="#679436", size=4, hjust=0.5, fontface="bold")  
gg<-gg + annotate(geom="text", x=3,y=22, label="NIFA", color="#427AA1", size=4, hjust=0.5, fontface="bold")

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.