Pour ma deuxième participation au #TidyTuesday, je n’ai pas pu résister à pousser mon analyse de la production laitière de la semaine dernière plus loin. En effet, après avoir vu que les vaches des États Unis prodisent en moyenne 1143 kg plus que les vaches du Québec, je veux voir où sont ces super vaches.

Les données brutes fournis par le USDA fournissent la moyenne de production laitière des vaches par état. C’est exactement ce qu’il me faut pour savoir dans quel région la production laitière est supérieure à celle du Québec.

IMPORTER

vaches<- read_excel("milkcowsandprod_1_.xlsx",
                       sheet="REGPROD",
                      range="BA5:CY77", #conserver seulement les données pertinentes
                      col_names = TRUE, #identifier la première ligne comme nom de colonne
                      col_types = NULL)

PRÉPARER

#Séparer en 2 tables (Région et États):
  vaches_region<-vaches%>%
    select(-2,-3)%>% #retirer les colonnes non pertinentes    
    rename(region=X__1)%>% #corriger les noms de colonnes     
    filter(!is.na(region))%>% #retirer les lignes vides    
    gather(key=annee, value=valeur, -region) #changer la mise en page pour analyse
    vaches_etat<-vaches%>%    select(-1,-3)%>% #retirer les colonnes non pertinentes
    rename(etat=X__2)%>% #corriger les noms de colonnes    
    filter(!is.na(etat))%>% #retirer les lignes vides    
    gather(key=annee, value=valeur, -etat) #changer la mise en page pour analyse

EXPLORER

str(vaches_region)

## Classes 'tbl_df', 'tbl' and 'data.frame':    528 obs. of  3 variables:  
##  $ region: chr  "Northeast" "Lake States" "Corn Belt" "Northern Plains" ... 
 ##  $ annee : chr  "1970" "1970" "1970" "1970" ...  
##  $ valeur: num  10503 10223 9556 8723 7856 ...

Hmisc::describe(vaches_region$valeur)

## vaches_region$valeur   
##        n  missing distinct     Info     Mean      Gmd      .05      .10   
##      528        0      528        1    15158     4883     9114    10010   
##      .25      .50      .75      .90      .95   
##    11730    14623    18635    21390    22395   
##   
## lowest :  6415.909  6693.396  7044.444  7171.504  7463.687  
## highest: 23775.567 24235.032 24349.891 24537.384 24609.318

str(vaches_etat)

## Classes 'tbl_df', 'tbl' and 'data.frame':    2400 obs. of  3 variables:  
##  $ etat  : chr  "Maine" "New Hampshire" "Vermont" "Massachusetts" ...  
##  $ annee : chr  "1970" "1970" "1970" "1970" ...  
##  $ valeur: num  9984 9889 10155 10967 10870 ...

Hmisc::describe(vaches_etat$valeur)

## vaches_etat$valeur   
##        n  missing distinct     Info     Mean      Gmd      .05      .10   
##     2400        0     2106        1    14921     4612     9306    10176   
##      .25      .50      .75      .90      .95   ##    11706    14376    17829    20808    22378   
##   
## lowest :  5860  6018  6448  6640  6689, highest: 25733 25957 25993 26181 26302

Nous disposons donc de 47 années (1970 à 2017) de données de production laitière pour les différentes régions et états des États Unis. Les données sont sous le bon format pour poursuivre l’analyse. Ancune donnée n’est manquante.

Par Région

plt1 <-vaches_region %>%
     ggplot(aes(x=" ", y = valeur)) +
    geom_boxplot(fill = "#D8EADF", color = "black") +
     coord_flip() +
    theme_classic() +
    xlab("") +
    ylab("Lait par vache")+
    theme(axis.text.y=element_blank(),
          axis.ticks.y=element_blank())

plt2 <-vaches_region %>%
    ggplot() +
     geom_histogram(aes(x = valeur, y = (..count..)/sum(..count..)),                         
                        position = "identity", binwidth = 1500,
                        fill = "#D8EADF", color = "black") +
     ylab("Fréquence Relative")+
     xlab("")+
    theme_classic()+ 
   theme(axis.text.x = element_blank())+
    theme(axis.ticks.x = element_blank())


plt2 + plt1 + plot_layout(nrow = 2, heights = c(2, 1))

Par États

plt1 <-vaches_etat %>%
     ggplot(aes(x=" ", y = valeur)) +
    geom_boxplot(fill = "#D8EADF", color = "black") +
     coord_flip() +
    theme_classic() + 
   xlab("") +
    ylab("Lait par vache")+
    theme(axis.text.y=element_blank(),
          axis.ticks.y=element_blank())


plt2 <-vaches_etat %>%    ggplot() +
     geom_histogram(aes(x = valeur, y = (..count..)/sum(..count..)),                         
                        position = "identity", binwidth = 1500,
                        fill = "#D8EADF", color = "black") + 
    ylab("Fréquence Relative")+
     xlab("")+ 
   theme_classic()+
    theme(axis.text.x = element_blank())+
    theme(axis.ticks.x = element_blank())  


plt2 + plt1 + plot_layout(nrow = 2, heights = c(2, 1))

Pour ces deux table de données, la distribution des données de production de lait par vache semble normale. Il n’y a aucune valeurs extrême qui pourrait être considérée comme une valeur aberrante.

PRÉPARER

Par région

Qc<-data.frame(region="Québec",annee=c("2008", "2017"),valeur=c(8304,9433))%>%
    mutate(annee=as.character(annee), region=as.character(region))    

dumbbell_region <-vaches_region%>%
    mutate(valeur=valeur/2.2)%>%  #changement des unités de lbs à kg    
    bind_rows(Qc) %>% #ajouter les données du Québec pour comparer    
    filter(!region=="United States") %>%
    filter(annee == 2008 | annee == 2017) %>%
    spread(annee, valeur) %>%
    mutate(ecart = `2017` - `2008`) %>%
    arrange(desc(`2017`))

Par États

Qc<-data.frame(etat="Québec",
                 annee=c("2008","2009", "2010", "2011", "2012", "2013", "2014", "2015", "2016", "2017"),
                 valeur=c(8304,8306,8568,8682,8865,8868,8975,9054,9265,9433))%>%
    mutate(annee=as.character(annee), etat=as.character(etat))    

line_etat <-vaches_etat%>%
    mutate(valeur=valeur/2.2)%>%  #changement des unités de lbs à kg    
    bind_rows(Qc)%>% #ajouter les données du Québec pour comparer    
    filter(annee>=2008)%>% 
    mutate(annee=as.numeric(annee))%>%
    mutate(type=0)%>% #créer des catégories pour les couleurs du graphique    
   mutate(type=ifelse(etat=="Québec", 1, type))%>%
    mutate(type=ifelse(etat=="Montana", 2, type))    


line_etat_0<-line_etat%>%
    filter(type=="0")

line_etat_1<-line_etat%>%
    filter(type=="1")    

line_etat_2<-line_etat%>%
    filter(type=="2")

VISUALISER

Par région

gg<-ggplot()  #Dumbell  
gg<-gg + geom_dumbell(data=dumbbell_region,
                        aes(x = `2008`, xend = `2017`, y = reorder(region,`2017`),group = region),
                         colour = "#dddddd",
                       size = 3,
                       colour_x = "#FAAB18",
                       colour_xend = "#1380A1")  
#modifier le thème  
gg<-gg + bbc_style()  
gg<-gg + theme(axis.text.x = element_blank())  
#ajuster les axes  
gg<-gg + scale_x_continuous(expand=c(0,0), limits=c(5500, 12300))  
gg<-gg + scale_y_discrete(expand=c(0.075,0))  
#ajouter les titres  
gg<-gg + labs(title="Où sont les meilleures vaches?",
                subtitle="Évolution de la production laitière (kg/vache/an) de 2008 à 2017")  
#ajouter une colonne de référence pour les différences  
gg<-gg + geom_rect(data=dumbbell_region, aes(xmin=11700, xmax=12300, ymin=-Inf, ymax=Inf), fill="#efefe3")  
gg<-gg + geom_text(data=dumbbell_region, aes(label=round(ecart, digits=0), y=region, x=12000), hjust=0.5,
                     fontface="bold", size=4, family="Calibri")  
gg<-gg + geom_text(data=filter(dumbbell_region, region=="Mountain"), aes(x=12000, y=region, label="ÉCART"),
                       color="#7a7d7e", size=3.1, vjust=-2, fontface="bold", family="Calibri") 
 #ajouter les étiquettes de données  
gg<-gg + geom_text(data=dumbbell_region, aes(x=`2008`, y=region, label=round(`2008`, digits=0)),
                       color="#FAAB18", size=2.75, vjust=2.75, family="Calibri")  
gg<-gg + geom_text(data=dumbbell_region, color="#1280A1", size=2.75, vjust=2.5, family="Calibri",
                       aes(x=`2017`, y=region, label=round(`2017`, digits=0)))

Par États

gg<-ggplot()  
#ajuster les axes 
 gg<-gg + scale_x_continuous(breaks=seq(2008,2017,1), limits = c(2008, 2017))  
gg<-gg + scale_y_continuous(breaks=seq(4000,13000,1000), limits = c(4000, 13000))  
#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 = element_line(size=0.5, linetype="solid", colour = "#8B8B8B"))  
#type de graphique (ajouter par couche pour mettre en évidence le Qc et le Montana)  
gg<-gg + geom_line(data=line_etat_0, aes(x = annee, y = valeur, group=etat), size=1, colour="#A9A9A9")  
gg<-gg + geom_line(data=line_etat_1, aes(x = annee, y = valeur, group=etat), size=2.5, colour="#3F3489")  
gg<-gg + geom_line(data=line_etat_2, aes(x = annee, y = valeur, group=etat), size=2.5, colour="#E3784F")  
#ajouter les titres  
gg<-gg + labs(subtitle="Même si les vaches avaient le même niveau de prodcution en 2008, celles du Montana  produisaient en moyenne 637 kg de plus en 2017.",
                y="Production laitière (kg lait/vache/an)")  
gg<-gg + theme(plot.subtitle = element_text(hjust=0,size=14, color="#8B8B8B"),
                 axis.title.y = element_text(hjust=1,size= 10, colour = "#8B8B8B"),
                 axis.title.x = element_blank(),
                 axis.text = element_text(hjust=0.5,size= 10, colour = "#8B8B8B"))

Pour visualiser les données de chaque État et les comparer avec le Québec, j’ai choisi de présenter les données avec des graphiques linéaires. Comme il y a quand même beaucoup d’états à présenter, j’ai mis l’accent sur les données du Québec et du Montana en plaçant les autres en gris pour les mettre en arrière plan. J’ai mis de l’avant la comparaison du Québec avec le Montana parce que la production de ces deux régions était au même niveau en 2008. C’est intéressant de voir que les vaches du Montana ont subit une meilleure amélioration de leur production comparativement à celle du Québec. J’ai choisi de garder les données des autres états, mais de les présenter en arrière plans parce que ça nous donne une idée de la variabilité des données. On voit que même si le Québec à une production laitière dans la moyenne des données, il y a un plus grand nombre d’états qui ont une production laitière supérieure.