Hola qué tal todo? Hoy vamos aprender cómo se hace este plot que lleva la leyenda en el título
Este post forma parte de la serie exclusiva para suscriptores de pago de The Clean Shot. Hoy lo abro para todo el mundo.
Ya van 10 entregas enseñando, paso a paso, cómo hago las gráficas que ves en este boletín. Desde limpiar datos en R hasta generar visualizaciones propias con estilo, claridad y sentido.
Si alguna vez te has preguntado cómo se hacen estas gráficas o has estado dudando si merece la pena pagar, este post es para ti, por experiencia ningún curso oficial enseña esto ojalá lo hubiera pillado yo cuando empecé.
Aquí tienes el contenido tal cual lo reciben los suscriptores de pago cada semana.
Al final del post te dejo un resumen de todo lo que ya he publicado en esta serie premium, por si quieres desbloquearlo todo de golpe.. Dicho esto, comenzamos.
Como de costumbre cargamos las librerías
library(tidyverse) # datos, gráficos, manipulación
library(rvest) # web, scraping, HTML
library(janitor) # limpieza, columnas, nombres
library(nbastatR) # NBA, datos, estadísticas
library(cropcircles) # imágenes, máscaras, formas
library(ggimage) # imágenes, plots, iconos
library(ggrepel) # etiquetas, no-superposición, texto
library(ggtext) # texto, estilos, Markdown
library(hablar) # tipos, limpieza, transformar
library(extrafont) # fuentes, texto, tipografía
Ya sabes si no tienes alguna
# Instalar una librería (solo la primera vez)
install.packages("nombre_del_paquete")
# Ejemplo: instalar gtExtras
install.packages("gtExtras")
#pero en el caso de la libreria nbastatR
devtools::install_github("abresler/nbastatR")Y ahora cargamos mi tema y caption customizado
#theme
theme_ivo <- function () {
theme_minimal(base_size=9, base_family="Oswald") %+replace%
theme(
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = 'white', color = "white")
)
}
#caption
twitter <- "<span style='color:#000000;font-family: \"Font Awesome 6 Brands\"'></span>"
tweetelcheff <- "<span style='font-weight:bold;'>*@elcheff*</span>"
insta <- "<span style='color:#E1306C;font-family: \"Font Awesome 6 Brands\"'></span>"
instaelcheff <- "<span style='font-weight:bold;'>*@sport_iv0*</span>"
github <- "<span style='color:#000000;font-family: \"Font Awesome 6 Brands\"'></span>"
githubelcheff <- "<span style='font-weight:bold;'>*IvoVillanueva*</span>"
substack <- "<img src='https://substackcdn.com/image/fetch/$s_!xBQa!,w_10,c_limit,f_auto,q_auto:good,fl_progressive:steep/https%3A%2F%2Fsubstack.com%2Fimg%2Fsubstack.png' />"
caption <- glue::glue("<br>**Datos**: *@RealGM* | **Gráfico**: *Ivo Villanueva* • {twitter} {tweetelcheff} • {insta} {instaelcheff} • {github} {githubelcheff}")Como la base de datos de las fotos de los jugadores es muy extensa hay que decirle a vroom que use un búfer de 256 KB en lugar del valor por defecto, lo cual puede acelerar la lectura de archivos grandes.
#131072 * 2: está multiplicando 131072 (128 KB) por 2, lo que da 262144 bytes (256 KB) de búfer.
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)Y ahora? Pues ahora vamos a cargar las fotos de los jugadores, como muchos aún no tienen la foto oficial y otros no estarán en la NBA ya las he buscado yo para poder resaltar los jugadores que nos interesan
#fotos jugadores
headshot <- nbastatR::nba_players() %>%
select(player = namePlayer, urlPlayerHeadshot) %>%
rbind(tibble::tribble(
~player, ~urlPlayerHeadshot,
"Gabe Madsen", "https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4432753.png&w=350&h=254",
"Solomon Young", "https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4066296.png&w=350&h=254",
"David Jones", "https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4713010.png&w=350&h=254",
"Nique Clifford", "https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/4702384.png&w=350&h=254",
"Yudai Baba", "https://www.proballers.com/media/cache/resize_600_png/https---www.proballers.com/ul/player/yudai-baba2-1ef82771-c306-6a90-a8a2-51503ad90c32.png",
"Alex Schumacher", "https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4712280.png&w=350&h=254",
"Cam Carter", "https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4898380.png&w=350&h=254",
"Ron Holland", "https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/4683771.png&w=350&h=254",
"P.J. Hall", "https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/4701225.png&w=350&h=254",
"Terrence Shannon, Jr.", "https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/4432847.png&w=350&h=254",
"Tristan Da Silva", "https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/4702382.png&w=350&h=254",
"Walter Clayton, Jr.", "https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/4896372.png&w=350&h=254",
"Kevin McCullar, Jr.", "https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/4411057.png&w=350&h=254",
"Curtis Jones","https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4898369.png&w=350&h=254",
"Tre Johnson","https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/5238230.png&w=350&h=254",
"Nae'qwan Tomlin","https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/5106268.png&w=350&h=254",
"Mark Armstrong","https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/5105590.png&w=350&h=254",
"Myron Gardner","https://ak-static.cms.nba.com/wp-content/uploads/headshots/gleague/1040x760/1642066.png",
"Selton Miguel", "https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4433187.png&w=350&h=254",
"Martez Brown", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/gleague/1040x760/1642558.png",
"Boogie Ellis","https://ak-static.cms.nba.com/wp-content/uploads/headshots/gleague/1040x760/1642407.png",
"Reyne Smith","https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4896994.png&w=350&h=254",
"Ja'Vier Francis","https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4684301.png&w=350&h=254",
"R.J. Felton", "https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4708215.png&w=350&h=254",
"K.J. Simpson", "https://a.espncdn.com/combiner/i?img=/i/headshots/nba/players/full/4683834.png&w=350&h=254"
)) %>% mutate(player = str_squish(player)) #quitamos posibles espacios
A continueación vamos a ir ala pagina de Real Gm para extraer los datos de eFG% y USG% . Los datos están separados por posición entonces si queremos tener todos los jugadores tenemos que crear una función que extraiga por posición los datos.
position <- c("PG", "SG", "SF", "PF", "C")
summer <- function(position){
data <- paste0("https://basketball.realgm.com/nba/summer/1/NBA-Summer-League/59/stats/NBA/0/Advanced_Stats/All/points/", position, "/desc/1/Summer_League") %>%
read_html() %>%
html_element("table.table") %>%
html_table() %>%
clean_names() %>%
select(player, team, e_fg_percent, usg_percent) %>%
mutate(usg_percent = as.numeric(usg_percent), #a veces no son numeric
pos = position) %>%
drop_na() %>%
filter(!e_fg_percent >1) #algunos datos vienen erroneos
}
summer_df <- map_df(position, summer)Una vez que tenemos los datos,
Primero: vamos a crear un dataframe filtrando que el USG% sea mayor de 15%, asignamos colores a las posiciones y unimos los datos con la tabla headshot (fijate que he creado un dataframe dentro del leftjoint para ahorrar pasos
plot_summer_df <- summer_df%>%
filter(usg_percent >= 15) %>%
left_join(., headshot, join_by(player)) %>%
left_join(
tibble::tribble(~pos, ~color,
"PG", "#d66fca",
"SG", "#e47236",
"SF", "#4e9beb",
"PF", "#9be373",
"C" , "#ffc409"), join_by(pos))Luego calculamos el tercer cuartil, o sea la cuarta parte mejor de todos los jugadores
q3_usg <- quantile(plot_summer_df$usg_percent, 0.75, na.rm = TRUE)Filtramos por el tercer cuartil y seleccionamos los 25 mejores y les agregamos las fotografías envolviendolas en un circulo con cropcircle
# Filtrar jugadores con USG% >= Q3
top_usage_df <- plot_summer_df %>%
filter(usg_percent >= q3_usg)
# Ordenar por eFG% y quedarnos con top 25
top25 <- top_usage_df %>%
arrange(desc(e_fg_percent)) %>%
slice_head(n = 25) %>%
mutate(
foto = crop_circle(str_squish(urlPlayerHeadshot), border_size = 8, border_colour = "black", bg_fill = color)
)Ahora ya hacemos el plot
p <- plot_summer_df %>%
filter(e_fg_percent < 1 & e_fg_percent > 0 & !player %in% c(top25$player)) %>% #quitamos los porcentajes de 100 y de cero
ggplot( aes(x = usg_percent, y = e_fg_percent)) +
# Puntos para jugadores sin foto
geom_point(
aes(fill = color, color = "black"),
size = 2.75,
shape = 21,
alpha = 0.5,
color = "#cccccc"
) +
# Fotos redondas de jugadores destacados
geom_image(data = top25, aes(image = foto), size = .065) +
geom_text_repel(
data = top25,
aes(label = player),
size = 3.2,
max.overlaps = Inf,
box.padding = 0.6,
point.padding = 0.3,
segment.color = "#999999",
segment.size = 0.3,
min.segment.length = 0,
force = 1.5,
bg.color = "white",
bg.r = 0.15
) +
scale_y_continuous(
limits = c(0, .9),
breaks = seq(0, 0.9, by = 0.1),
labels = scales::label_percent(accuracy = 1)
)+
labs(
x = "Uso ofensivo (USG%)",
y = "Eficiencia efectiva de tiro (eFG%)",
caption = caption
) +
scale_color_identity() +
scale_fill_identity()+
# Evitar recorte de las etiquetas fuera del área
coord_cartesian(clip = "off") +
# Tema visual personalizado
theme_ivo() +
theme(
plot.background = element_rect(fill = "white", color = "white"),
legend.position = "top",
plot.caption = element_markdown(size = 7, color = "gray65", hjust = 0),
plot.title = element_text(face = "bold", hjust = 0.5, size = 25),
plot.subtitle = element_text(face = "italic", hjust = 0.5,, size = 12.5),
plot.margin = margin(b = 25, t = 0, r = 50, l = 50),
axis.text = element_text(size = 8),
axis.title = element_text(size = 12)
)
Bueno como se ve falta una cosa importante, el título y el subtítulo pero me encapriché de poner la leyenda entre el título y el subtítulo, pero eso las etiquetas html necesarias markdown no nos lo permite. Le estuve dando muchas vueltas (un día) y la solución fué hacer otro plot y unir las dos gráficas con cowplot
Luego el plot simulando un título y subtítulo es como sigue:
Primero creamos un datraframe con las coordenadas de los puntos
pos_data <- data.frame(
pos = c("PG", "SG", "SF", "PF", "C"),
x = seq(2.85, 4.25, length.out = 5), # centrado visual
y = rep(0.5, 5),
color = c("#d66fca", "#e47236", "#4e9beb", "#9be373", "#ffc409")
)Que daría un dataframe asi que vamos a usar para el geom_point()
Primero creamos con un annotate el Titulo centrado
header_plot <- ggplot() +
annotate(
"text", x = 3.5, y = 1.6,
label = "USG% vs eFG% en Summer League",
size = 8.5, family = "Oswald", fontface = "bold", hjust = 0.5
) 
Luego le añadimos los puntos donde figuran las posiciones con sus colores
header_plot <- ggplot() +
annotate(
"text", x = 3.5, y = 1.6,
label = "USG% vs eFG% en Summer League",
size = 8.5, family = "Oswald", fontface = "bold", hjust = 0.5
) +
geom_point(
data = pos_data,
aes(x = x, y = 0.8),
shape = 21,
size = 10.5,
fill = pos_data$color,
color = "black",
stroke = .6
) +
geom_text(
data = pos_data,
aes(x = x, y = 0.8, label = pos),
family = "Oswald", color = "black", fontface = "bold", size = 5
)
Y a continuación le añadimos el subtítulo con las esteticas y los ajustes de todos los elementos
header_plot <- ggplot() +
annotate(
"text", x = 3.5, y = 1.6,
label = "USG% vs eFG% en Summer League",
size = 8.5, family = "Oswald", fontface = "bold", hjust = 0.5
) +
geom_point(
data = pos_data,
aes(x = x, y = 0.8),
shape = 21,
size = 10.5,
fill = pos_data$color,
color = "black",
stroke = .6
) +
geom_text(
data = pos_data,
aes(x = x, y = 0.8, label = pos),
family = "Oswald", color = "black", fontface = "bold", size = 5
) +
# Subtítulo como anotación centrada debajo de los puntos
annotate(
"text", x = 3.5, y = 0.25,
label = "Solo se etiquetan los 25 mejores (Q3 en uso ofensivo)",
size = 4.2,
family = "Oswald",
fontface = "italic",
hjust = 0.5,
color = "gray40"
) +
theme_void() +
theme(plot.background = element_rect(fill = "white", color = "white")) +
coord_cartesian(clip = "off") +
xlim(0, 7) + ylim(0, 2.2)
Ahora, con la función plot_grid() de la librería cowplot unimos los dos plots quitamos con NULL el título y el subtítulo esta parte es mas porque si no, ggplot nos lo pone a izda y derecha; ajustamos los parametros para que nos quede cuco
final_plot <- cowplot::plot_grid(
header_plot,
p + labs(title = NULL, subtitle = NULL), # quitamos título y subtítulo
ncol = 1,
rel_heights = c(0.21, 1.1) # menos espacio entre título y gráfico
)Y aquí está el resultado final
🔓 ¿Te ha gustado este post? Esto es solo una muestra.
Cada semana publico una entrega como esta, solo para suscriptores de pago. Ya van 9.
Aquí tienes lo que te estás perdiendo:
Cómo se hace tabla Ratio de Rebote Ofensivo
En este post la parte mas interesante es ver como se consigue el on-off de un jugador, porque la tabla que uso es una de las tres o cuatro que ya tengo como standard; y para eso tenemos que tener previamente un dataframe con los jugadores en pista en cada momento. Aprovecharemos el dataframe que subí a google
Cómo se hace: mapa densidad de tiro
Esta semana voy a explicar cómo se hace esta gráfica de densidades, la que yo llamo "de los anticiclones", usando los puntos X e Y del play-by-play. Para que podáis practicar y explorar diferentes densidades según el equipo o la situación que os interese, he cargado en el
Cómo se hace: Mapa de España
Hoy voy a explicar, como hice el mapa de España con las banderas de provincia y el número de jugadores que nacieron en ellas y que han jugado en la ACB la temporada 2024/2025.
… y 5 más.