diff --git a/module3/exo3/exercice_fr.Rmd b/module3/exo3/exercice_fr.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..b8af3af3aefdde99e1b6f29d1d8a6ffdca2f5477 --- /dev/null +++ b/module3/exo3/exercice_fr.Rmd @@ -0,0 +1,279 @@ +--- +title: "Etude du pouvoir d'achat des ouvriers anglais du XVIe au XIXe siècle" +author: "Votre nom" +date: "La date du jour" +output: html_document +--- + + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, fig.dim=c(10,5)) +``` + +## Introduction + +[William Playfair](https://fr.wikipedia.org/wiki/William_Playfair) était un des pionniers de la présentation graphique des données. Il est notamment considéré comme l'inventeur de l'histogramme. Un de ses graphes célèbres, tiré de son livre *"A Letter on Our Agricultural Distresses, Their Causes and Remedies"*, montre l'évolution du prix du blé et du salaire moyen entre 1565 et 1821. + +Le but de ce document est de reproduire dans un premier temps le graphique produit par William Playfair, puis de tenter de l'améliorer pour faire ressortir des informations plus pertinentes. +![Graphe de Playfair](https://upload.wikimedia.org/wikipedia/commons/thumb/3/3a/Chart_Showing_at_One_View_the_Price_of_the_Quarter_of_Wheat%2C_and_Wages_of_Labour_by_the_Week%2C_from_1565_to_1821.png/640px-Chart_Showing_at_One_View_the_Price_of_the_Quarter_of_Wheat%2C_and_Wages_of_Labour_by_the_Week%2C_from_1565_to_1821.png) + +### Chargement des libraries utilisées + +```{r message=FALSE} +library(tidyverse) # Manipulation de données, graphiques +library(knitr) # +library(kableExtra) # Formattage des tableaux +library(grid) # Annotations en dehors du graphe +``` + +## Chargement des données + +Playfair n'a pas publié les données numériques brutes qu'il a utilisées, car à son époque la réplicabilité n'était pas encore considérée comme essentielle. +Celles-ci ont été déduites par numérisation et sont disponibles [ici](https://vincentarelbundock.github.io/Rdatasets/doc/HistData/Wheat.html), ou [ici au format CSV](https://raw.githubusercontent.com/vincentarelbundock/Rdatasets/master/csv/HistData/Wheat.csv). + +Nous téléchargeons le fichier de données en local (si celui-ci n'existe pas). Ceci afin de nous prémunir contre un éventuel problème de connexion à ce fichier. +```{r} +data_url <- "https://raw.githubusercontent.com/vincentarelbundock/Rdatasets/master/csv/HistData/Wheat.csv" +dest_file <- "./wheat.csv" +if(!file.exists(dest_file)) { + download.file(url = data_url, destfile = dest_file, method = "auto") +} +``` + +On peut maintenant charger les données depuis le fichier local, en renommant les colonnes (la première ligne devient donc inutile) et en supprimant la première colonne (simples numéros d'identification). +```{r} +playfair <- read_csv("wheat.csv", + skip = 1, # suppression de la 1ere ligne (titre des colonnes) + col_types = c("_ddd"), # suppression de la 1ere colonne + col_names = c("year", "wheat", "wages")) # renommer les colonnes +``` + +Les données obtenues sont de la forme : +```{r} +head(playfair) %>% + kable(format = "html", escape = FALSE, align ="c") %>% + kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "left") +``` + +On peut vérifier si nous avons des valeurs manquantes. +```{r} +playfair %>% + filter_all(any_vars(is.na(.))) +``` + +Les dernières valeurs pour la variable `wages` sont manquantes, ce qu'on retrouve sur le graphe de Playfair. + + +## Reproduction du graphique de William Playfair + +Le graphique doit permettre de visualiser le prix du blé (sous forme de barres) et le salaire moyen (par une courbe et une surface) en fonction des années. + +Afin de visualiser le prix sous forme de barres comme sur le graphique, nous pourrions utiliser la fonction `geom_step()`, qui répond à la forme voulue, mais sans la possibilité de colorier les barres. +```{r} +# graphe de base : geom_step +ggplot(playfair, aes(x = year)) + + geom_step(aes(y = wheat)) +``` + +Pour palier ce problème, nous allons utiliser à la place la fonction `geom_ribbon()` avec une astuce pour faciliter le coloriage des barres ([source](https://gist.github.com/Teebusch/db0ab76d31fd31a13ccf93afa7d77df5)). +```{r playfair-plot} +# astuce de construction, pour correspondre aux différentes marches du graphique +playfair_area <- bind_rows(old = playfair, + new = playfair %>% mutate(wheat = lag(wheat)), + .id = "source") %>% + arrange(year, source) + +# Graphe de base : geom_ribbon +p <- ggplot(playfair, aes(x = year)) + + geom_ribbon(data = playfair_area, aes(ymin = 20, ymax = wheat), fill = "grey19", alpha = 0.9) + +p +``` + +Nous pouvons maintenant ajouter la courbe et la surface correspondant aux salaires. + +- Graphe de base : prix du blé + courbe salaire +*Note* : l'option `expand = FALSE` permet de supprimer les espaces entre les axes et le graphe. L'option `clip = "off` permettra par la suite d'ajouter des annotations à l'extérieur du graphe. +```{r warning=FALSE} +p <- p + + geom_line(aes(y = wages), color = "firebrick", na.rm = TRUE, size = 2.5) + + geom_area(aes(y = wages), fill = "lightblue", na.rm = TRUE, alpha = 0.9) + + coord_cartesian(expand = FALSE, clip = "off") +p +``` + + +On peut continuer à modifier ce graphe, pour se rapprocher au maximum de la représentation de William Playfair. + +- Modification des axes +```{r warning=FALSE} +p <- p + + scale_x_continuous(limits = c(1565, 1830), + breaks = c(1565, seq(1600, 1800, by = 50), 1830), + minor_breaks = seq(1565, 1830, by = 5), + name = "") + + scale_y_continuous(limits = c(0, 100), + breaks = seq(0, 100, by = 10), + name = "", + sec.axis = sec_axis(~., name = "Price of the Quarter of Wheat in Shillings", + breaks = seq(0, 100, by = 10))) +p +``` + +- Modification de l'arrière-plan et de la police des textes des axes +```{r warning=FALSE} +p <- p + + theme(panel.background = element_blank(), + panel.grid.major = element_line(colour = "grey25", size = 0.8), + panel.grid.minor = element_line(colour = "grey25", size = 0.3), + text = element_text(family = "NewCenturySchoolbook", face = "italic"), + axis.text = element_text(size = 7), + axis.title.y.right = element_text(angle = 90, size = 8)) +p +``` + +- Ajout du titre et des annotations dans le graphe +```{r warning=FALSE} +p <- p + + annotate(geom = "label", x = 1650, y = 70, + label = "CHART,\n Showing at One View\nThe Price of the Quater of Wheat,\n& Wages of Labour by the Week,\nfrom The Year 1565 to 1821,\nby William Playfair.", + fontface = "bold.italic", size = 3.5, family = "NewCenturySchoolbook", + label.r = unit(3, "lines")) + + annotate(geom = "text", x = c(1635, 1748), y = c(9, 18), label = "Weekly Wages of a Good Mechanic", + fontface = "italic", size = 2.7, angle = c(2, 10), family = "NewCenturySchoolbook") +p +``` + +Pour la frise chronologique des rois et reines, nous allons utiliser les données disponibles [ici](https://mbostock.github.io/protovis/ex/wheat.js), et formattées au format CSV. +```{r message=FALSE} +# Fichier des rois et reines +wheat_monarchs <- read_csv("wheat_monarchs.csv") +wheat_monarchs %>% + kable(format = "html", escape = FALSE, align ="c") %>% + kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "left") +``` + +- Ajout frise chronologique des rois et reines +```{r warning=FALSE} +p <- p + + # rois/reines sur la barre supérieure + geom_rect(data = wheat_monarchs %>% filter(row_number() %% 2 == 1, is.na(commonwealth)), aes(xmin = start, xmax = end, ymin = 97, ymax = 98), inherit.aes = FALSE) + + geom_text(data = wheat_monarchs %>% filter(row_number() %% 2 == 1, is.na(commonwealth)), aes(x = start + (end -start) / 2, y = 96, label = name), size = 2, family = "NewCenturySchoolbook", fontface = "italic") + + # rois/reines sur la barre inférieure + geom_rect(data = wheat_monarchs %>% filter(row_number() %% 2 == 0, is.na(commonwealth)), aes(xmin = start, xmax = end, ymin = 96, ymax = 97), inherit.aes = FALSE) + + geom_text(data = wheat_monarchs %>% filter(row_number() %% 2 == 0, is.na(commonwealth)), aes(x = start + (end -start) / 2, y = 95, label = name), size = 2, family = "NewCenturySchoolbook", fontface = "italic") + + # cas particulier de Cromwell + geom_rect(data = wheat_monarchs %>% filter(commonwealth), aes(xmin = start, xmax = end, ymin = 97, ymax = 98), inherit.aes = FALSE, fill = "white", color = "black") + + geom_text(data = wheat_monarchs %>% filter(commonwealth), aes(x = start + (end -start) / 2, y = 96, label = name), size = 2, family = "NewCenturySchoolbook", fontface = "italic") +p +``` + +- Ajout des annotations en bas et à droite du graphe. +*Note* : en utilisant `annotation_custom`, on doit également modifier les marges autour du graphe. +```{r warning=FALSE} +p <- p + + theme(plot.margin = unit(c(1.2,0.8,0.5,0), units = "cm")) + + annotation_custom(grob = textGrob(label = "shillings", + gp = gpar(fontsize = 8, fontface = "italic", fontfamily = "NewCenturySchoolbook")), + xmin = 1844, xmax = 1844, ymin = 100, ymax = 100) + + annotation_custom(grob = textGrob(label = "shillings", + gp = gpar(fontsize = 8, fontface = "italic", fontfamily = "NewCenturySchoolbook")), + xmin = 1841, xmax = 1841, ymin = 0, ymax = 0) + + annotation_custom(grob = textGrob(label = "5 Years each division", + gp = gpar(fontsize = 8, fontface = "italic", fontfamily = "NewCenturySchoolbook")), + xmin = 1650, xmax = 1650, ymin = -5, ymax = -5) + + annotation_custom(grob = textGrob(label = "5 Years each division", + gp = gpar(fontsize = 8, fontface = "italic", fontfamily = "NewCenturySchoolbook")), + xmin = 1785, xmax = 1785, ymin = -5, ymax = -5) + +p +``` + +- Enfin, ajout des annonations en haut du graphe. +```{r warning=FALSE} +p <- p + + annotation_custom(grob = textGrob(label = "16th Century", + gp = gpar(fontsize = 8, fontfamily = "NewCenturySchoolbook")), + xmin = 1577, xmax = 1577, ymin = 102.5, ymax = 102.5) + + annotation_custom(grob = textGrob(label = "17th Century", + gp = gpar(fontsize = 8, fontfamily = "NewCenturySchoolbook")), + xmin = 1650, xmax = 1650, ymin = 102.5, ymax = 102.5) + + annotation_custom(grob = textGrob(label = "18th Century", + gp = gpar(fontsize = 8, fontfamily = "NewCenturySchoolbook")), + xmin = 1750, xmax = 1750, ymin = 102.5, ymax = 102.5) + + annotation_custom(grob = textGrob(label = "19th Century", + gp = gpar(fontsize = 8, fontfamily = "NewCenturySchoolbook")), + xmin = 1820, xmax = 1820, ymin = 102.5, ymax = 102.5) + + annotation_custom(grob = curveGrob(x1 = 0, y1 = 1, x2 = 1, y2 = 0, curvature = -0.12, square = FALSE, ncp = 20, + gp = gpar(col = "black", lwd = 3)), + xmin = 1565, xmax = 1600, ymin = 105, ymax = 100) + + annotation_custom(grob = curveGrob(x1 = 0, y1 = 0, x2 = 1, y2 = 1, curvature = -0.15, square = FALSE, ncp = 20, + gp = gpar(col = "black", lwd = 3)), + xmin = 1600, xmax = 1700, ymin = 100, ymax = 100) + + annotation_custom(grob = curveGrob(x1 = 0, y1 = 0, x2 = 1, y2 = 1, curvature = -0.15, square = FALSE, ncp = 20, + gp = gpar(col = "black", lwd = 3)), + xmin = 1700, xmax = 1800, ymin = 100, ymax = 100) + + annotation_custom(grob = curveGrob(x1 = 0, y1 = 0, x2 = 1, y2 = 1, curvature = -0.12, square = FALSE, ncp = 20, + gp = gpar(col = "black", lwd = 3)), + xmin = 1800, xmax = 1830, ymin = 100, ymax = 105) + + annotation_custom(grob = textGrob(label = "N°1", + gp = gpar(fontsize = 11, fontfamily = "NewCenturySchoolbook", fontface = "bold")), + xmin = 1700, xmax = 1700, ymin = 104, ymax = 104) + +p +``` + + +Ces différentes étapes permettent d'obtenir un graphique assez proche de celui de William Playfair. + + +## Amélioration du graphe de Playfair. + +Le graphe de Playfair n'est pas parfait, et certaines pratiques semblent inconcevables aujourd'hui. Par exemple, les 2 quantités représentées, prix du blé et salaire, sont représentés sur une même ordonnée (à droite), avec une unité commune, le shilling ; ou encore l'absence d'une légende (même si le graphe de Playfair reste compréhensible). + +On peut ainsi séparer les 2 quantités en utilisant deux ordonnées différentes (une à gauche et une à droite), avec des unités appropriées (ici, nous laissons la même échelle sur les deux axes, car cela ne gêne pas la visualisation globale). + +```{r message=FALSE, warning=FALSE} +ggplot(playfair, aes(x = year, y = wheat)) + + geom_step(aes(color = "Wheat Price", lty = "Wheat Price"), + alpha = 0.6, size = 0.8) + + geom_smooth(aes(color = "Wheat Price Trend Curve", lty = "Wheat Price Trend Curve"), + se = FALSE, lwd = 0.5, span = 0.5) + + geom_step(aes(y = wages, color = "Weekly Wage", lty = "Weekly Wage"), alpha = 0.7) + + scale_color_manual(name = "", + limits = c("Wheat Price", "Wheat Price Trend Curve", "Weekly Wage"), + values = c("Wheat Price" = "red", + "Wheat Price Trend Curve" = "red", + "Weekly Wage" = "blue")) + + scale_linetype_manual(name = "", + limits = c("Wheat Price", "Wheat Price Trend Curve", "Weekly Wage"), + values = c("Wheat Price" = "solid", + "Wheat Price Trend Curve" = "dashed", + "Weekly Wage" = "solid")) + + scale_x_continuous(limits = c(1565, 1830), expand = c(0, 0), + breaks = c(1565, seq(1600, 1800, by = 50), 1830), + minor_breaks = seq(1565, 1830, by = 5), + name = "") + + scale_y_continuous(limits = c(0, 100), expand = c(0, 0), + breaks = seq(0, 100, by = 10), + name = "Price of the Quarter of Wheat (in shillings)", + sec.axis = sec_axis(~., name = "Weekly Wage (in shillings)", + breaks = seq(0, 100, by = 10))) + + theme_light() + + labs(title = "Price of the Quater of Wheat & Wages of Labour by the Week", + subtitle = "(from The Year 1565 to 1821)", + y = "") + + theme(legend.position = c(0.13, 0.87), + legend.title = element_blank(), + legend.text = element_text(face = "italic", size = 8), + legend.spacing = unit(0.3, "cm")) +``` + +En ajoutant une courbe de tendance, on peut voir que le prix du blé a baissé légèrement jusqu'à 1740, avant une brutale augmentation. +Les salaires ont quant à eux progressé durant toute la période, avec une augmentation plus prononcée à partir de 1700. + + + + + +