geom_col
Autor

Víctor Gauto

Fecha de publicación

19 de noviembre de 2025

Países con la mayor cantidad de Grandes Maestros de ajedrez.

Semana 38, 2025

Paquetes

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

Estilos

Colores.

Ocultar código 
c1 <- "black"
c2 <- "white"
c3 <- "#BA5AA2"
c4 <- "#659643"

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:{c3};'><span style='font-family:jet;'>",
  "{{<b>tidytuesdayR</b>}}</span> semana 38, ",
  "<b>International Chess Federation</b>.</span>"
)

autor <- glue("<span style='color:{c3};'>**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:{c3};'>**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, 38)
september <- tuesdata$fide_ratings_september

Procesamiento

Me interesan los países con mayor cantidad de Grandes Maestros.

Obtengo los nombres de los países de acuerdo con la abreviatura de sus federaciones.

Ocultar código 
fed_tbl <- rvest::read_html(
  "https://www.mark-weeks.com/aboutcom/mw15b16.htm"
) |>
  rvest::html_table() |>
  pluck(2) |>
  rename_with(tolower) |>
  select(fed, country)

Selecciono septiembre de 2025 como el mes de interés y creo datos con las traducciones de los países.

Ocultar código 
d <- inner_join(september, fed_tbl, by = join_by(fed)) |>
  filter(title %in% c("GM", "FGM")) |>
  count(country, sort = TRUE) |>
  mutate(country = fct_reorder(country, n)) |>
  slice_max(order_by = country, n = 12)

country_tbl <- tibble(
  country = d$country,
  pais = c(
    "Alemania",
    "EE.UU.",
    "India",
    "Rusia",
    "Ucrania",
    "Francia",
    "Serbia",
    "España",
    "Israel",
    "Polonia",
    "Hungría",
    "China"
  )
)

Combino todos los datos.

Ocultar código 
d2 <- inner_join(country_tbl, d, by = join_by(country)) |>
  mutate(pais = factor(pais, levels = rev(pais)))

Figura

Defino patrones para las barras usando {grid} y diferentes intensidades de colores.

Ocultar código 
f_pattern <- function(C) {
  pattern(
    gTree(
      children = gList(
        rectGrob(
          x = c(.25, .75),
          y = c(.25, .75),
          width = .5,
          height = .5,
          gp = gpar(fill = scales::col_darker(C), col = NA)
        ),
        rectGrob(
          x = c(.25, .75),
          y = c(.75, .25),
          width = .5,
          height = .5,
          gp = gpar(fill = scales::col_lighter(C), col = NA)
        )
      )
    ),
    width = .05,
    height = .05,
    extend = "repeat"
  )
}

p <- map(
  scico::scico(n = 12, palette = "bam"),
  f_pattern
)

Título y figura.

Ocultar código 
mi_titulo <- glue(
  "Países con mayor cantidad de <b style='color: {c3};'>Grandes Maestros</b> ",
  " del<br><b style='color: {c4};'>ajedrez</b>, masculinos y femeninos, a ",
  "septiembre de 2025"
)

g <- ggplot(d2, aes(n, pais, fill = pais)) +
  geom_col(show.legend = FALSE, width = .8, fill = p) +
  scale_x_continuous(breaks = scales::breaks_width(10)) +
  coord_cartesian(expand = FALSE) +
  labs(x = NULL, y = NULL, title = mi_titulo, caption = mi_caption) +
  theme_bw(base_size = 24, base_family = "ubuntu") +
  theme(
    text = element_text(color = c2),
    aspect.ratio = 1,
    axis.ticks.y = element_blank(),
    axis.ticks.x = element_line(color = c2, linewidth = .2),
    panel.border = element_blank(),
    panel.background = element_blank(),
    panel.grid = element_blank(),
    panel.grid.major.x = element_line(
      color = c2,
      linewidth = .1,
      linetype = "55"
    ),
    panel.ontop = TRUE,
    axis.text = element_text(color = c2),
    axis.text.x = element_text(family = "jet"),
    axis.text.y = element_text(margin = margin(r = 15)),
    plot.background = element_rect(fill = c1, color = NA),
    plot.title = element_markdown(lineheight = 1.2),
    plot.title.position = "plot",
    plot.caption = element_markdown(
      size = rel(.6),
      lineheight = 1.2,
      color = c4
    )
  )

Guardo.

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