Package iVoNcaaR

Es un package que facilita los logos y los colores tanto de los equipos como de las conferencias de la liga universitaria de baloncesto NCAA para mejorar el aspecto de las gráficas de estadistica.

Se descarga desde:

devtools::install_github("IvoVillanueva/IvoNcaaR")

Ejemplo de uso

Para explicar, como se usan los datos que proporciona la tabla crearemos paso a paso un gráfico de barras como este

Cargamos las librerias

library(tidyverse) #grupo de 8 paquetes
library(rvest) #para poder descargar datos web
library(janitor) #para limpiar encabezados usamos la función clean_names()
library(iVoNcaa) #para cargar los logos y colores
library(lubridate) #para agregar fechas automaticamente
library(ggtext) #personalizar textos en HTML
library(ggimage) #Agrega imagenes

Si no tienes uno de estos paquetes instalalos antes así:

install.packages("tidyverse")

Extraer los datos

Escribimos el siguiente código con la función rvest para descargar los datos. En este caso la extracción no es dificil, en otros casos se complica algo mas.

df <- read_html("https://www.sports-reference.com/cbb/seasons/2021-school-stats.html") %>% 
  html_node("table") %>% 
  html_table %>% clean_names()#nos cambia los signos o los nombres para escribirlos mas fácil
df

Limpiar los datos

Cómo decía, la extracción no es complicada con tres lineas ya la tenemos, pero la tabla que obtenemos nos devuelve doble encabezado y otro mas cada 20 filas. Así que vamos a limpiarlo. Observamos que es la primera fila de la tabla la que nos interesa como encabezado. Esto lo cambiamos fácilmente así:

df <- df %>%
    row_to_names(row_number = 1) %>%
    clean_names()

Esta linea de código lo que hace es convertir esa primera fila en los nombres de la tabla. Este es el resultado:

Pero aun nos queda los encabezados que figura entre los datos

Elegimos por ejemplo la columna g de games e indicamos que la columna no es ni Overall ni G, con estas dos lineas de código

df <- df[df$g!="Overall",]
df <- df[df$g!="G",]

Con lo que la tabla ya estaría lista para usar

Guardar como .csv

Si se puede evitar, hay que raspar la web con la menor frecuencia posible, así que seguiremos adelante y guardaremos los datos en un .csv por si tenemos que comenzar de nuevo.

write.csv(df, "df_table.csv", row.names = FALSE)

df <- read.csv("df_table.csv")

Corregir y seleccionar

Ya con la tabla en csv seguimos limpiando datos, en este caso, no queremos la palabra NCAA al lado de algunos nombres que indica la invitación para el March Madness, ya que eso inpediría la unión con los nombres del package. Para eso usamos la función gsub que basicamente quiere decir, que si está la palabra NCAA en la columna la quite, como haría el reemplazar del excel

df$school <- gsub("NCAA", "", df$school) #Quito la palabra NCAA y lo dejo en blanco

Seleccionamos las columnas que nos interesan y dividimos los puntos totales del equipo local tm y los de su oponente opp. Usamos la función round porque la división nos devuelve 5 decimales. El 1 quiere decir que nos redondee con un decimal y ordenamos de mayor a menor el número de puntos. Hay otra forma para que el código sea mas fluido que es usar la función GSUB dentro de la función MUTATE como a continuación hacemos.

df <- df %>% select(school ,g ,tm, opp) %>% 
             mutate(school = gsub("NCAA","", school), #la misma linea de arriba ya integrada
                    tm = round(tm/g, 1), 
                    opp = round(opp/g, 1)) %>%  
                    arrange(desc(tm))

Indicamos número de equipos

Un último ajuste antes de unir el data frame con la tabla de logos y colores. Como en el March Madness quitando los partidos del first four son 64 equipos, seleccionamos los 64 mejores equipos en puntos por partido.Son muchos pero para el ejemplo me viene muy bien

df <- df[c(1:64),]

Y ya estaría nuestra tabla preparada

Cargamos la libreria iVoNcaaR

Ok, ahora extraemos los logos y los colores en otra tabla. Puede ser logos o la palabra que quieras

logos <- get_ncaa()

Unimos las tablas

Con la función left joint unimos las dos tablas. Nos interesa la columna reference_name que es la que contiene los nombres de la web donde hemos extraido los datos

df <- df %>% left_join(logos, by = c("school" = "reference_name")) #que me una la columna school de la tabla df con la columna reference_name de la tabla logos

Pues bien, así es como deberían verse nuestros datos:

Seleccionamos columnas

Para no saturarnos, vamos a volver a hacer select con las columnas que nos interesan. Nuestro objetivo es hacer un analisis del net rating (diferencia de puntos a favor con los puntos en contra). Para esto vamos agregar al código de arriba dos nuevas columnas que se llamarán net_r y otra llamada rk, que nos dará el ranking y nos ayudará con el orden del eje x

df <- df %>% left_join(logos, by = c("school" = "reference_name")) %>% 
mutate(net_r = tm-opp) %>% 
  select(school, net_r, logos, primary, secondary, url_conference)%>% 
  arrange(desc(net_r)) %>% #coloca la columna en orden descendente
  mutate(rk = row_number()) #rk es igual al numero de la fila

Y aqui está

Haciendo la gráifca

Cómo vimos al principio en la primera fotografía el color primario de los equipos está en el interior y el color secundario está en el borde de cada columna, para así dar coherencia a la visualización.

basic_plot <- df %>%
  ggplot() + 
  geom_col(aes(x = rk, y = net_r, fill= primary, color=secondary), width = 0.5)+
  scale_color_identity(aesthetics = c("color", "fill")) +
  geom_hline(yintercept = 0, color = "#BDBDBD", size = 1) +
  theme_minimal() +
  scale_y_continuous(limit = c(-4, 24), breaks=seq(-4 ,24 ,2)) +
  labs(x=NULL, #Creo que los nombres del eje x dan igual que esten
       y = "Net Rating",
       title = "Net Rating - NCAA Season 2020_21",
       subtitle = glue::glue("Diferencia del ratio ofensivo menos el defensivo hasta el {dia}"),
       caption ="**Datos**: *@bball_ref* | **Gráfico**: *Ivo Villanueva*<br>")+
  theme(
    panel.grid.minor = element_blank(),
    panel.grid.major.x  = element_blank(),
    plot.title = element_text(face = "bold", size = 20, hjust = 0.5),
    plot.subtitle = element_text(size = 15,  hjust = 0.5),
    axis.text.x = element_blank(),
    axis.title.y = element_text(size = 10, face = "bold"),
    axis.text = element_text(size = 12, face = "bold"),
    axis.line.x.bottom = NULL)+
  theme(
        plot.title = element_markdown(),
        plot.subtitle = element_markdown(),
        plot.caption = element_markdown())

basic_plot

Agregar logos con GGIMAGE

Ahora vamos agregar los logos de los equipos, añadiendo otra capa.

basic_plot_img <- basic_plot +
  # Hay que tener en cuenta que también podemos controlar el tamaño de la imagen de acuerdo con su ancho
  geom_image(
    aes(
      x = rk, y = net_r,
      image = logos
    ), 
    # Establecer tamaño y relación de aspecto
    size = 0.02, by = "width", asp = asp_ratio
  ) +
  # Segundo paso
  theme(aspect.ratio = 1/asp_ratio)

# incluir la relación de aspecto en ggsave
ggsave(
  "basic_plot_img.png", basic_plot_img, 
  # hacer que el ancho sea equivalente al aspecto.
  height = 10, width = 10 * asp_ratio, dpi = "retina"
)

Y ahí están

Añadiendo conferencias

Pero vamos a darle una vuelta mas poniendo las conferencias a las que pertenecen debajo. Esto se consigue superponiendo al gráfico anterior un nuevo ggimage.

conference_plot <- basic_plot_img +
   geom_image(
     aes(
         x = rk, y = -4, #Aquí está la diferencia, ponemos el lugar donde queramos que salgan
         image = url_conference),
         size = 0.015, by = "width", asp = asp_ratio ) +
 # Second step
   theme(aspect.ratio = 1/asp_ratio)
# include aspect ratio in ggsave
ggsave(
  "basic_plot_confe.png", conference_plot, 
  # make the width equivalent to the aspect.ratio
  height = 10, width = 10 * asp_ratio, dpi = "retina"
)

A continuación dejo el código completo integrado con las funciones dplyr para simplificar y unirlo lo mas posible

#Cargamos las librerias

library(tidyverse) #grupo de 8 paquetes
library(rvest) #para poder descargar datos web
library(janitor) #para limpiar encabezados usamos la función clean_names()
library(iVoNcaa) #para cargar los logos y colores
library(lubridate) #para agregar fechas automaticamente
library(ggtext) #personalizar textos en HTML
library(ggimage) #Agrega imagenes

#Obtenemos los datos

df <- read_html("https://www.sports-reference.com/cbb/seasons/2021-school-stats.html") %>% 
  html_node("table") %>% 
  html_table %>% 
  row_to_names(row_number = 1) %>%
  clean_names() %>% # Janitor library que transforma los nombres a unos mas accesibles
  filter(g != "Overall" & g != "G" )

# Lo guardamos en csv

write.csv(df, "df_table.csv", row.names = FALSE)
df <- read.csv("df_table.csv")

# Modificamos los datos

df <- df %>% select(school ,g ,tm, opp) %>% # Seleccionamos columnas
             mutate(school = gsub("NCAA","", school), # Quitamos la palabra NCAA 
                    tm = round(tm/g, 1), # Dividimos los puntos anotados por los partidos
                    opp = round(opp/g, 1)) %>% # Dividimos los puntos recibidos  
                    arrange(desc(tm)) %>% # Ordenamos de mayor a menor
                    slice(1:64) # Seleccionamos las filas

logos <- get_ncaa() # Cargamos la tabla de la libreria (iVoNcaaR)

df <- df %>% left_join(logos, by = c("school" = "reference_name")) %>% # Unimos la tabla
             mutate(net_r = tm - opp) %>% # Calculamos el Net Rating
             select(school, net_r, logos, primary, secondary, url_conference) %>% 
             arrange(desc(net_r)) %>%
             mutate(rk = row_number()) # Creamos una columna con el Ranking que ocupan

dia <- today() # Nos devuelve el dia de hoy con la función lubridate
asp_ratio <- 1.618 # Proporción de aspecto de la imagen

# Creamos la gráfica

basic_plot <- df %>%
              ggplot() + 
              geom_col(aes(x=rk, y=net_r,
                           fill= primary,
                           color=secondary),
                           width = 0.5)+ # Capa de gráfica de columnas
              geom_image( aes( x = rk, y = net_r, 
                               image = logos), 
                               size = 0.02, by = "width",
                               asp = asp_ratio)+ # Capa para los logos
  scale_color_identity(aesthetics = c("fill", "color")) +
  geom_hline(yintercept = 0, color = "#BDBDBD", size = 1) +
  theme_minimal() +
  scale_y_continuous(limit = c(-4, 24), breaks=seq(-4, 24,2)) +
  labs(x=NULL,
       y = "Net Rating",
       title = "Net Rating - NCAA Season 2020_21",
       subtitle = glue::glue("Diferencia del ratio ofensivo menos el defensivo hasta el {dia}"),                                                 # Entre los corchetes saldra el dia de hoy
       caption ="**Datos**: *@bball_ref* | **Gráfico**: *Ivo Villanueva*")+
  theme(            # Dos asteriscos para negrita uno para cursiva (ggtext)
    panel.grid.minor = element_blank(),
    panel.grid.major.x  = element_blank(),
    plot.title = element_text(face = "bold", size = 18, hjust = 0.5),
    plot.subtitle = element_text(size = 13,  hjust = 0.5),
    axis.text.x = element_blank(),
    axis.title.y = element_text(size = 10, face = "bold"),
    axis.text = element_text(size = 12, face = "bold"),
    axis.line.x.bottom = NULL)+
  
  theme(
        plot.title = element_markdown(),
        plot.subtitle = element_markdown(),
        plot.caption = element_markdown())

# Incluimos los logos de las conferencias

conference_plot <- basic_plot +
   geom_image(
     aes(
         x = rk, y = -4, #Aquí está la diferencia, ponemos el lugar donde queramos que salgan
         image = url_conference),
         size = 0.015, by = "width", asp = asp_ratio ) +
   theme(aspect.ratio = 1/asp_ratio)
# incluimos el ratio de aspecto al png
ggsave(
  "basic_plot_confe.png", conference_plot, 
  # make the width equivalent to the aspect.ratio
  height = 10, width = 10 * asp_ratio, dpi = "retina"
)