TidyTuesday | 2019W5 (prise 2): Portrait de la production laitière aux États-Unis

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%
  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%
  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 %
  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 %
  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 %
  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 %
  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%
  mutate(annee=as.character(annee), region=as.character(region))

dumbbell_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%
  mutate(annee=as.character(annee), etat=as.character(etat))

line_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%
  filter(type=="0")

line_etat_1%
  filter(type=="1")

line_etat_2%
  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)))

Mes objectifs étaient de montrer l'évoution de la production laitière par région des États Unis, de mettre l'emphase sur les meilleures régions et de situer la production laitière moyenne des vaches du Québec. Voici le graphique que j'obtient:

Voici un lien si vous avez, comme moi besion de visualiser un peu mieux les différentes régions des États Unis.

 

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.

 

Répondre

Entrez vos coordonnées ci-dessous ou cliquez sur une icône pour vous connecter:

Logo WordPress.com

Vous commentez à l'aide de votre compte WordPress.com. Déconnexion /  Changer )

Photo Google

Vous commentez à l'aide de votre compte Google. Déconnexion /  Changer )

Image Twitter

Vous commentez à l'aide de votre compte Twitter. Déconnexion /  Changer )

Photo Facebook

Vous commentez à l'aide de votre compte Facebook. Déconnexion /  Changer )

Connexion à %s