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

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 09

Semana 09

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

  • Ver el código fuente
geom_richtext
Autor

Víctor Gauto

Fecha de publicación

4 de marzo de 2025

Nombres más populares de gatos y perros.

Semana 09, 2025

Paquetes

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

Estilos

Colores.

Ocultar código
c1 <- "#6497B1"
c2 <- "#FFF2F5"
c3 <- "#6A359C"
c4 <- "#679C35"

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"
)

font_add(
  family = "bebas",
  regular = "././fuente/BebasNeue-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 09, ",
    "<b>{{animalshelter}}</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, 09)
longbeach <- tuesdata$longbeach

Procesamiento

Me interesan los nombres más populares en perros y gatos.

Ocultar código
nombres <- longbeach |>
  select(animal_name, animal_type) |>
  filter(!str_detect(animal_name, fixed("*"))) |>
  filter(animal_name != "unknown") |>
  filter(!str_detect(animal_name, "kitten")) |>
  count(animal_name, animal_type) |>
  slice_max(order_by = n, n = 10, by = animal_type, with_ties = FALSE) |>
  filter(animal_type %in% c("dog", "cat")) |>
  select(-n, "nombre" = animal_name, "tipo" = animal_type)

Dispongo los nombres de manera radial.

Ocultar código
radio <- 1

d <- nombres |>
  mutate(
    id = row_number(), .by = tipo
  ) |>
  mutate(
    alfa = id/max(id)*2*pi
  ) |>
  mutate(
    x = radio*cos(alfa),
    y = radio*sin(alfa)
  ) |>
  mutate(
    color = rep(PrettyCols::prettycols(palette = "Bold"), 4)
  )

Íconos de perro y gato para ubicar en el centro de cada panel.

Ocultar código
icono <- tibble(
  x = 0,
  y = -.14,
  label = c("&#xf0a43;", "&#xf011b;"),
  tipo = c("dog", "cat"),
  color = c(c1, c4)
)

Figura

Íconos coloreados de perro y gato para usar en el subtítulo.

Ocultar código
perros <- glue("<b style='color: {c1}'>perros</b>")
gatos <- glue("<b style='color: {c4}'>gatos</b>")

mi_subtitulo <- glue(
  "Top 10 nombres más populares en {gatos} y {perros} del refugio Long
  Beach, en California"
)

Figura.

Ocultar código
g <- ggplot(d, aes(x, y, label = nombre, color = color)) +
  geom_segment(
    aes(x = 0, y = 0, xend = x, yend = y, color = color), linewidth = 1
  ) +
  annotate(
    geom = "point", x = 0, y = 0, size = 70, color = c2
  ) +
  geom_richtext(
    family = "bebas", size = 10, label.color = NA, fill = c2,
    label.padding = unit(.1, "lines")
  ) +
  geom_richtext(
    data = icono, aes(x, y, label = label, color = color), family = "jet",
    fill = NA, label.color = NA, size = 90, inherit.aes = FALSE
  ) +
  facet_wrap(vars(tipo), nrow = 1) +
  scale_color_identity() +
  coord_cartesian(
    clip = "off", expand = FALSE, xlim = c(-1, 1), ylim = c(-1, 1)
  ) +
  labs(subtitle = mi_subtitulo, caption = mi_caption) +
  theme_void() +
  theme(
    aspect.ratio = 1,
    text = element_text(family = "ubuntu", color = c3),
    plot.margin = margin(l = 30, r = 30),
    plot.background = element_rect(fill = c2, color = NA),
    plot.subtitle = element_markdown(
      size = 20, hjust = .5, margin = margin(b = 20, t = 10)
    ),
    plot.caption = element_markdown(
      margin = margin(b = 5, t = 30), lineheight = 1.3
    ),
    panel.spacing.x = unit(5, "cm"),
    panel.background = element_blank(),
    strip.text = element_blank()
  )

Guardo.

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

Nombres más populares de gatos y perros.

![Semana 09, 2025](semana_09.png)

## Paquetes

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

## Estilos

Colores.

```{r}
c1 <- "#6497B1"
c2 <- "#FFF2F5"
c3 <- "#6A359C"
c4 <- "#679C35"
```

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"
)

font_add(
  family = "bebas",
  regular = "././fuente/BebasNeue-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 09, ",
    "<b>{{animalshelter}}</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(2025, 09)
longbeach <- tuesdata$longbeach
```

## Procesamiento

Me interesan los nombres más populares en perros y gatos.

```{r}
nombres <- longbeach |>
  select(animal_name, animal_type) |>
  filter(!str_detect(animal_name, fixed("*"))) |>
  filter(animal_name != "unknown") |>
  filter(!str_detect(animal_name, "kitten")) |>
  count(animal_name, animal_type) |>
  slice_max(order_by = n, n = 10, by = animal_type, with_ties = FALSE) |>
  filter(animal_type %in% c("dog", "cat")) |>
  select(-n, "nombre" = animal_name, "tipo" = animal_type)
```

Dispongo los nombres de manera radial.

```{r}
radio <- 1

d <- nombres |>
  mutate(
    id = row_number(), .by = tipo
  ) |>
  mutate(
    alfa = id/max(id)*2*pi
  ) |>
  mutate(
    x = radio*cos(alfa),
    y = radio*sin(alfa)
  ) |>
  mutate(
    color = rep(PrettyCols::prettycols(palette = "Bold"), 4)
  )
```

Íconos de perro y gato para ubicar en el centro de cada panel.

```{r}
icono <- tibble(
  x = 0,
  y = -.14,
  label = c("&#xf0a43;", "&#xf011b;"),
  tipo = c("dog", "cat"),
  color = c(c1, c4)
)
```

## Figura

Íconos coloreados de perro y gato para usar en el subtítulo.

```{r}
perros <- glue("<b style='color: {c1}'>perros</b>")
gatos <- glue("<b style='color: {c4}'>gatos</b>")

mi_subtitulo <- glue(
  "Top 10 nombres más populares en {gatos} y {perros} del refugio Long
  Beach, en California"
)
```

Figura.

```{r}
g <- ggplot(d, aes(x, y, label = nombre, color = color)) +
  geom_segment(
    aes(x = 0, y = 0, xend = x, yend = y, color = color), linewidth = 1
  ) +
  annotate(
    geom = "point", x = 0, y = 0, size = 70, color = c2
  ) +
  geom_richtext(
    family = "bebas", size = 10, label.color = NA, fill = c2,
    label.padding = unit(.1, "lines")
  ) +
  geom_richtext(
    data = icono, aes(x, y, label = label, color = color), family = "jet",
    fill = NA, label.color = NA, size = 90, inherit.aes = FALSE
  ) +
  facet_wrap(vars(tipo), nrow = 1) +
  scale_color_identity() +
  coord_cartesian(
    clip = "off", expand = FALSE, xlim = c(-1, 1), ylim = c(-1, 1)
  ) +
  labs(subtitle = mi_subtitulo, caption = mi_caption) +
  theme_void() +
  theme(
    aspect.ratio = 1,
    text = element_text(family = "ubuntu", color = c3),
    plot.margin = margin(l = 30, r = 30),
    plot.background = element_rect(fill = c2, color = NA),
    plot.subtitle = element_markdown(
      size = 20, hjust = .5, margin = margin(b = 20, t = 10)
    ),
    plot.caption = element_markdown(
      margin = margin(b = 5, t = 30), lineheight = 1.3
    ),
    panel.spacing.x = unit(5, "cm"),
    panel.background = element_blank(),
    strip.text = element_blank()
  )
```

Guardo.

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

Creado con y

Víctor Gauto

  • Editar esta página
  • Informar de un problema