Víctor Gauto
  • Tidytuesday
  • Publicaciones
  • Mapas de Argentina
  • Visualizaciones
  • Mi CV

Sitio en construcción

Contenido

  • Paquetes
  • Estilos
  • Epígrafe
  • Datos
  • Procesamiento
  • Figura
  • Editar esta página
  • Informar sobre problema

Semana 06

  • Mostrar todo el código
  • Ocultar todo el código

  • Ver el código fuente
geom_spatraster_rgb
geom_spatvector
Autor

Víctor Gauto

Fecha de publicación

18 de febrero de 2026

Mapas RGB de las ciudades en las que ocurren los JJ. OO. de Invierno 2026, Milano y Cortina.

Semana 06, 2026

Paquetes

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

Estilos

Colores.

Ocultar código
c1 <- "#05a3bd"
c2 <- "#da7900"
c3 <- "white"
c4 <- "grey95"
c5 <- "grey30"
c6 <- "grey98"

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 06, ",
  "<b>XXV Olympic Winter Games | Milano Cortina 2026</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(2026, 06)
schedule <- tuesdata$schedule

Procesamiento

Me interesa señalar las ciudades de los JJ.OO., Milano y Cortina, en un mapa de Italia, y mostrar mapas satelitales para cada una.

Creo un vector con el nombre de las ciudades, para obtener los datos y generar los mapas. Asigno colores, obtengo las coordenadas y creo vector.

Ocultar código
ciudades <- c("Cortina d'Ampezzo", "Milano")

ciudades_col <- c(c1, c2)
ciudades_col <- set_names(ciudades_col, ciudades)

cortina <- c(12.137351, 46.538333)
milan <- c(9.19, 45.466944)

df <- data.frame(
  lon = c(12.137351, 9.19),
  lat = c(46.538333, 45.466944),
  ciudad = ciudades
)

p <- vect(df, geom = c("lon", "lat"), crs = "EPSG:4326")

Vectores de Italia y de las ciudades.

Ocultar código
it4 <- rgeoboundaries::geoboundaries(country = "ITA", adm_lvl = 4) |>
  terra::vect()

it1 <- rgeoboundaries::geoboundaries(country = "ITA", adm_lvl = 1) |>
  terra::vect()

v <- it4[it4$shapeName %in% ciudades]

Función para generar un vector buffer circular alrededor de las ciudades.

Ocultar código
f_bb <- function(X) {
  v <- v[v$shapeName == X]
  centro <- centroids(v)
  buffer(centro, width = width(v) * .8, quadsegs = 1000)
}

Función para obtener ráster RGB de los buffer de las ciudades.

Ocultar código
f_rgb <- function(X) {
  b <- f_bb(X)

  maptiles::get_tiles(
    x = b,
    provider = "Esri.WorldImagery",
    crop = TRUE,
    zoom = 13
  ) |>
    mask(b)
}

Ejecuto para ambas ciudades y asigno nombres.

Ocultar código
l_rgb <- map(ciudades, f_rgb)
l_rgb <- set_names(l_rgb, ciudades)

Figura

Función para generar los mapas de cada ciudad.

Ocultar código
f_gg <- function(X) {
  colorX <- if (X == "Milano") ciudades_col[2] else ciudades_col[1]
  locationX <- if (X == "Milano") "br" else "bl"

  ggplot() +
    geom_spatraster_rgb(
      data = l_rgb[[X]],
      maxcell = prod(dim(l_rgb[[X]]))
    ) +
    geom_spatvector(
      data = v[v$shapeName == X],
      fill = NA,
      color = colorX,
      linetype = 1,
      linewidth = .6
    ) +
    geom_spatvector(
      data = v[v$shapeName == X],
      fill = NA,
      color = c3,
      linetype = 2,
      linewidth = .6
    ) +
    geom_spatvector(
      data = f_bb(X),
      fill = NA,
      color = colorX,
      linewidth = 1
    ) +
    annotation_scale(
      location = locationX,
      bar_cols = c(c3, colorX),
      height = unit(.2, "cm"),
      line_col = colorX,
      text_family = "jet"
    ) +
    coord_sf(clip = "off") +
    labs(title = X) +
    theme_void(base_family = "ubuntu") +
    theme_sub_plot(
      title = element_text(
        hjust = .5,
        face = "bold",
        size = 15,
        color = colorX,
        margin = margin_auto(0)
      )
    )
}

Genero los mapas.

Ocultar código
l_gg <- map(ciudades, f_gg)

Mapa de Italia señalando las ciudades.

Ocultar código
gg_it <- ggplot() +
  geom_spatvector(
    data = it1,
    fill = c4,
    color = c5,
    linewidth = .2
  ) +
  geom_spatvector(
    data = v,
    aes(fill = shapeName),
    color = NA,
    show.legend = FALSE
  ) +
  annotate(
    geom = "segment",
    x = I(c(.48, .23)),
    xend = I(c(.65, .1)),
    y = I(c(.92, .84)),
    yend = I(c(.98, .95)),
    arrow = arrow(angle = 20, length = unit(5, "pt"), type = "closed")
  ) +
  annotate(
    geom = "label",
    x = I(c(.65, .1)),
    y = I(c(.98, .95)),
    label = ciudades,
    fill = NA,
    border.color = NA,
    fontface = "bold",
    family = "ubuntu",
    hjust = .5,
    vjust = 0,
    color = ciudades_col,
    size = 3
  ) +
  coord_sf(clip = "off", expand = TRUE) +
  scale_fill_manual(
    values = ciudades_col
  ) +
  theme_void()

Logo de los JJ. OO. para incorporar a la figura.

Ocultar código
logo <- "https://upload.wikimedia.org/wikipedia/commons/7/71/2026_Winter_Olympics_logo_%28Energy%29.svg"
logo_txt <- paste(readLines(logo), collapse = "\n")

Combino los mapas y agrego el logo.

Ocultar código
g <- wrap_plots(
  list(gg_it, l_gg[[1]], l_gg[[2]]),
  nrow = 1
) +
  annotation_custom(
    ggsvg::svg_to_rasterGrob(logo_txt),
    xmin = I(-2),
    xmax = I(-2.3),
    ymin = I(.2),
    ymax = I(-.1)
  ) &
  plot_annotation(
    title = glue(
      "Durante los <b style='color:{c1};'>JJ. OO. de Invierno 2026</b> se van a disputar <b style='color:{c2};'>{nrow(schedule)}</b> eventos deportivos"
    ),
    caption = mi_caption,
    theme = theme(
      plot.title = element_markdown(
        family = "ubuntu",
        size = 21,
        hjust = .5,
        margin = margin_auto(10)
      ),
      plot.caption = element_markdown(
        family = "ubuntu",
        color = c2,
        size = 8,
        lineheight = 1.3,
        margin = margin(t = 5, b = 3)
      ),
      plot.background = element_rect(fill = c6, color = NA)
    )
  )

Guardo.

Ocultar código
ggsave(
  plot = g,
  filename = "tidytuesday/2026/semana_06.png",
  width = 30,
  height = 12,
  units = "cm"
)
Subir
Ejecutar el código
---
format:
  html:
    code-fold: show
    code-summary: "Ocultar código"
    code-line-numbers: false
    code-annotations: false
    code-link: true
    code-tools:
        source: true
        toggle: true
        caption: "Código"
    code-overflow: scroll
    page-layout: full
editor_options:
  chunk_output_type: console
categories:
  - geom_spatraster_rgb
  - geom_spatvector
execute:
  eval: false
  echo: true
  warning: false
title: "Semana 06"
date: last-modified
author: Víctor Gauto
---

Mapas RGB de las ciudades en las que ocurren los **JJ. OO. de Invierno 2026**, Milano y Cortina.

::: {.column-screen-inset}

![Semana 06, 2026](semana_06.png)

:::

## Paquetes

```{r}
library(glue)
library(ggtext)
library(showtext)
library(terra)
library(tidyterra)
library(ggspatial)
library(patchwork)
library(tidyverse)
```

## Estilos

Colores.

```{r}
c1 <- "#05a3bd"
c2 <- "#da7900"
c3 <- "white"
c4 <- "grey95"
c5 <- "grey30"
c6 <- "grey98"
```

Fuentes: Ubuntu y JetBrains Mono.

```{r}
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

```{r}
fuente <- glue(
  "Datos: <span style='color:{c1};'><span style='font-family:jet;'>",
  "{{<b>tidytuesdayR</b>}}</span> semana 06, ",
  "<b>XXV Olympic Winter Games | Milano Cortina 2026</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

```{r}
tuesdata <- tidytuesdayR::tt_load(2026, 06)
schedule <- tuesdata$schedule
```

## Procesamiento

Me interesa señalar las ciudades de los JJ.OO., Milano y Cortina, en un mapa de Italia, y mostrar mapas satelitales para cada una.

Creo un vector con el nombre de las ciudades, para obtener los datos y generar los mapas. Asigno colores, obtengo las coordenadas y creo vector.

```{r}
ciudades <- c("Cortina d'Ampezzo", "Milano")

ciudades_col <- c(c1, c2)
ciudades_col <- set_names(ciudades_col, ciudades)

cortina <- c(12.137351, 46.538333)
milan <- c(9.19, 45.466944)

df <- data.frame(
  lon = c(12.137351, 9.19),
  lat = c(46.538333, 45.466944),
  ciudad = ciudades
)

p <- vect(df, geom = c("lon", "lat"), crs = "EPSG:4326")
```

Vectores de Italia y de las ciudades.

```{r}
it4 <- rgeoboundaries::geoboundaries(country = "ITA", adm_lvl = 4) |>
  terra::vect()

it1 <- rgeoboundaries::geoboundaries(country = "ITA", adm_lvl = 1) |>
  terra::vect()

v <- it4[it4$shapeName %in% ciudades]
```

Función para generar un vector buffer circular alrededor de las ciudades.

```{r}
f_bb <- function(X) {
  v <- v[v$shapeName == X]
  centro <- centroids(v)
  buffer(centro, width = width(v) * .8, quadsegs = 1000)
}
```

Función para obtener ráster RGB de los buffer de las ciudades.

```{r}
f_rgb <- function(X) {
  b <- f_bb(X)

  maptiles::get_tiles(
    x = b,
    provider = "Esri.WorldImagery",
    crop = TRUE,
    zoom = 13
  ) |>
    mask(b)
}
```

Ejecuto para ambas ciudades y asigno nombres.

```{r}
l_rgb <- map(ciudades, f_rgb)
l_rgb <- set_names(l_rgb, ciudades)
```

## Figura

Función para generar los mapas de cada ciudad.

```{r}
f_gg <- function(X) {
  colorX <- if (X == "Milano") ciudades_col[2] else ciudades_col[1]
  locationX <- if (X == "Milano") "br" else "bl"

  ggplot() +
    geom_spatraster_rgb(
      data = l_rgb[[X]],
      maxcell = prod(dim(l_rgb[[X]]))
    ) +
    geom_spatvector(
      data = v[v$shapeName == X],
      fill = NA,
      color = colorX,
      linetype = 1,
      linewidth = .6
    ) +
    geom_spatvector(
      data = v[v$shapeName == X],
      fill = NA,
      color = c3,
      linetype = 2,
      linewidth = .6
    ) +
    geom_spatvector(
      data = f_bb(X),
      fill = NA,
      color = colorX,
      linewidth = 1
    ) +
    annotation_scale(
      location = locationX,
      bar_cols = c(c3, colorX),
      height = unit(.2, "cm"),
      line_col = colorX,
      text_family = "jet"
    ) +
    coord_sf(clip = "off") +
    labs(title = X) +
    theme_void(base_family = "ubuntu") +
    theme_sub_plot(
      title = element_text(
        hjust = .5,
        face = "bold",
        size = 15,
        color = colorX,
        margin = margin_auto(0)
      )
    )
}
```

Genero los mapas.

```{r}
l_gg <- map(ciudades, f_gg)
```

Mapa de Italia señalando las ciudades.

```{r}
gg_it <- ggplot() +
  geom_spatvector(
    data = it1,
    fill = c4,
    color = c5,
    linewidth = .2
  ) +
  geom_spatvector(
    data = v,
    aes(fill = shapeName),
    color = NA,
    show.legend = FALSE
  ) +
  annotate(
    geom = "segment",
    x = I(c(.48, .23)),
    xend = I(c(.65, .1)),
    y = I(c(.92, .84)),
    yend = I(c(.98, .95)),
    arrow = arrow(angle = 20, length = unit(5, "pt"), type = "closed")
  ) +
  annotate(
    geom = "label",
    x = I(c(.65, .1)),
    y = I(c(.98, .95)),
    label = ciudades,
    fill = NA,
    border.color = NA,
    fontface = "bold",
    family = "ubuntu",
    hjust = .5,
    vjust = 0,
    color = ciudades_col,
    size = 3
  ) +
  coord_sf(clip = "off", expand = TRUE) +
  scale_fill_manual(
    values = ciudades_col
  ) +
  theme_void()
```

Logo de los JJ. OO. para incorporar a la figura.

```{r}
logo <- "https://upload.wikimedia.org/wikipedia/commons/7/71/2026_Winter_Olympics_logo_%28Energy%29.svg"
logo_txt <- paste(readLines(logo), collapse = "\n")
```

Combino los mapas y agrego el logo.

```{r}
g <- wrap_plots(
  list(gg_it, l_gg[[1]], l_gg[[2]]),
  nrow = 1
) +
  annotation_custom(
    ggsvg::svg_to_rasterGrob(logo_txt),
    xmin = I(-2),
    xmax = I(-2.3),
    ymin = I(.2),
    ymax = I(-.1)
  ) &
  plot_annotation(
    title = glue(
      "Durante los <b style='color:{c1};'>JJ. OO. de Invierno 2026</b> se van a disputar <b style='color:{c2};'>{nrow(schedule)}</b> eventos deportivos"
    ),
    caption = mi_caption,
    theme = theme(
      plot.title = element_markdown(
        family = "ubuntu",
        size = 21,
        hjust = .5,
        margin = margin_auto(10)
      ),
      plot.caption = element_markdown(
        family = "ubuntu",
        color = c2,
        size = 8,
        lineheight = 1.3,
        margin = margin(t = 5, b = 3)
      ),
      plot.background = element_rect(fill = c6, color = NA)
    )
  )
```

Guardo.

```{r}
ggsave(
  plot = g,
  filename = "tidytuesday/2026/semana_06.png",
  width = 30,
  height = 12,
  units = "cm"
)
```

Creado con y

Víctor Gauto

  • Editar esta página
  • Informar sobre problema