In saiemgilani/kenpomR: Access Men's Basketball Play by Play Data

knitr::opts_chunk$set(echo = TRUE)
old <- options(rmarkdown.html_vignette.check_title = FALSE)
pkg_name <- "sportsdataverse/hoopR"
url <- paste0("https://raw.githubusercontent.com/", pkg_name, "/main/DESCRIPTION")


x <- readLines(url)
remote_version <- gsub("Version:\\s*", "", x[grep('Version:', x)])

We will be acquiring data from kenpom.com, using the hoopR package, created by Saiem Gilani. An active subscription to the website will be required for most of this tutorial.

Using Your KenPom Subscription

You can save your user email and password for consistent usage by adding KP_USER = [e-mail] and KP_PW = XX-YOUR-PASSWORD-XX to your .Renviron file (easily accessed via usethis::edit_r_environ()). Run usethis::edit_r_environ(), a new script will pop open named .Renviron, THEN paste the following in the new script that pops up (without quotations)

KP_USER = [e-mail]
KP_PW = XX-YOUR-PASSWORD-XX

Save the script and restart your RStudio session, by clicking Session (in between Plots and Build) and click Restart R (n.b. there also exists the shortcut Ctrl + Shift + F10 to restart your session). If set correctly, from then on you should be able to use any of the kp_ functions without any other changes.

For less consistent usage, save your user email and password as the environment variables KP_USER and KP_PW (with quotations) at the beginning of every session, using a command like the following.

Sys.setenv(KP_USER = "[e-mail]")
Sys.setenv(KP_PW = "XX-YOUR-PASSWORD-XX")

How the browser login is set

This is the function that is evaluated to log you in to kenpom.com to use the functions. In prior versions, this function needed to be set and passed as a parameter to the functions for usage, but is now applied under the hood within each KenPom (kp_) function.

browser <- login(Sys.getenv("KP_USER"), Sys.getenv("KP_PW"))

Import libraries

# You can install using the pacman package using the following code:
if (!requireNamespace('pacman', quietly = TRUE)){
  install.packages('pacman')
}
pacman::p_load_current_gh("saiemgilani/hoopR")
pacman::p_load(dplyr, ggplot2,animation,ggimage,png, glue)

Let's first just try to get our hands on the Pomeroy ratings for the last 10 years by using the hoopR::kp_pomeroy_ratings() function, which takes the following arguments:

• min_year - First year of data to pull
• max_year - Last year of data to pull

rtgs <- hoopR::kp_pomeroy_ratings(min_year = 2010, max_year = 2021)

glimpse(rtgs)

So in this vignette, we're going to plot something simple first to get a sense of how we would compare different metrics and groups. In this example, we are going to compare Florida State's adjusted efficiency margin (AdjEM) over the past ten years and the ACC conference average.

Pre-processing

First, to keep things a bit simpler, we will first create a second and third rtgs dataset, one for the the filtered ACC data, and the other for Florida State. We will then combine these two to plot our data with. - ACC: filter by conference = 'ACC', group by the year and conference, then use dplyr's dplyr::summarize() function, which we use to compute the `mean() of each of the Year-Conf combinations. However, in this case, since there is only one conference, it is essentially just a Year grouping for the ACC.

team1 = "Florida St."
team2 = "ACC"
metric <- "adj_em" 
full_metric <- "Adjusted Efficiency Margin"
Color1 = '#782F40'
Color2 = 'navyblue'

rtgs$metric = rtgs[, metric]


rtgs_acc <- rtgs %>% 
  dplyr::filter(.data$conf == team2) %>% 
  dplyr::group_by(.data$year,.data$conf) %>% 
  dplyr::summarize(metric = mean(metric)) %>% 
  dplyr::ungroup() %>% 
  dplyr::rename("team" = "conf")

rtgs_fsu <- rtgs %>% 
  filter(team == team1) %>% 
  arrange(-.data$year, .data$rk) %>% 
  select(year, team, metric)

# combine the two datasets using rbind
plot_data <- rbind(rtgs_fsu, rtgs_acc)

plot_data <- rtgs_fsu %>% 
  mutate(metric_1 = metric) %>% 
  left_join(rtgs_acc %>% 
              select(.data$year, .data$metric),
            by=c("year"),suffix=c("","_2"))  
plot_data <- plot_data %>% 
  mutate(
    metric = round(metric,1),
    metric_1 = round(metric_1,1),
    metric_2 = round(metric_2,1)
  ) %>% 
  arrange(.data$year)

plot_data$Color_1 = Color1
plot_data$Color_2 = Color2

logo_url <- "https://raw.githubusercontent.com/sportsdataverse/hoopR/main/man/figures/logo.png"
z <- tempfile()
download.file(logo_url,z,mode="wb")
m <- png::readPNG(z)
img <- matrix(rgb(m[,,1],m[,,2],m[,,3], m[,,4] ), nrow=dim(m)[1]) #0.2 is alpha
rast <- grid::rasterGrob(img, interpolate = T)

plot_data <- plot_data %>% 
  mutate(logo_1 = "https://a.espncdn.com/i/teamlogos/ncaa/500/52.png?transparent=true&w=35&h=35",
         logo_2 = "https://a.espncdn.com/i/teamlogos/ncaa_conf/500/1.png?transparent=true&w=35&h=35") %>% arrange(year)
# points for plotting
x_max <- 2021
x_lab_min <- 2010 - 3
x_lab_max <- x_max + 2
x_score <- 2 + x_max

Plotting a simple animation

draw_frame <- function(year)
{
  yr <- year
  # frame data
  frm_data <- plot_data %>% 
    filter(.data$year <= yr)

  # output quarter changes
  if (nrow(frm_data %>% filter(year == max(.data$year))) == 1)
  {
    print(glue::glue("Plotting AdjEM in Year: {max(frm_data$year)}"))
  }

  # plot
  frm_plot <- frm_data %>% 
    ggplot(aes(x = year, y = metric, group=team))+
    theme_minimal()+
    geom_vline(xintercept = c(2010, x_max), color = "#5555AA")+
    geom_segment(x = 2010, xend = 2021, y = 0, yend = 0, size = 0.75)+
    geom_image(x = x_score-1, y = 24, image = frm_data$logo_1, size = 0.09, asp = 1.5)+
    geom_image(x = x_score-1, y = 2, image = frm_data$logo_2, size = 0.12, asp = 1.5)+
    geom_image(aes(x = year, y = metric_1, image = logo_1),  size = .03, asp = 1.5)+
    geom_image(aes(x = year, y = metric_2, image = logo_2),  size = .06, asp = 1.5)+
    annotation_custom(grob = rast, xmin=2017, xmax=2021, ymin=-2, ymax=-20)+
    geom_line(aes(x = year, y = metric_1, color = Color1), size = 1)+
    geom_line(aes(x = year, y = metric_2, color = Color2), size = 1)+
    scale_color_manual(values = c(Color1, Color2))+
    scale_x_continuous(breaks = seq(2010, 2021, 1),
                       minor_breaks = NULL,
                       limits = c(2009.5, x_max + 2)) +
    scale_y_continuous(breaks = seq(-20, 35, 5),
                       minor_breaks = NULL,
                       limits = c(-21, 36)) +
    coord_cartesian(clip = "off",expand = FALSE) +
    xlab("") +
    ylab("") +
    labs(title = glue::glue("{team1} and {team2} \n{full_metric} Chart - {min(plot_data$year)}-{max(plot_data$year)}"),
         caption = "Data from kenpom.com | Visualization by @SaiemGilani") +
    theme(legend.position = "none",
          axis.title.x = element_text(size = 18, family = "sans", face = 'bold', color = "#3D1A22"),
          axis.text.x = element_text(size = 12, family = "sans", face = 'bold', color = "#3D1A22"),
          axis.title.y = element_text(size = 18, family = "sans", face = 'bold', color = "#3D1A22"),
          axis.text.y = element_text(size = 14, family = "sans", face = 'bold', color = "#3D1A22"),
          plot.title = element_text(size = 16, family = "sans", face = 'bold', color = "#3D1A22"),
          plot.subtitle = element_text(size = 14, family = "sans", face = 'bold', color = "#3D1A22"),
          plot.caption = element_text(size = 14, family = "sans", face = 'bold', color = "#3D1A22",hjust=0.5),
          panel.background = element_rect(fill = "snow"),
          plot.background = element_rect(fill = "#DCF2F5"))

  # score display 
  metric1 <- tail(frm_data$metric_1, n=1)
  metric2 <- tail(frm_data$metric_2, n=1)

  # clock display
  Year <- case_when(
    max(frm_data$year) == 2010 ~ "2010" ,
    max(frm_data$year) == 2011 ~ "2011" ,
    max(frm_data$year) == 2012 ~ "2012" ,
    max(frm_data$year) == 2013 ~ "2013" ,
    max(frm_data$year) == 2014 ~ "2014" ,
    max(frm_data$year) == 2015 ~ "2015" ,
    max(frm_data$year) == 2016 ~ "2016" ,
    max(frm_data$year) == 2017 ~ "2017" ,
    max(frm_data$year) == 2018 ~ "2018" ,
    max(frm_data$year) == 2019 ~ "2019" ,
    max(frm_data$year) == 2021 ~ "2020" ,
    max(frm_data$year) == 2020 ~ "2021" ,
    TRUE ~ as.character(max(frm_data$year))
  )

  # add score and clock to plot
  frm_plot <- frm_plot + 
    annotate("text", x = x_score-1, y = 16, label = metric1, color = Color1, size = 8) +
    annotate("text", x = x_score-1, y = -4, label = metric2, color = Color2, size = 8) +
    annotate("text", x = x_score-1, y = 8, label = Year, color = "#000000", size = 7)

  # label key moments
  # frm_labels <- frm_data %>% 
  #   filter(text != "")
  # frm_plot <- frm_plot +
  #   geom_point(frm_labels, mapping = aes(x = Year, y = AdjEM),
  #              color = "#000000", size = 2, show.legend = FALSE) +
  #   geom_segment(frm_labels, mapping = aes(x = x_text, xend = s, y = y_text, yend = wp),
  #                linetype = "dashed", color = "#000000", na.rm=TRUE) +
  #   geom_label(frm_labels, mapping = aes(x = x_text, y = y_text, label = text),
  #              size = 3, color = "#000000", na.rm = TRUE, alpha = 0.8)

  # plot the frame
  plot(frm_plot, width = 12.5, height = 6.47, dpi = 500)
}

draw_frame(2014)

draw_gif <- function()
{
  lapply(plot_data$year, function(year)
  { 
    draw_frame(year)
  })
  print("Plotting frames for pause")
  replicate(3, draw_frame(max(plot_data$year)))
  print("Assembling plots into a GIF")
}

saveGIF(draw_gif(), interval = 1, movie.name = glue::glue("animated_{metric}.gif"),
        ani.width = 960, ani.height = 540, ani.res = 110)

effs <- hoopR::kp_efficiency(min_year = 2021, max_year = 2021)
glimpse(effs)

ff <-  hoopR::kp_fourfactors(min_year = 2021, max_year = 2021)
glimpse(ff)

hgts <-  hoopR::kp_height(min_year = 2021, max_year = 2021)

glimpse(hgts)

All Games Player stats

plyrstats <- hoopR::kp_team_player_stats(team = 'Florida St.', year = 2021)


glimpse(plyrstats[[1]])

Conference only Player stats

glimpse(plyrstats[[2]])

saiemgilani/kenpomR documentation built on Dec. 10, 2023, 3:34 a.m.