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.318str(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 26302Nous 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.
