Courbe de croissance des porcs québeçois

Le Centre d’études sur les coûts de production en agriculture (CECPA) à publié récemment son étude de coût de production Porcelets et Porcs 2017. Plusieurs éléments intéressant y sont présentés, mais ce sont les valeurs de poids d’entrée et de sortie qui ont particulièrement attirées mon attention.

Voici donc la courbe de croissance des porcs québeçois basée sur les résultats de cette étude:

 

 

Combien vaut votre lisier de porc?

Toutes les entreprises porcines ont des volumes plus ou moins important de lisier à gérer. Porc Québec, a publié en décembre 2017 un article très intéressant qui estime la valeur du lisier de porc à partir du prix des engrais minéraux de 2017.

Tous les types d’engrais apporte 3 éléments nutritifs essentiels aux plantes soit l’azote, le phosphore et le potassium. Les valeurs fertilisantes apportées par le lisier de porc varient en fonction du type d’épandage, du moment d’application sur la culture et de la rapidité d’enfouissement après l’épandage.

Pour résumé le tout j’ai pris les valeurs économiques brutes du lisier d’engraissement appliqué sur des cultures annuelles, par aspersion basse et incoproré en moins de 24 heures. En faisait la moyenne entre les applications du printemps et de l’automne le lisier de porc d’engraissement aurait une valeur économique de 7,49$/T. En considérant la proportion des éléments fertilisants apportés par les lisiers de maternité et de pouponnière vallent respectivement 4.87$/T et 4,64$/T.

 

TidyTuesday | 2019W7: USDA Dépenses fédérales en recherche et développement

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

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.

 

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

Quoi de mieux que des données du domaine agricole pour me lancer dans les #TidyTuesday! Pour la qinquième semaine, les données à travailler portent sur la production laitière des vaches et sur la consommation de produits laitiers aux États-Unis.

Voici la source, l’article et le répertoire github.

L’objectif des #TidyTuesday est de permettre à la communauté #RStats de pratiquer les techniques de traitement, de nettoyage et de visualidation de données ainsi que de parfaire les aptitudes à tirer des conclusions.

EXPLORATION INITIALE

Après avoir importé et pris connaissance des différentes bases de données fournies, l’agronome en moi est curieuse de voir à quoi ressemble l’évolution de la production laitière des vaches aux États-Unis. J’ai récemment fait un travail similaire pour la production laitière québeçoise, ce sera intéressant de voir comment est-ce que ça de compare.

summary(vaches)
##       year      avg_milk_cow_number  milk_per_cow   milk_production_lbs
##  Min.   :1980   Min.   : 9010000    Min.   :11891   Min.   :1.284e+11  
##  1st Qu.:1988   1st Qu.: 9171000    1st Qu.:14254   1st Qu.:1.445e+11  
##  Median :1997   Median : 9314000    Median :16871   Median :1.561e+11  
##  Mean   :1997   Mean   : 9695743    Mean   :16962   Mean   :1.626e+11  
##  3rd Qu.:2006   3rd Qu.:10135000    3rd Qu.:19722   3rd Qu.:1.794e+11  
##  Max.   :2014   Max.   :11059000    Max.   :22259   Max.   :2.061e+11  
##  avg_price_milk    dairy_ration     milk_feed_price_ratio
##  Min.   :0.1210   Min.   :0.03445   Min.   :1.520        
##  1st Qu.:0.1275   1st Qu.:0.04550   1st Qu.:2.540        
##  Median :0.1360   Median :0.04914   Median :2.700        
##  Mean   :0.1462   Mean   :0.05784   Mean   :2.697        
##  3rd Qu.:0.1530   3rd Qu.:0.05886   3rd Qu.:3.030        
##  Max.   :0.2400   Max.   :0.12150   Max.   :3.640        
##  milk_cow_cost_per_animal milk_volume_to_buy_cow_in_lbs alfalfa_hay_price
##  Min.   : 820             Min.   : 6560                 Min.   : 64.64   
##  1st Qu.:1100             1st Qu.: 7574                 1st Qu.: 79.22   
##  Median :1190             Median : 8626                 Median : 94.03   
##  Mean   :1283             Mean   : 8848                 Mean   :104.59   
##  3rd Qu.:1425             3rd Qu.: 9697                 3rd Qu.:109.20   
##  Max.   :1950             Max.   :13411                 Max.   :206.08   
##  slaughter_cow_price
##  Min.   :0.3300     
##  1st Qu.:0.3988     
##  Median :0.4503     
##  Mean   :0.4875     
##  3rd Qu.:0.5147     
##  Max.   :1.0204

Nous disposons donc de 34 années de 1980 à 2014. Pour chaque année, le nombre moyen de vaches aux États-Unis est donné et varient entre 9 et 11 millions. La moyenne de lait produit par vache est aussi présente et varie entre 11 891 et 22 259 lbs de lait par vache par année. C’est un point de départ intéressant.

Années:

str(vaches$year)
##  num [1:35] 1980 1981 1982 1983 1984 ...
Hmisc::describe(vaches$year)
## vaches$year 
##        n  missing distinct     Info     Mean      Gmd      .05      .10 
##       35        0       35        1     1997       12     1982     1983 
##      .25      .50      .75      .90      .95 
##     1988     1997     2006     2011     2012 
## 
## lowest : 1980 1981 1982 1983 1984, highest: 2010 2011 2012 2013 2014

Les années sont en format numérique, les 34 années séparant 1980 et 2014 sont présentes, donc aucune données manquante à gérer.

Production de lait:

str(vaches$milk_per_cow)
##  int [1:35] 11891 12183 12306 12622 12541 13024 13285 13819 14185 14323 ...
Hmisc::describe(vaches$milk_per_cow)
## vaches$milk_per_cow 
##        n  missing distinct     Info     Mean      Gmd      .05      .10 
##       35        0       35        1    16962     3756    12269    12573 
##      .25      .50      .75      .90      .95 
##    14254    16871    19722    21257    21750 
## 
## lowest : 11891 12183 12306 12541 12622, highest: 21142 21334 21722 21816 22259

Les données de production laitières sont classées comme des données quantitatives discrètes (integer), on va devoir changer le format pour travailler avec des valeurs quantitative continue (numeric). Les valeurs de production de lait sont présentes pour les 34 années, donc aucune donnée manquante à gérer. Aussi, ces valeurs sont en lbs/vache, au Québec on parle de kg de lait produit par vache par année. Je vais faire la conversion pour des fins de comparaison.

 

plt1 % select(milk_per_cow) %>%
  ggplot(aes(x="", y = milk_per_cow)) +
  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 % select(milk_per_cow) %>%
  ggplot() +
   geom_histogram(aes(x = milk_per_cow, 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))

La distribution des données semble normale. Aucune valeur extrème qui pourrait être considérée comme une valeur aberrante.

RANGEMENT

Cette table de donnée répond déjà au 3 grands principe de tidy data donc, pour l’analyse que je veux faire de ces données il n’y a aucun travail à faire pour cette étape.

PRÉPARATION

vaches_prep%
   mutate(milk_per_cow==(as.numeric(milk_per_cow)))%>% #changer le type de la variable
   mutate(milk_per_cow_kg=milk_per_cow/2.2)%>%  #changement des unités de lbs à kg
   select(year, milk_per_cow_kg)  #sélection des variables pour l'analyse

#validation du changement de type
str(vaches_prep$milk_per_cow_kg)
##  num [1:35] 5405 5538 5594 5737 5700 ...

VISUALISATION DES DONNÉES

ggplot(data=vaches_prep, aes(x=year, y = milk_per_cow_kg)) +
  geom_bar(stat="identity", width=0.85, fill='#FFFFFF', color='#B8B8B8') +
  scale_x_continuous(breaks=seq(1980,2014,5), limits = c(1979,2015))+
  scale_y_continuous(breaks=seq(0,12000,2000), limits = c(0,12000))+
  labs(y="Lait (kg) par vache",
      title="Évolution de la production laitière moyenne par vache aux États-Unis",
      subtitle="Elle a plus que doublée au cours des 35 dernières années et surpassait le Québec de 1143 kg/vache en 2014!")+
  theme(plot.title = element_text(hjust=0,  size=22, color="#5D5D5D",face="bold"),
        plot.subtitle = element_text(hjust=0,  size=14, color="#004FFF",face="bold"),
        axis.title.x = element_blank(),
        axis.title.y = element_text(hjust=1,  size=12, color="#B8B8B8"),
        axis.text =  element_text(hjust=0.5,size=12, color="#B8B8B8"))+
  theme( panel.border = element_blank(),
         panel.background = element_blank(),
         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 = "#B8B8B8"),
         axis.ticks = element_line(size=0.5, linetype="solid", colour = "#B8B8B8"))+
  annotate(geom="text", x=1980,y=5750, label="4405", color="#004FFF", size=5, hjust=0.5, fontface="bold")+
  annotate(geom="text", x=2014,y=10400, label="10118", color="#004FFF", size=5, hjust=0.5, fontface="bold")+
  annotate(geom="text", x=2015,y=8700, label="Qc", color="#000000", size=5, hjust=0, fontface="bold")+ geom_abline(intercept = -220688.7763, slope = 114.0526, size=1.3)

Mes objectifs sont de montrer l’évolution dans le temps de la production de lait par vache aux États-Unis, mettre l’enphase sur l’amélioration de la période de 35 ans de données disponibles et de comparer ces données avec la moyenne de la production laitières des vaches du Québec que j’ai obtenu suite à mon analyse récente des données de Valacta. Voici le graphique que j’obtient:

Évolution des performances de la production porcine québeçoise

La production porcine a beaucoup évoluée au cours des dernières années au Québec. Les porcelets entrent en engraissement en moyenne à 30 kg au lieu de 24 kg dans les années 2000. Suite à la période d’engraissement, les porcs sortent maintenant 23 kg plus lourd que dans les années 2000. Pour arriver à de telles performances, la conversion alimentaire ajustée (25-107 kg) a dû passer de 2.70 à 2.44.

Avec de telles améliorations des performances des engraissements, on pourrait croire que ces types d’élevages rejettent moins de phosphore dans l’environnement. Or, pour la même durée d’engraissement, les porcs mangent maintenant 270 kg de moulée pour finir à 130 kg de poids vif au lieu du 235 kg de moulée nécessaire pour finir un porc à 107 kg dans les années 2000. Alors, même si la conversion alimentaire c’est améliorée au cours des années, est-ce que les porcs rejettent plus ou moins de phosphore dans l’environnement?

Les vaches laitières et leur rejet de phosphore dans l’environnement

Valacta publie à chaque année le rapport de l’évolution de la production laitière québeçoise. Dans ce rapport, on peut constater que l’évolution de la génétique des vaches a permis de faire passer la moyenne de la production laitière de 8304 en 2008 à 9433 kg de lait par vache par année en 2017, soit une augmentation d’un peu plus de 125 kg de lait par vache par année.

Avec cette augmentation, on pourrait croire que les rejets de phosphore dans l’environnement ont aussi augmentés depuis 2008. Or, l’efficience d’utilisation du phosphore, soit le ratio du phosphore exporté (lait et animaux) sur le phosphore ingéré, a aussi évoluée au cours des dernières années pour passer de 31.0% en 2008 à 35.2% en 2017, soit une augmentation de 4.2%.

Rejet P lait

Donc, même si l’évolution génétique a permis d’améliorer la production laitière des vaches, l’efficience d’utilisation du phosphore a aussi évoluée pour faire en sorte que le patron de rejet du phosphore n’est plus directement lié à la production laitière. En considérant la somme des années 2008 à 2017, les vaches qui produisent entre 6000 et 9000 kg de lait rejettent en moyenne 43 kg de P2O5 dans l’environnement et celles qui produisent plus de 9000 kg de lait en rejettent 46 kg. En 2017, les 4047 troupeaux québécois inscrit au service de Valacta avaient une production laitière moyenne de 9467 kg/vache/an. On peut donc considérer que, pour la majorité des troupeaux du Québec, le niveau de production de lait des animaux n’influence pas les rejets de phosphore dans l’environnement.

L’irrigation des patates du Québec

Dans son dernier programme Prime-Vert le MAPAQ a inclus une mesure pour soutenir les producteurs dans leur gestion de l’eau d’irrigation. Il y aurait près de 6 000 exploitations au Québec qui produisent des cultures qui auraient avantage à être irriguées. Toutefois, peu d’entre eux font une gestion optimale de leur eau d’irrigation. Ce programme a donc été mis en place pour aider les exploitations agricoles à optimiser l’usage de l’eau d’irrigation par l’acquisition d’équipements spécialisés et le conseil technique.

Je me suis interrogé à savoir à quoi ressemble les besoins en irrigation dans les différentes régions du Québec. La principale culture irriguée au Québec est la pomme de terre. Donc, en considérant la moyenne des besoins des cultivars hâtifs et tardifs des pommes de terres et l’historique des 5 dernières années de Agrométéo pour les précipitations et l’évapotranspiration de 7 stations météo, je suis arrivée a déterminer les besoins moyen en eau par région.

test irrigation final

Les conditions météorologiques des 5 dernières années, nous indique que, en moyenne, à St-Bernard et à St-Léonard-de-Portneuf les précipitations sont suffisantes pour combler les besoins de la culture. Toutefois, pour la station de St-Bernard, les valeurs varient d’un besoin en eau de 64 mm en 2018 à un surplus en eau de 48 mm en 2016.  En Montérégie, en Estrie et dans le centre du Québec, il y a un déficit d’environ 60 mm à chaque année pour combler les besoins en eau de la culture. Dans le Bas St-Laurent, ce déficit atteint 110 mm.

En conclusion, la décision d’irriguer les cultures doit tenir compte d’une multitude de facteurs et l’historique des besoins en eau en fait certainement partie. Pour plus de détails sur le programme de subvention, consulter le site du MAPAQ ou votre agronome.

Saviez-vous qu’il est 96X plus efficace de cultiver des légumineuses que de faire l’élevage du boeuf?

Protéine produite par ha

C’est ce que j’ai appris pour ma première participation au MakeoverMonday cette semaine. Une étude de Clark & Tiltman (2017) a démontré que la culture d’un hectare de terre en légumineuse permet de produire 962 kg de protéine comparativement à seulement 10 kg pour l’élevage de boeuf. C’est une différence énorme! En général par contre, il y a peu de surprise: les produits végétaux génèrent plus de protéines que les produits d’origine animale par superficie cultivée.

Avant de vous creuser la tête pour vous trouver des recettes avec des légumineuses pour 5 jours semaine (question de sauver l’environnement!), je vous invite a aller écouter l’entrevue de Lionel Levac. Il soulève des points intéressants notamment l’impact de manger local dans le calcul des émissions des gaz à effet de serre et le fait que la production bovine au Québec se fait sur des terres souvent impropre à d’autre type de cultures.