Investigate rush and pass TD% at goal line

goal_line.md

Investigate rush and pass TD% at goal line

Need to change locations of files and output below.

library(tidyverse)
library(ggimage)
library(ggrepel)
library(ggplot2)
library(ggbeeswarm)
library(vipor)
library(ggsci)
library(teamcolors)

nfl_colors <- teamcolors %>%
  filter(league == "nfl") %>%
  mutate(
    team_abb = case_when(
      name == "Arizona Cardinals" ~ "ARI",
      name == "Atlanta Falcons" ~ "ATL",
      name == "Baltimore Ravens" ~ "BAL",
      name == "Buffalo Bills" ~ "BUF",
      name == "Carolina Panthers" ~ "CAR",
      name == "Chicago Bears" ~ "CHI",
      name == "Cincinnati Bengals" ~ "CIN",
      name == "Cleveland Browns" ~ "CLE",
      name == "Dallas Cowboys" ~ "DAL",
      name == "Denver Broncos" ~ "DEN",
      name == "Detroit Lions" ~ "DET",
      name == "Green Bay Packers" ~ "GB",
      name == "Houston Texans" ~ "HOU",
      name == "Indianapolis Colts" ~ "IND",
      name == "Jacksonville Jaguars" ~ "JAX",
      name == "Kansas City Chiefs" ~ "KC",
      name == "Los Angeles Rams" ~ "LA",
      name == "Los Angeles Chargers" ~ "LAC",
      name == "Miami Dolphins" ~ "MIA",
      name == "Minnesota Vikings" ~ "MIN",
      name == "New England Patriots" ~ "NE",
      name == "New Orleans Saints" ~ "NO",
      name == "New York Giants" ~ "NYG",
      name == "New York Jets" ~ "NYJ",
      name == "Oakland Raiders" ~ "OAK",
      name == "Philadelphia Eagles" ~ "PHI",
      name == "Pittsburgh Steelers" ~ "PIT",
      name == "Seattle Seahawks" ~ "SEA",
      name == "San Francisco 49ers" ~ "SF",
      name == "Tampa Bay Buccaneers" ~ "TB",
      name == "Tennessee Titans" ~ "TEN",
      name == "Washington Redskins" ~ "WAS",
      TRUE ~ NA_character_
    ),
    posteam = team_abb
  ) %>% select(posteam,primary,secondary)

nfl_logos_df <- read_csv("https://raw.githubusercontent.com/statsbylopez/BlogPosts/master/nfl_teamlogos.csv")

data_old <- readRDS("PATH/pbp_rp.rds") %>%
  select(name,pass,posteam,game_id,defteam,play_id,season,epa,game_date, complete_pass, incomplete_pass, 
         pass_location, air_yards, desc, yardline_100, pass_touchdown, rush_touchdown, down) 

data_new <- readRDS("PATH/pbp_rp_2019.rds") %>%
  select(name,pass,posteam,game_id,defteam,play_id,season,epa,game_date, complete_pass, incomplete_pass, 
         pass_location, air_yards, desc, yardline_100, pass_touchdown, rush_touchdown, down)

#the downs filter is to exclude 2-pt conversions
data <- rbind(data_old,data_new) %>%  mutate(td=pmax(pass_touchdown, rush_touchdown)) %>%
  filter(down==1 | down == 2 | down == 3 | down == 4)

#remove the non-rodgers plays from GB dropbacks and do other stuff
#1 yard line
data_1 <- data %>%filter(yardline_100<=1 & !(pass==1 & posteam=="GB" & name!="A.Rodgers")) %>%
  select(season,name,posteam,pass,desc,td) %>%
  mutate(rush=case_when(pass == 0 ~ "Rush", pass==1 ~ "Dropback")) %>%
  group_by(posteam,rush) %>%
  summarize(td=100*mean(td), n=n()) %>%
  left_join(nfl_logos_df, by = c("posteam" = "team_code")) %>%
  left_join(nfl_colors,by="posteam") 
  
data_1 %>% 
  ggplot(aes(rush, td)) + geom_quasirandom(size=3, width=.2, color=data_1$primary) +
  geom_image(aes(image = url), size = ifelse(data_1$posteam=="GB",0.08,0))+
  labs(x = "Play type",
       y = "Touchdown %",
       caption = "Data from nflscrapR",
       title = "Packers touchdown rate from 1 yard line, 2009-19")+
  theme_bw() +
  theme(axis.title = element_text(size = 12),
        axis.text = element_text(size = 10),
        plot.title = element_text(size = 16, hjust=.5),
        plot.subtitle = element_text(size = 14),
        plot.caption = element_text(size = 12))

ggsave('PATH/td.png', dpi=800)

#remove the non-rodgers plays from GB dropbacks
#5 and inside
data_2 <- data %>%filter(yardline_100<=5 & !(pass==1 & posteam=="GB" & name!="A.Rodgers")) %>%
  select(season,name,posteam,pass,desc,td) %>%
  mutate(rush=case_when(pass == 0 ~ "Rush", pass==1 ~ "Dropback")) %>%
  group_by(posteam,rush) %>%
  summarize(td=100*mean(td), n=n()) %>%
  left_join(nfl_logos_df, by = c("posteam" = "team_code")) %>%
  left_join(nfl_colors,by="posteam") 

data_2 %>% 
  ggplot(aes(rush, td)) + geom_quasirandom(size=3, width=.2, color=data_2$primary) +
  geom_image(aes(image = url), size = ifelse(data_2$posteam=="GB",0.08,0))+
  labs(x = "Play type",
       y = "Touchdown %",
       caption = "Data from nflscrapR",
       title = "Packers touchdown rate from inside opponent 5 yard line, 2009-19")+
  theme_bw() +
  theme(axis.title = element_text(size = 12),
        axis.text = element_text(size = 10),
        plot.title = element_text(size = 16, hjust=.5),
        plot.subtitle = element_text(size = 14),
        plot.caption = element_text(size = 12))

ggsave('PATH/td2.png', dpi=800)