R/plot_pbp_sequencing.R

In meysubb/cfbscrapR: A Scraping and Aggregating Interface to the CollegeFootballData API

#' Plot the Drive/PBP Sequencing
#'
#' @param df Play-by-Play data frame (can be retrieved from \code{\link[cfbscrapR:cfb_pbp_data]{cfbscrapR::cfb_pbp_data()}})
#' @keywords Plot PbP
#' @importFrom dplyr group_by filter ungroup mutate 
#' @import ggplot2
#' @importFrom stringr str_detect
#' @import ggrepel
#' @export
#' @examples
#'
#' df <- cfb_pbp_data(year = 2019, week = 9,team = 'Texas A&M', epa_wpa = TRUE)
#'
#' plot_pbp_sequencing(df)
#'

plot_pbp_sequencing <- function(df) {
  clean_game_df = prep_df_pbp_overview(df) %>% 
    dplyr::filter(!stringr::str_detect(.data$play_type, "End"))
  game_id <- unique(clean_game_df$game_id)
  clean_game_df$new_drive_id = as.numeric(gsub(game_id, "", clean_game_df$drive_id))
  
  clean_drive_info = clean_game_df %>% 
    dplyr::group_by(.data$drive_id) %>%
    dplyr::filter(row_number() == (n())) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(
      y_max = max(.data$play_num) + 5,
      score_text = ifelse(.data$drive_scoring == TRUE, .data$score_text, NA)
    )
  
  nd_id = clean_drive_info$new_drive_id
  off_team = clean_drive_info$offense_play
  
  ggplot() +
    geom_tile(
      data = clean_game_df,
      aes(
        x = .data$new_drive_id,
        y = .data$play_num,
        fill = .data$clean_play_type,
        alpha = .data$yards_gained,
        width = 0.8
      ),
      size = 1.2
    ) +
    geom_text_repel(
      data = clean_game_df,
      aes(
        x = .data$new_drive_id,
        y = .data$play_num,
        label = .data$event
      ),
      point.padding = NA
    ) +
    geom_label_repel(
      data = clean_drive_info,
      aes(
        x = .data$new_drive_id,
        y = .data$y_max,
        label = .data$score_text
      ),
      point.padding = NA
    ) +
    coord_flip() +
    scale_alpha(
      range = c(0.05, 1),
      limits = c(-20, 20),
      breaks = c(-20,-10, 0, 10, 20),
      labels = c("-20+", "-10", "0", "10", "20+"),
      name = "Yards gained"
    ) +
    scale_x_reverse(labels = off_team,
                    breaks = nd_id,
                    expand = expansion(add = 1.2)) +
    labs(
      x = "",
      y = "",
      fill = "Play type",
      alpha = "Yards gained",
      title = "Play-by-Play Overview",
      subtitle = paste0(
        unique(clean_game_df$away),
        "@",
        unique(clean_game_df$home)
      ),
      caption = "@CFB_Data | @cfbscrapR"
    ) +
    theme_classic(base_size = 14)
}

#' prep_df_pbp_overview
#' @param df Play-by-Play data frame (can be retrieved from cfb_pbp_data)
#' @keywords Plot PBP
#' @importFrom dplyr case_when arrange mutate lead group_by ungroup n
#' @importFrom stringr str_detect
#'
prep_df_pbp_overview <- function(df) {
  clean_df = df %>% 
    dplyr::arrange(.data$id_play) %>%
    dplyr::mutate(
      event = dplyr::case_when(
        stringr::str_detect(.data$play_text, "fumble") ~ "Fumble",
        stringr::str_detect(.data$play_text, "interception") ~ "INT",
        stringr::str_detect(.data$play_text, "sack") ~ "Sack",
        TRUE ~ "nothing"
      ),
      event = ifelse(.data$event == "nothing", NA, .data$event),
      clean_play_type = dplyr::case_when(
        stringr::str_detect(.data$play_type, "Pass") ~ "Pass",
        stringr::str_detect(.data$play_type, "Rush") ~ "Rush",
        stringr::str_detect(.data$play_type, "Field Goal") ~ "Kick",
        stringr::str_detect(.data$play_type, "Kickoff") ~ "Kick",
        stringr::str_detect(.data$play_type, "Punt") ~ "Punt",
        stringr::str_detect(.data$play_type, "Penalty") ~ "Penalty",
        TRUE ~ "Other"
      ),
      drive_id = cumsum(.data$offense_play != dplyr::lead(.data$offense_play)),
      score_text = paste0(.data$offense_score, "-", .data$defense_score)) %>% 
    dplyr::group_by(.data$drive_id) %>%  
    dplyr::arrange(.data$id_play) %>%
    dplyr::mutate(play_num = row_number()) %>%
    dplyr::ungroup()
  return(clean_df)
}