geom_spatraster
geom_spatvector
Autor

Víctor Gauto

Fecha de publicación

28 de mayo de 2025

Eventos sísmicos en el Monte Vesubio.

Semana 19, 2025

Paquetes

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

Estilos

Colores.

Ocultar código 
c1 <- "violetred"
c2 <- "#FEFED7"
c3 <- "#081C57"

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 19, ",
  "<b>Italian Istituto Nazionale di Geofisica e Vulcanologia</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, 19)
vesuvius <- tuesdata$vesuvius

Procesamiento

Me interesa la cantidad de terremotos en el Vesubio, sobre un mapa, por los últimos nueve años. El mapa es de la topografía del volcán.

Creo un vector a partir de los datos desde 2016 inclusive.

Ocultar código 
v <- vesuvius |>
  drop_na(latitude, longitude) |>
  filter(year >= 2016) |> 
  terra::vect(
    geom = c("longitude", "latitude"), crs = "EPSG:4326"
  )

v_sf <- sf::st_as_sf(v)

Creo un círculo alrededor de las coordenadas del volcán y obtengo la elevación del terreno.

Ocultar código 
buf_sf <- data.frame(
  x = 14.42599167,
  y = 40.82166944
) |>
  vect(geom = c("x", "y"), crs = "EPSG:4326") |>
  buffer(2000, quadsegs = 500) |>
  sf::st_as_sf()

elev <- elevatr::get_elev_raster(
  locations = buf_sf,
  z = 13,
  clip = "locations"
) |>
  terra::rast()

names(elev) <- "altura"

Recorto los datos para conservar únicamente los que coinciden con el ráster de elevación.

Ocultar código 
v_crop <- sf::st_intersection(v_sf, buf_sf) |> 
  vect()

Cuento la cantidad de eventos por año y genero etiquetas para las facetas de la figura.

Ocultar código 
v_crop_tbl <- as.data.frame(v_crop, geom = "xy") |> 
  as_tibble()

v_n <- count(v_crop_tbl, year) |> 
  mutate(
    label = glue("**{year}** ({n})")
  )

año_label <- v_n$label
año_label <- set_names(año_label, as.character(v_n$year))

Figura

Defino un estilo para los títulos de las facetas.

Ocultar código 
label_style <- modify_style(
  classic_style(),
  "body",
  family = "JetBrains Mono",
  color = c1
)

Creo título y subtítulo.

Ocultar código 
mi_titulo <- glue(
  "Actividad sísmica en el <b style='color: {c1}'>Monte Vesubio</b>"
)

mi_subtitulo <- "Los valores entre paréntesis corresponden a la cantidad de 
eventos en ese año."

Creo los mapas con los eventos sísmicos por cada año.

Ocultar código 
g <- ggplot() +
  geom_spatraster(
    data = elev, aes(fill = altura)
  ) +
  geom_spatvector(
    data = v_crop, color = c1, size = 1, alpha = 1/3, shape = 16
  ) +
  scale_fill_whitebox_c(
    palette = "deep",
    name = "Altura (m)",
    breaks = seq(500, 1250, 250),
    labels = scales::label_number(big.mark = ".", decimal.mark = ","),
    limits = c(500, 1250)
  ) +
  facet_wrap(vars(year), ncol = 3, labeller = as_labeller(año_label)) +
  coord_sf(expand = FALSE) +
  labs(title = mi_titulo, subtitle = mi_subtitulo, caption = mi_caption) +
  theme_void(base_family = "ubuntu", base_size = 15) +
  theme(
    text = element_text(color = c2),
    plot.margin = margin(r = 10, l = 10, b = 10),
    plot.background = element_rect(fill = scales::col_darker(c3), color = NA),
    plot.title = element_markdown(
      size = rel(2.3), hjust = .5, margin = margin(b = 5, t = 10)
    ),
    plot.subtitle = element_markdown(
      size = rel(1.5), hjust = .5, margin = margin(b = 10)
    ),
    plot.caption = element_markdown(
      size = rel(1), lineheight = 1.3, margin = margin(t = 30)
    ),
    strip.text = element_marquee(
      family = "jet", margin = margin(t = 10, b = 0), style = label_style,
      size = rel(1.1)
    ),
    legend.position = "bottom",
    legend.title = element_text(margin = margin(b = 18, r = 8)),
    legend.key.width = unit(3, "cm"),
    legend.box.spacing = unit(1, "cm"),
    legend.text = element_text(family = "jet")
  )

Guardo.

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