geom_tile
geom_segment
geom_image
Autor

Víctor Gauto

Fecha de publicación

19 de noviembre de 2025

Cantidad de grullas observadas en el Lago Hornborgasjön, Suecia.

Semana 39, 2025

Paquetes

Ocultar código 
library(glue)
library(ggtext)
library(showtext)
library(tidyverse)

Estilos

Colores.

Ocultar código 
c1 <- "#4888B8"
c2 <- "#C54A52"
c3 <- "#F6F6F6"

Fuentes: Ubuntu y JetBrains Mono.

Ocultar código 
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"
)

showtext_auto()
showtext_opts(dpi = 300)

Epígrafe

Ocultar código 
fuente <- glue(
  "Datos: <span style='color:{c1};'><span style='font-family:jet;'>",
  "{{<b>tidytuesdayR</b>}}</span> semana 39, ",
  "<b>Lake Hornborgasjön</b>.</span>"
)

autor <- glue("<span style='color:{c1};'>**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:{c1};'>**vhgauto**</span>")
sep <- glue("**|**")

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

Datos

Ocultar código 
tuesdata <- tidytuesdayR::tt_load(2025, 39)
cranes <- tuesdata$cranes

Procesamiento

Me interesa los meses y años en los que hubo mayores observaciones de grullas.

Creo etiquetas para los meses y agrego por mes y año, de 2002 en adelante.

Ocultar código 
meses <- toupper(sort(unique(month(cranes$date, label = TRUE, abbr = FALSE))))

d <- cranes |>
  mutate(
    mes = month(date, label = TRUE, abbr = FALSE),
    año = year(date)
  ) |>
  mutate(mes = toupper(mes)) |>
  reframe(
    s = sum(observations, na.rm = TRUE),
    .by = c(año, mes)
  ) |>
  filter(año >= 2002) |>
  mutate(mes = factor(mes, levels = meses))

Figura

Logo de la estación de vigilancia en Lago Hornborgasjön, en Suecia, y título de la figura.

Ocultar código 
mi_titulo <- glue(
  "Observaciones de <b style='color: {c1};'>grullas</b>, por mes y año, en el Lago Hornborgasjön en Suecia"
)

logo <- "https://www.hornborga.com/wp-content/uploads/Naturum-logotyp-Hornborgasjo%C2%A6en-sv-1.png"

logo_tbl <- tibble(
  x = I(.94),
  y = I(1.1),
  image = logo
)

Figura.

Ocultar código 
g <- ggplot(d, aes(año, mes, fill = s)) +
  geom_tile(color = c3, linewidth = 1) +
  geom_segment(
    x = 2000,
    xend = 2024.6,
    y = 2.5,
    yend = 2.5,
    linetype = 2,
    linewidth = .2
  ) +
  ggimage::geom_image(
    data = logo_tbl,
    aes(x, y, image = image),
    size = .5,
    inherit.aes = FALSE
  ) +
  coord_equal(expand = FALSE, clip = "off") +
  scale_x_continuous(breaks = scales::breaks_width(2)) +
  tidyterra::scale_fill_whitebox_c(
    palette = "muted",
    labels = scales::label_number(scale = 1e-3),
    name = "Cantidad de\ngrullas, en miles"
  ) +
  labs(x = NULL, y = NULL, title = mi_titulo, caption = mi_caption) +
  theme_classic(base_size = 12, base_family = "ubuntu") +
  theme(
    plot.background = element_rect(fill = c3, color = NA),
    plot.title = element_markdown(
      hjust = 0,
      margin = margin(b = 10, t = 5),
      size = rel(1.5)
    ),
    plot.title.position = "panel",
    plot.caption = element_markdown(
      color = c2,
      margin = margin(t = 15),
      lineheight = 1.1,
      size = rel(.8)
    ),
    axis.line = element_blank(),
    axis.text.x = element_text(family = "jet", margin = margin(t = 5)),
    axis.text.y = element_text(
      face = "bold",
      hjust = 1,
      margin = margin(r = 5)
    ),
    axis.ticks = element_blank(),
    legend.background = element_blank(),
    legend.title = element_text(
      hjust = 1,
      margin = margin(r = 20, b = 10),
      size = rel(.8)
    ),
    legend.position = "top",
    legend.justification.top = c(0, 0),
    legend.text = element_text(
      family = "jet",
      size = rel(.8),
      margin = margin(t = 3)
    ),
    legend.key.height = unit(4, "mm"),
    legend.key.width = unit(16, "mm"),
    legend.ticks = element_blank(),
    legend.box.spacing = unit(0, "mm")
  )

Guardo.

Ocultar código 
ggsave(
  plot = g,
  filename = "tidytuesday/2025/semana_39.png",
  width = 30,
  height = 11,
  units = "cm"
)
Subir