Le thème des exemples ggplot2

## Common ggplot2 theme of the lexicon's examples, shown as is on the theme
## page of the site (R/theme_page.R): comments stay in English.

## Colors, always encoding a variable (redundantly when an axis already names
## the groups, which keep their color across examples): the site's plum, blue and
## orange for up to three categories; beyond, the IdEst palettes.
lex_colors <- c(plum = "#9b2367", blue = "#2e7891", orange = "#dc863b")
## IdEst "Rattner", safe for color vision deficiencies: up to eight
## categories, no more. For n categories, the colors whose rank is n or less.
rattner <- c("#de8e69", "#f1be99", "#c1bd38", "#7a9132",
             "#4c849a", "#184363", "#5d5686", "#a39fc9")
rattner_rank <- c(1, 5, 6, 2, 3, 7, 8, 4)
## IdEst "Hokusai3", light to dark: quantities and ordered categories.
idest_seq <- c("#d8d97a", "#95c36e", "#74c8c3", "#5a97c1", "#295384", "#0a2e57")
## IdEst "Picabia", brown to slate through a light grey: values on either
## side of a centre, such as correlations around 0.
## `scale_fill_gradientn(colours = idest_div, limits = c(-1, 1))`.
idest_div <- c("#53362e", "#744940", "#9f7064", "#c99582", "#e6bcac", "#e2d8d6",
               "#a5a6ae", "#858794", "#666879", "#515260", "#3d3d47")
## Continents (gapminder): the same color in every example, whatever the
## continents shown. One OKLCH lightness (0.62), so that no continent stands
## out more than another; chroma 0.2 where sRGB allows it. Hue alone tells
## them apart, which is weaker for color vision
## deficiencies and lost in grayscale: continents are always named, on the
## plot or in a legend. `scale_fill_manual(values = continent_colors)`.
continent_colors <- c(Africa = "#e44063", Americas = "#a38203", Asia = "#0b999c",
                      Europe = "#7a6df8", Oceania = "#c050c5")
## Their names, written in their color: the same hues at one darker lightness
## (0.555), so that small text reaches a 4.5:1 contrast with white (WCAG AA).
continent_text_colors <- c(Africa = "#cc2651", Americas = "#8c6f05", Asia = "#038386",
                           Europe = "#6958e2", Oceania = "#ab3ab0")

## Thousands separated by a thin space, as the SI and the BIPM write them:
## 20 000. Quicksand has no narrow no-break space (U+202F); text in an SVG
## never wraps, so the thin space (U+2009) does not break either. A theme
## cannot format numbers: each numeric scale takes `labels = lex_number`,
## except years, which are not quantities (2007, not 2 007).
lex_number <- scales::label_number(big.mark = "\u2009")

## An axis with a ")" mark needs room before its first value, so that the
## data start after the mark: `expand = lex_break_expand` in its scale,
lex_break_pad <- c(0.12, 0.05)
lex_break_expand <- expansion(mult = lex_break_pad)
## and no tick in that room, where its label would meet the mark:
## `breaks = lex_break_breaks`. ggplot2 gives it the expanded range, from
## which the data range is recovered.
lex_break_breaks <- function(limits) {
  span <- diff(limits) / (1 + sum(lex_break_pad))
  b <- scales::breaks_extended()(limits)
  b[b >= limits[1] + lex_break_pad[1] * span]
}

lex_pal_discrete <- function(n) {
  if (n <= 3) {
    unname(lex_colors[seq_len(n)])
  } else {
    rattner[rattner_rank <= n]
  }
}

## An axis line that starts with a ")" mark: its scale does not start at 0.
## The mark is a half circle 3 mm from the corner, bulging the way the axis
## goes; the line starts just after it, leaving the corner blank.
element_line_break <- S7::new_class("element_line_break", parent = element_line,
                                     constructor = function(...) S7::new_object(element_line(...)))
registerS3method("element_grob", "element_line_break", envir = asNamespace("ggplot2"), function(element, x = 0:1, y = 0:1, ...) {
  r <- 1.8   # radius of the mark, mm
  at <- 3    # from the corner to the centre of the mark, mm
  t <- seq(-90, 90, length.out = 19) * pi / 180
  horizontal <- length(unique(as.numeric(y))) == 1
  gp <- grid::gpar(col = element@colour, lwd = 0.75 * element@linewidth * .pt)
  if (horizontal) {
    mark <- grid::linesGrob(x[1] + unit(at + r * cos(t), "mm"), y[1] + unit(r * sin(t), "mm"), gp = gp)
    x[1] <- x[1] + unit(at + r + 0.3, "mm")
  } else {
    mark <- grid::linesGrob(x[1] + unit(r * sin(t), "mm"), y[1] + unit(at + r * cos(t), "mm"), gp = gp)
    y[1] <- y[1] + unit(at + r + 0.3, "mm")
  }
  ## NextMethod() draws the line from the shifted start.
  grid::grobTree(NextMethod(), mark)
})

## `grid`: the axes that carry a grid, "x", "y", "xy" or "".
## `arrows`: the axes drawn as an arrow, those of a numeric or ordered
## variable, "x", "y", "xy" or "" (a theme cannot see the variables).
## `break_not_zero`: the arrowed axes whose scale does not start at 0, marked by ")";
## not for years, nor where 0 means nothing.
## Each plot has a title, a subtitle if needed, and the source of its data
## in `caption`, at the bottom right.
## Up to three categories, name them on the plot in their color rather than
## in a legend.
## Ordered factors ignore the theme's palettes: add
## `scale_colour_ordinal(type = idest_seq)` (or `scale_fill_ordinal()`).
theme_lex_viz <- function(base_size = 10, grid = "xy", arrows = "xy", break_not_zero = "") {
  grid_line <- element_line(colour = "#d6d6d6", linewidth = 0.25)
  arrow_line <- function(axis) {
    new <- if (grepl(axis, break_not_zero)) { element_line_break } else { element_line }
    new(colour = "black", linewidth = 0.5,
        arrow = grid::arrow(length = unit(1.6, "mm"), angle = 25, type = "closed"))
  }
  theme_minimal(base_size = base_size, base_family = "Quicksand") +
    theme(
      text = element_text(colour = "#535353"),
      plot.title = element_text(colour = "black", face = "bold", hjust = 0),
      ## A text box, so that a long subtitle wraps to the plot's width
      ## instead of running off it; it reads Markdown (escape _ and *).
      plot.subtitle = ggtext::element_textbox_simple(margin = margin(b = 6)),
      plot.caption = element_text(colour = "#7d7d7d", size = rel(0.7), hjust = 1),
      plot.title.position = "plot",
      plot.caption.position = "plot",
      axis.text = element_text(colour = "#535353"),
      axis.ticks = element_blank(),
      axis.line.x = if (grepl("x", arrows)) { arrow_line("x") } else { element_blank() },
      axis.line.y = if (grepl("y", arrows)) { arrow_line("y") } else { element_blank() },
      panel.grid.minor = element_blank(),
      panel.grid.major.x = if (grepl("x", grid)) { grid_line } else { element_blank() },
      panel.grid.major.y = if (grepl("y", grid)) { grid_line } else { element_blank() },
      legend.position = "top",
      legend.justification = "left",
      strip.text = element_text(face = "bold", hjust = 0),
      geom = element_geom(family = "Quicksand"),
      palette.colour.discrete = lex_pal_discrete,
      palette.fill.discrete = lex_pal_discrete,
      palette.colour.continuous = idest_seq,
      palette.fill.continuous = idest_seq
    )
}