geom_treemap
geom_from_path
Autor

Víctor Gauto

Fecha de publicación

11 de febrero de 2025

Agencias de EE.UU. afectadas por la deshabilitación al acceso de bases de datos.

Semana 06, 2025

Paquetes

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

Estilos

Colores

Ocultar código 
c1 <- "#0A3161"
c2 <- "#B31942"
c3 <- "grey90"

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,<br>",
    "<b>CDC datasets</b> en <i>archive.org</i>, Jon Harmon.</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, 06)
cdc_datasets <- tuesdata$cdc_datasets
omb_codes <- tuesdata$omb_codes
fpi_codes <- tuesdata$fpi_codes

Procesamiento

Me interesa la proporción de agencias en las bases de datos eliminadas.

La figura es un treemap, que puede generarse con el paquete {treemapify}.

Ocultar código 
d <- cdc_datasets |>
  select(bureau_code) |>
  separate_wider_delim(
    cols = bureau_code, delim = ":", names = c("agency_code", "bureau_code")
  ) |>
  mutate(
    across(
      .cols = everything(),
      .fns = as.numeric
    )
  ) |>
  inner_join(
    omb_codes, by = join_by(agency_code, bureau_code),
    relationship = "many-to-many") |>
  select(agency_name, bureau_name) |>
  count(agency_name, bureau_name, sort = TRUE) |>
  select(-agency_name) |>
  mutate(
    bureau_name = str_wrap(bureau_name, 15)
  )

Logos de las agencias y coordenadas para las flechas curvas.

Ocultar código 
logos <- c(
  `Centers for Disease Control and Prevention` = "https://www.cdc.gov/TemplatePackage/5.0/img/logo/cdc-logo-tag-right.svg",
  `Department of Health and Human Services` = "https://www.hhs.gov/themes/custom/hhs_uswds/logo-desktop.svg",
  `Health Resources and Services Administration` = "https://www.hrsa.gov/themes/hrsa/uswds_hrsa/images/hrsa-logo.png",
  `Centers for Medicare and Medicaid Services` = "https://www.cms.gov/themes/custom/cms_evo/logo.svg"
)

logos_tbl <- tibble(
  img = logos,
  x = c(.5, .5, 1.11, 1.11),
  y = c(.4, .9, .87, 1.03),
  width = c(.3, .4, .2, .2)
)

Figura

Subtítulo y figura principal

Ocultar código 
mi_subtitulo <- glue(
  "La gestión actual de EE.UU. comenzó a <span style='color:{c2}'>deshabilitar",
  "</span> el acceso a<br>bases de datos, en particular de agencias de salud ",
  "federales."
)

g <- ggplot(d, aes(area = n, label = bureau_name)) +
  geom_treemap(
    alpha = 1, layout = "srow", linetype = 1, color = c3, size = 1,
    fill = c1
  ) +
  geom_from_path(
    data = logos_tbl, aes(x, y, path = img, width = width), inherit.aes = FALSE
  ) +
  annotate(
    geom = "curve", x = 1.1, y = 1.01, xend = 1.001, yend = .98,
    curvature = -.1, color = c2, arrow.fill = c2,
    arrow = arrow(angle = 15, length = unit(5, "pt"), type = "closed")
  ) +
  annotate(
    geom = "curve", x = 1.1, y = .83, xend = 1.001, yend = .8,
    curvature = -.1, color = c2, arrow.fill = c2,
    arrow = arrow(angle = 15, length = unit(5, "pt"), type = "closed")
  ) +
  coord_cartesian(
    xlim = c(0, 1), ylim = c(0, 1), expand = FALSE, clip = "off"
  ) +
  labs(subtitle = mi_subtitulo, caption = mi_caption) +
  theme_void() +
  theme(
    aspect.ratio = 1,
    text = element_text(family = "ubuntu"),
    plot.background = element_rect(fill = c3, color = NA),
    plot.margin = margin(10, 210, 2, 5),
    plot.subtitle = element_markdown(
      color = c1, face = "bold", size = 20, margin = margin(b = 10),
      lineheight = 1.2
    ),
    plot.caption = element_markdown(
      color = c2, size = 10, lineheight = 1.4,
      margin = margin(t = -45, r = -200, l = 10)
    ),
    legend.position = "none"
  )

Guardo

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