Semana 52

Autores navideños con fotografía, año de nacimiento y fallecimiento, y obras.

Semana 52, 2025

Paquetes

library(glue)
library(ggtext)
library(showtext)
library(tidyverse)

Estilos

Colores.

c1 <- "#860a4d"
c2 <- "#9e0c4b"
c3 <- "white"
c4 <- "gold"

Fuentes: Ubuntu y JetBrains Mono.

font_add(
  family = "ubuntu",
  regular = "././fuente/Ubuntu-Regular.ttf",
  bold = "././fuente/Ubuntu-Bold.ttf",
  italic = "././fuente/Ubuntu-Italic.ttf"
)

font_add(
  family = "jet",
  regular = "././fuente/JetBrainsMonoNLNerdFontMono-Regular.ttf"
)

font_add_google(
  name = "Berkshire Swash",
  family = "berkshire"
)

showtext_auto()
showtext_opts(dpi = 300)

Epígrafe

fuente <- glue(
  "Datos: <span style='color:{c3};'><span style='font-family:jet;'>",
  "{{<b>tidytuesdayR</b>}}</span> semana 52, ",
  "<b>{{gutenbergr}}</b>.</span>"
)

autor <- glue("<span style='color:{c3};'>**Víctor Gauto**</span>")
icon_twitter <- glue("<span style='font-family:jet;'>&#xf099;</span>")
icon_instagram <- glue("<span style='font-family:jet;'>&#xf16d;</span>")
icon_github <- glue("<span style='font-family:jet;'>&#xf09b;</span>")
icon_mastodon <- glue("<span style='font-family:jet;'>&#xf0ad1;</span>")
icon_bsky <- glue("<span style='font-family:jet;'>&#xe28e;</span>")
usuario <- glue("<span style='color:{c3};'>**vhgauto**</span>")
sep <- glue("**|**")

mi_caption <- glue(
  "{fuente}<br>{autor} {sep} {icon_github} {icon_twitter} {icon_instagram} ",
  "{icon_mastodon} {icon_bsky} {usuario}"
)

Datos

tuesdata <- tidytuesdayR::tt_load(2025, 52)
christmas_novel_authors <- tuesdata$christmas_novel_authors
christmas_novels <- tuesdata$christmas_novels

Procesamiento

Me interesan los datos de los autores extraídos de Wikipedia.

d2 <- christmas_novel_authors |>
  filter(!str_detect(author, "Finley")) |>
  select(gutenberg_author_id, author, wikipedia) |>
  separate_wider_delim(
    cols = author,
    delim = ", ",
    names = c("apellido", NA),
    cols_remove = TRUE
  ) |>
  drop_na() |>
  mutate(wikipedia = str_remove(wikipedia, "\\|(.*)")) |>
  mutate(
    wikipedia = if_else(
      apellido == "Mitchell",
      "https://en.wikipedia.org/wiki/Silas_Weir_Mitchell_(physician)",
      wikipedia
    )
  ) |>
  mutate(apellido = if_else(apellido == "Van Dyke", "Dyke", apellido))

Función para ingresar al link de Wikipedia y extraer la dirección de la imagen del autor.

f_img <- function(gutenberg_author_id, apellido, wikipedia) {
  l <- rvest::read_html(wikipedia) |>
    rvest::html_elements("img") |>
    as.character()

  link <- l[str_detect(string = l, pattern = apellido)] |>
    pluck(1) |>
    rvest::minimal_html() |>
    rvest::html_elements("img") |>
    rvest::html_attr("src")

  if (length(link) == 0) {
    return(NULL)
  } else {
    return(tibble(id = gutenberg_author_id, link = paste0("https:", link)))
  }
}

Aplico la función a los datos y obtengo los links de las imágenes.

d_img <- pmap(d2, f_img) |>
  list_c()

Unifico los datos, aplico formato a los nombres de los autores y unifico las obras.

d2 <- inner_join(
  christmas_novel_authors,
  d_img,
  by = join_by(gutenberg_author_id == id)
) |>
  inner_join(christmas_novels, by = join_by(gutenberg_author_id)) |>
  select(author, birthdate, deathdate, title, link, gutenberg_author_id) |>
  mutate(author = str_remove(author, " \\(.*\\)")) |>
  mutate(author = str_replace(author, "(.*),", "**\\1**,")) |>
  mutate(title = str_wrap(title, width = 44)) |>
  mutate(title = glue("{title}<br>")) |>
  mutate(title = str_replace_all(title, "\\n", "<br>")) |>
  mutate(title = glue("\\- **{title}**")) |>
  reframe(
    label = str_flatten(title, collapse = ""),
    .by = c(author, birthdate, deathdate, link, gutenberg_author_id)
  ) |>
  arrange(author) %>%
  mutate(id = row_number())

Para desplazar los recuadros agrego dos filas sin datos.

d_na <- slice(d2, 1:2) |>
  mutate(
    across(
      everything(),
      ~NA
    )
  )

Combino los datos y agrego las posiciones de las figuras.

d <- rbind(d_na, d2) %>%
  mutate(x = rep(1:3, length.out = nrow(.))) %>%
  mutate(y = rep(10:1, each = 3, length.out = nrow(.))) |>
  mutate(link = glue("<img src='{link}' width=50 />")) |>
  mutate(años = glue("({birthdate}-{deathdate})")) |>
  drop_na()

Figura

g <- ggplot(d, aes(x, y)) +
  geom_richtext(
    aes(label = link),
    fill = c4,
    label.color = NA,
    label.padding = unit(c(.1, .1, .1, .1), "lines"),
    label.r = unit(0, "pt"),
    hjust = 1,
    vjust = 1
  ) +
  geom_richtext(
    aes(label = author),
    hjust = 0,
    label.color = NA,
    label.r = unit(0, "pt"),
    vjust = 1,
    size = 5,
    fill = c2,
    color = c3
  ) +
  geom_richtext(
    aes(y = y - .2, label = años),
    hjust = 0,
    vjust = 1,
    size = 3,
    label.color = NA,
    label.r = unit(0, "pt"),
    fill = c2,
    family = "jet",
    color = c3
  ) +
  geom_richtext(
    aes(y = y - .4, label = label),
    hjust = 0,
    vjust = 1,
    family = "ubuntu",
    size = 3,
    label.r = unit(0, "pt"),
    label.color = NA,
    fill = NA,
    color = c3
  ) +
  annotate(
    geom = "text",
    x = 1,
    y = 10,
    label = "Autores navideños",
    layout = 1,
    hjust = 0,
    vjust = 1,
    fontface = "bold",
    family = "berkshire",
    size = 50,
    size.unit = "pt",
    color = c4
  ) +
  geom_richtext(
    size = 5,
    nudge_x = .02,
    nudge_y = .02,
    label = "&#xf06b;",
    family = "jet",
    angle = -20,
    fill = NA,
    color = c4,
    label.color = NA
  ) +
  labs(caption = mi_caption) +
  coord_cartesian(xlim = c(.75, 4), expand = FALSE, clip = "off") +
  theme_void(base_family = "ubuntu", base_size = 15) +
  theme_sub_plot(
    margin = margin(b = 70, t = 10),
    background = element_rect(fill = c1),
    caption = element_markdown(
      color = c4,
      margin = margin(t = 60, b = -60),
      hjust = .5,
      lineheight = 1.3
    )
  )

Guardo.

ggsave(
  plot = g,
  filename = "tidytuesday/2025/semana_52.png",
  width = 30,
  height = 30,
  units = "cm"
)