biplot

Code R de l'exemple ggplot2

library(ggplot2)
library(HistData)

## Guerry's moral statistics are scaled so that more is better: crimes,
## illegitimate births and suicides are counted as population per event.
## The arrow names say so.
moral <- c(Crime_pers = "Few crimes (persons)", Crime_prop = "Few crimes (property)",
           Literacy = "Literacy", Donations = "Donations",
           Infants = "Few illegitimate births", Suicides = "Few suicides")
pca <- prcomp(Guerry[, names(moral)], scale. = TRUE)
share <- scales::percent(pca$sdev^2 / sum(pca$sdev^2), accuracy = 1)

departments <- as.data.frame(pca$x[, 1:2])
## Arrows stretched to the spread of the departments, so both read on one plot.
stretch <- max(abs(pca$x[, 1:2])) / max(abs(pca$rotation[, 1:2])) * 0.8
variables <- data.frame(pca$rotation[, 1:2] * stretch, name = moral[rownames(pca$rotation)])

p <- ggplot(departments, aes(x = PC1, y = PC2)) +
  geom_hline(yintercept = 0, colour = "#d6d6d6", linewidth = 0.3) +
  geom_vline(xintercept = 0, colour = "#d6d6d6", linewidth = 0.3) +
  geom_point(size = 1.2, alpha = 0.5, colour = "#535353") +
  geom_segment(data = variables, aes(x = 0, y = 0, xend = PC1, yend = PC2),
               colour = "#9b2367", linewidth = 0.5,
               arrow = grid::arrow(length = unit(1.6, "mm"), angle = 25, type = "closed")) +
  geom_text(data = variables, aes(label = name), colour = "#9b2367", size = 2.8,
            hjust = ifelse(variables$PC1 > 0, 0, 1), nudge_x = ifelse(variables$PC1 > 0, 0.1, -0.1)) +
  scale_x_continuous(labels = lex_number, expand = expansion(mult = c(0.6, 0.35))) +
  scale_y_continuous(labels = lex_number, expand = expansion(mult = 0.1)) +
  coord_fixed(clip = "off") +
  labs(title = "Literacy went with more property crime",
       subtitle = "Moral statistics of 86 French departments, 1833",
       x = paste0("Axis 1 (", share[1], ")"), y = paste0("Axis 2 (", share[2], ")"),
       caption = "Data: Guerry 1833, via the HistData R package") +
  theme_lex_viz(grid = "", arrows = "") +
  theme(axis.text = element_blank())