Víctor Gauto
  • Tidytuesday
  • Publicaciones
  • Mapas de Argentina
  • Visualizaciones
  1. 2025
  2. Semana 08

Sitio en construcción

  • Inicio
  • 2025
    • Semana 02
    • Semana 03
    • Semana 04
    • Semana 05
    • Semana 06
    • Semana 07
    • Semana 08
    • Semana 09
    • Semana 10
    • Semana 11
    • Semana 12
    • Semana 13
    • Semana 14
    • Semana 15
    • Semana 16
    • Semana 17
    • Semana 18
    • Semana 19
    • Semana 20
    • Semana 21
  • 2024
    • Semana 02
    • Semana 03
    • Semana 04
    • Semana 05
    • Semana 06
    • Semana 07
    • Semana 08
    • Semana 09
    • Semana 10
    • Semana 11
    • Semana 12
    • Semana 13
    • Semana 14
    • Semana 15
    • Semana 16
    • Semana 17
    • Semana 18
    • Semana 19
    • Semana 20
    • Semana 21
    • Semana 22
    • Semana 23
    • Semana 24
    • Semana 25
    • Semana 26
    • Semana 27
    • Semana 28
    • Semana 29
    • Semana 30
    • Semana 31
    • Semana 32
    • Semana 33
    • Semana 34
    • Semana 35
    • Semana 36
    • Semana 37
    • Semana 38
    • Semana 39
    • Semana 40
    • Semana 41
    • Semana 42
    • Semana 43
    • Semana 44
    • Semana 45
    • Semana 46
    • Semana 47
    • Semana 48
    • Semana 49
    • Semana 50
    • Semana 51
    • Semana 52
    • Semana 53
  • 2023
    • Semana 07
    • Semana 12
    • Semana 13
    • Semana 14
    • Semana 15
    • Semana 16
    • Semana 17
    • Semana 18
    • Semana 19
    • Semana 20
    • Semana 21
    • Semana 22
    • Semana 23
    • Semana 24
    • Semana 25
    • Semana 26
    • Semana 27
    • Semana 28
    • Semana 29
    • Semana 30
    • Semana 31
    • Semana 32
    • Semana 33
    • Semana 34
    • Semana 35
    • Semana 36
    • Semana 37
    • Semana 38
    • Semana 39
    • Semana 40
    • Semana 41
    • Semana 42
    • Semana 43
    • Semana 44
    • Semana 45
    • Semana 46
    • Semana 47
    • Semana 48
    • Semana 49
    • Semana 50
    • Semana 51
    • Semana 52

Contenido

  • Paquetes
  • Estilos
  • Epígrafe
  • Datos
  • Procesamiento
  • Figura
  • Editar esta página
  • Informar de un problema
  1. 2025
  2. Semana 08

Semana 08

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

  • Ver el código fuente
geom_text_wordcloud
Autor

Víctor Gauto

Fecha de publicación

25 de febrero de 2025

Categorías raciales en papers de ginecología y obstetricia.

Semana 08, 2025

Paquetes

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

Estilos

Colores.

Ocultar código
c1 <- "#FDAD17"
c2 <- "#52C890"
c3 <- "#0D2D4C"
c4 <- "#E99BB9"
c5 <- "white"

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 08<br>",
    "<b>Racial and ethnic disparities in reproductive medicine in the United<br>
     States: a narrative review of contemporary high-quality evidence</b><br>
    Lewis, Ayodele G. et al.<br>
    <i>American Journal of Obstetrics & Gynecology, Volume 232, Issue 1, 82 - 91.e44</i>.</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, 08)
article_dat <- tuesdata$article_dat
model_dat <- tuesdata$model_dat

Procesamiento

Me interesa la cantidad de categorías raciales y armar una nube de palabras.

Ocultar código
d <- article_dat |>
  select(starts_with("race")) |>
  select(!ends_with("_ss")) |>
  pivot_longer(
    cols = everything(),
    values_to = "cat",
    names_to = "col"
  ) |>
  drop_na() |>
  mutate(
    cat = tolower(cat)
  ) |>
  mutate(
    cat = str_replace(cat, "alaskan", "alaska"),
    cat = str_replace(cat, "whites", "white"),
    cat = str_replace(cat, "blacks", "black"),
    cat = str_replace(cat, "others", "other"),
    cat = str_remove_all(cat, "-")
  ) |>
  mutate(
    cat = if_else(
      str_detect(cat, "unknown"),
      "unknown",
      cat
    )
  ) |>
  count(cat, sort = TRUE) |>
  filter(n > 1) %>%
  mutate(
    col = sample(c(c1, c2), replace = TRUE, size = nrow(.))
  )

Figura

Subtítulo y nube de palabras.

Ocultar código
mi_subtitle <- glue(
  "<b style='color: {c4}'>{nrow(d)}</b> categorías raciales presentes en
  trabajos científicos de<br>
  <b>obstetricia</b> y <b>ginecología</b> entre 2010 y 2023"
)

g <- ggplot(d, aes(label = cat, size = n, color = col)) +
  geom_text_wordcloud(shape = "square") +
  scale_size_area(max_size = 40) +
  scale_color_identity() +
  labs(
    subtitle = mi_subtitle, caption = mi_caption
  ) +
  theme_minimal() +
  theme(
    plot.background = element_rect(fill = c3, color = NA),
    plot.subtitle = element_markdown(
      color = c5, family = "ubuntu", size = 30, hjust = .5,
      lineheight = 1.1, margin = margin(t = 20)
    ),
    plot.caption = element_markdown(
      color = c2, family = "ubuntu", size = 15, lineheight = 1.1,
      margin = margin(b = 10, r = 10)
    )
  )

Guardo.

Ocultar código
ggsave(
  plot = g,
  filename = "tidytuesday/2025/semana_08.png",
  width = 30,
  height = 30,
  units = "cm"
)
Subir
Semana 07
Semana 09
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_text_wordcloud"]
execute:
  eval: false
  echo: true
  warning: false
title: "Semana 08"
date: 2025-02-25
author: Víctor Gauto
---

Categorías raciales en papers de ginecología y obstetricia.

![Semana 08, 2025](semana_08.png)

## Paquetes

```{r}
library(glue)
library(ggtext)
library(showtext)
library(ggwordcloud)
library(tidyverse)
```

## Estilos

Colores.

```{r}
c1 <- "#FDAD17"
c2 <- "#52C890"
c3 <- "#0D2D4C"
c4 <- "#E99BB9"
c5 <- "white"
```

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 08<br>",
    "<b>Racial and ethnic disparities in reproductive medicine in the United<br>
     States: a narrative review of contemporary high-quality evidence</b><br>
    Lewis, Ayodele G. et al.<br>
    <i>American Journal of Obstetrics & Gynecology, Volume 232, Issue 1, 82 - 91.e44</i>.</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(2025, 08)
article_dat <- tuesdata$article_dat
model_dat <- tuesdata$model_dat
```

## Procesamiento

Me interesa la cantidad de categorías raciales y armar una nube de palabras.

```{r}
d <- article_dat |>
  select(starts_with("race")) |>
  select(!ends_with("_ss")) |>
  pivot_longer(
    cols = everything(),
    values_to = "cat",
    names_to = "col"
  ) |>
  drop_na() |>
  mutate(
    cat = tolower(cat)
  ) |>
  mutate(
    cat = str_replace(cat, "alaskan", "alaska"),
    cat = str_replace(cat, "whites", "white"),
    cat = str_replace(cat, "blacks", "black"),
    cat = str_replace(cat, "others", "other"),
    cat = str_remove_all(cat, "-")
  ) |>
  mutate(
    cat = if_else(
      str_detect(cat, "unknown"),
      "unknown",
      cat
    )
  ) |>
  count(cat, sort = TRUE) |>
  filter(n > 1) %>%
  mutate(
    col = sample(c(c1, c2), replace = TRUE, size = nrow(.))
  )
```

## Figura

Subtítulo y nube de palabras.

```{r}
mi_subtitle <- glue(
  "<b style='color: {c4}'>{nrow(d)}</b> categorías raciales presentes en
  trabajos científicos de<br>
  <b>obstetricia</b> y <b>ginecología</b> entre 2010 y 2023"
)

g <- ggplot(d, aes(label = cat, size = n, color = col)) +
  geom_text_wordcloud(shape = "square") +
  scale_size_area(max_size = 40) +
  scale_color_identity() +
  labs(
    subtitle = mi_subtitle, caption = mi_caption
  ) +
  theme_minimal() +
  theme(
    plot.background = element_rect(fill = c3, color = NA),
    plot.subtitle = element_markdown(
      color = c5, family = "ubuntu", size = 30, hjust = .5,
      lineheight = 1.1, margin = margin(t = 20)
    ),
    plot.caption = element_markdown(
      color = c2, family = "ubuntu", size = 15, lineheight = 1.1,
      margin = margin(b = 10, r = 10)
    )
  )
```

Guardo.

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

Creado con y

Víctor Gauto

  • Editar esta página
  • Informar de un problema