Etude du pouvoir d’achat des ouvriers anglais du XVIe au XIXe siècle
Introduction
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.
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, ou ici au format 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.
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).
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 colonnesLes données obtenues sont de la forme :
head(playfair) %>%
kable(format = "html", escape = FALSE, align ="c") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "left")| year | wheat | wages |
|---|---|---|
| 1565 | 41.0 | 5.00 |
| 1570 | 45.0 | 5.05 |
| 1575 | 42.0 | 5.08 |
| 1580 | 49.0 | 5.12 |
| 1585 | 41.5 | 5.15 |
| 1590 | 47.0 | 5.25 |
On peut vérifier si nous avons des valeurs manquantes.
## # A tibble: 3 x 3
## year wheat wages
## <dbl> <dbl> <dbl>
## 1 1815 78 NA
## 2 1820 54 NA
## 3 1821 54 NALes 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.
Pour palier ce problème, nous allons utiliser à la place la fonction geom_ribbon() avec une astuce pour faciliter le coloriage des barres (source).
# 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’optionexpand = FALSEpermet de supprimer les espaces entre les axes et le graphe. L’optionclip = "offpermettra par la suite d’ajouter des annotations à l’extérieur du graphe.
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
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
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
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, et formattées au format CSV.
# 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")| name | start | end | commonwealth |
|---|---|---|---|
| Elizabeth | 1565 | 1603 | NA |
| James I | 1603 | 1625 | NA |
| Charles I | 1625 | 1649 | NA |
| Cromwell | 1649 | 1660 | TRUE |
| Charles II | 1660 | 1685 | NA |
| James II | 1685 | 1689 | NA |
| W&M | 1689 | 1702 | NA |
| Anne | 1702 | 1714 | NA |
| George I | 1714 | 1727 | NA |
| George II | 1727 | 1760 | NA |
| George III | 1760 | 1820 | NA |
| George IV | 1820 | 1821 | NA |
- Ajout frise chronologique des rois et reines
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 utilisantannotation_custom, on doit également modifier les marges autour du graphe.
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 annotations en haut du graphe.
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).
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 Quarter 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.
Autres possibilités de graphe
Pouvoir d’achat
L’objectif de Playfair était de montrer que le pouvoir d’achat des ouvriers avait augmenté au cours du temps. On peut vaguement visualiser ceci sur son graphe, mais une représentation graphique du pouvoir d’achat au cours du temps (défini comme la quantité de blé qu’un ouvrier peut acheter avec son salaire hebdomadaire) semble plus pertinente.
Dans un premier temps, on ajoute donc cette quantité aux données, puis le graphe est obtenu directement.
Deux définitions peuvent être envisagées pour le calcul du pouvoir d’achat :
- avec un salaire donné, combien puis-je acheter de quantité de blé ?
- quelle est la quantité de travail nécessaire pour acheter une unité de blé donnée ?
Nous allons créer ici un graphe avec la première définition.
Note : les trois dernières valeurs de salaire étant manquantes dans nos données de base, nous allons supprimer ces données.
playfair %>%
filter(!is.na(wages)) %>%
mutate(purchase_power = wages / wheat) %>%
ggplot(aes(x = year, y = purchase_power)) +
geom_step(color = "red", alpha = 0.6, size = 0.8) +
geom_smooth(se = FALSE, lwd = 0.5, lty = 2, span = 0.4) +
labs(x = "", y = "Wheat Quantity (Quarter of a Bushel)",
title = "How much Wheat can I buy with my Weekly Wage ?") +
theme_light()
On peut ainsi voir que le “pouvoir d’achat” a pratiquement quintuplé en deux siècles jusqu’à 1750, avant de fortement se dégrader après cette date.
Relation salaire/prix et salaire/pouvoir d’achat
Une autre possibilité de graphique est de visaliser la relation directe entre le prix du blé et le salaire quotidien.
playfair %>%
mutate(century = paste0(str_sub(year, start = 1, end = 2), "th")) %>%
ggplot(aes(x = wages, y = wheat, color = century)) +
geom_point() +
labs(x = "Weekly Wage (in shillings)",
y = "Price of the Quarter of Wheat (in shillings)",
title = "Wheat Price / Weekly Wage relationship",
color = "Century") +
scale_x_continuous(breaks = seq(0, 30, by = 5)) +
scale_y_continuous(breaks = seq(0, 100, by = 10)) +
theme_light() +
theme(legend.position = c(0.5, 0.9),
legend.direction = "horizontal",
legend.background = element_rect(color = "black"))
On peut voir que la corrélation est plutôt négative jusqu’à 15 shillings, alors que on a une forte corrélation positive à partir de 15 shillings : plus le salaire est élevé, plus le prix du blé est éleve.
Un dernier graphe peut nous permettre de voir l’évolution réelle du pouvoir d’achat en fonction du salaire : on aurait tendance à penser qu’une augmentation du second entraîne automatiquement une augmentation du premier.
playfair %>%
filter(!is.na(wages)) %>%
mutate(purchase_power = wages / wheat) %>%
ggplot(aes(x = wages, y = purchase_power)) +
geom_point() +
geom_smooth(se = FALSE, lwd = 0.5, lty = 2) +
labs(x = "Weekly Wage (in shillings)",
y = "Purchasing Power",
title = "Purchasing Power / Weekly Wage relationship") +
theme_light()
Ce qu’on imaginait se produit réellement lorsque les salaires sont faibles : une augmentation de salaire entraîne effectivement une hausse du pouvoir d’achat.
Ceci n’est plus vrai lorsque les salaires sont élevés : lorsque ceux-ci dépassent 25 shillings par semaine, le pouvoir d’achat a tendance à diminuer.