plot_usmap
Autor

Víctor Gauto

Fecha de publicación

14 de marzo de 2026

Cantidad de proyectos de investigación finalizados por estado en EE.UU.

Semana 18, 2025

Paquetes

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

Estilos

Colores.

Ocultar código 
c1 <- "#420F75"
c2 <- "#552000"
c3 <- "white"
c4 <- "#E1C1C8"

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 18, ",
    "<b>U.S. National Science Foundation</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, 18)
nsf_terminations <- tuesdata$nsf_terminations

Procesamiento

Me interesa ver la distribución de proyectos cancelados por estado de EE.UU, mediante un mapa.

Ocultar código 
d <- nsf_terminations |> 
  count(org_state) |> 
  rename(state = org_state)

Figura

Subtítulo indicando la cantidad de proyectos afectados y el estado con mayor cantidad.

Ocultar código 
mi_subtitulo <- glue(
  "La administración Trump decidió terminar con {{{c1} _**{nrow(nsf_terminations)}**_} 
  subvenciones a investigación.
  **California** fue el estado más afectado con {{{c2} _**{d[d$n == max(d$n),]$n}**_} proyectos finalizados."
)
Ocultar código 
g <- usmap::plot_usmap(
  exclude = c("AK", "HI"),
  data = d,
  values = "n",
  color = c4,
  linewidth = .6
) +
  coord_sf(expand = FALSE) +
  scale_fill_steps2(
    low = c1,
    mid = c3,
    high = c2,
    midpoint = 64,
    breaks = c(1, seq(25, 125, 25)),
    limits = c(1, 125)
  ) +
  labs(
    subtitle = mi_subtitulo,
    fill = "Cantidad de\nproyectos afectados",
    caption = mi_caption
  ) +
  theme_void(base_family = "ubuntu", base_size = 20) +
  theme(
    plot.margin = margin(t = 10, b = 5, r = 15, l = 15),
    plot.background = element_rect(fill = c4, color = NA),
    plot.subtitle = marquee::element_marquee(
      width = .92, lineheight = 1.3, size = rel(1.), margin = margin(b = 15)
    ),
    plot.caption = element_markdown(
      color = c2, size = rel(.5), margin = margin(b = 10, t = 10),
      lineheight = 1.3
    ),
    legend.position = "inside",
    legend.position.inside = c(0, 0),
    legend.justification.inside = c(0, 0),
    legend.title = element_text(size = rel(.7)),
    legend.text = element_text(family = "jet", size = rel(.5))
  )

Guardo.

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