geom_tile
geom_segment
geom_image
Autor

Víctor Gauto

Fecha de publicación

2 de abril de 2026

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