geom_spatraster
geom_spatvector
Autor

Víctor Gauto

Fecha de publicación

2 de abril de 2026

Ubicación de munros en Escocia.

Semana 33, 2025

Paquetes

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

Estilos

Colores.

Ocultar código 
c1 <- "#5D2A13"
c2 <- "#7F9D90"
c3 <- "black"
c4 <- "white"
c5 <- "#20235B"

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 33, ",
  "<b>The Database of British and Irish Hills v18.2<br>www.hills-database.co.uk</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, 33)
scottish_munros <- tuesdata$scottish_munros

Procesamiento

Me interesa el mapa del relieve de la región indicando los munros.

Extraigo la extensión de los munros y recorto el vector de los sitios.

Ocultar código 
v <- scottish_munros |>
  select(Name, xcoord, ycoord) |>
  terra::vect(geom = c("xcoord", "ycoord"), crs = "EPSG:27700") |>
  terra::ext() |>
  terra::vect(crs = "EPSG:27700") |>
  terra::project("EPSG:4326")

p <- scottish_munros |>
  select(Name, xcoord, ycoord, Height_ft) |>
  filter(Height_ft > 3000) |>
  terra::vect(
    geom = c("xcoord", "ycoord"),
    crs = "EPSG:27700"
  ) |>
  terra::project("EPSG:4326")

p <- terra::crop(p, v)

Obtengo la elevación de la región, suavizo con una ventana de 3x3 y almaceno para una lectura posterior rápida.

Ocultar código 
e2 <- elevatr::get_elev_raster(
  locations = sf::st_as_sf(v),
  z = 10,
  clip = "bbox"
) |>
  terra::rast()

e <- terra::focal(e2, fun = median, w = 3)

terra::writeRaster(e, "tidytuesday/2025/semana_33.tif", overwrite = TRUE)

Polígono de Reino Unido, con sus divisiones administrativas.

Ocultar código 
gb <- rgeoboundaries::gb_adm2(country = "GBR") |>
  terra::vect()

Figura

Defino la paleta de colores, título y extensión del mapa.

Ocultar código 
col <- hypsometric_tints_db |>
  filter(pal == "meyers") |>
  pull(hex)

triangulo <- glue("<span style='font-family:jet; color: {c5}'>&#xf0536;</span>")

mi_titulo <- glue(
  "Un <b style='color: {c2}'>munro</b> es una montaña que supera los 3000 pies (914,4 m), en <b style='color: {c1}'>Escocia</b>.<br>Se muestran en el mapa {nrow(p)} munros ({triangulo})."
)

ext <- terra::ext(e)

Mapa, con escala.

Ocultar código 
g <- ggplot() +
  geom_spatraster(
    data = e,
    maxcell = prod(dim(e))
  ) +
  geom_spatvector(
    data = gb2,
    fill = NA,
    color = c3,
    linetype = 1,
    linewidth = .2
  ) +
  geom_spatvector(
    data = esc_crop,
    fill = NA,
    color = c4,
    linetype = 2,
    linewidth = .2
  ) +
  geom_spatvector(
    data = p,
    show.legend = FALSE,
    color = c5,
    shape = 17,
    size = 2,
    alpha = .7
  ) +
  ggspatial::annotation_scale(
    location = "bl",
    pad_x = unit(.3, "cm"),
    pad_y = unit(.3, "cm"),
    height = unit(0.5, "cm"),
    text_family = "ubuntu",
    text_cex = 1.2
  ) +
  scale_fill_gradientn(
    colors = col
  ) +
  coord_sf(
    expand = FALSE,
    xlim = c(ext$xmin, ext$xmax),
    ylim = c(ext$ymin, ext$ymax)
  ) +
  labs(fill = "Altura (m)", title = mi_titulo, caption = mi_caption) +
  theme_void(base_family = "ubuntu", base_size = 16) +
  theme(
    plot.margin = margin(b = 15, t = 25),
    plot.background = element_rect(fill = "white", color = NA),
    plot.title = element_markdown(
      size = rel(1.3),
      lineheight = 1.2,
      margin = margin(b = 5)
    ),
    plot.caption = element_markdown(
      color = c2,
      lineheight = 1.3,
      size = rel(.9)
    ),
    legend.position = "inside",
    legend.background = element_rect(fill = "white", color = "white"),
    legend.justification.inside = c(1, 0),
    legend.key.height = unit(1.2, "cm"),
    legend.margin = margin(5, 5, 5, 5)
  )

Guardo.

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