{"metadata":{"kernelspec":{"name":"ir","display_name":"R","language":"R"},"language_info":{"name":"R","codemirror_mode":"r","pygments_lexer":"r","mimetype":"text/x-r-source","file_extension":".r","version":"4.0.5"}},"nbformat_minor":4,"nbformat":4,"cells":[{"cell_type":"markdown","source":"# Introduction","metadata":{}},{"cell_type":"code","source":"#Attaching packages we'll be using\n\nlibrary(tidyverse)\n\n#Let's take a look at the touchback rate on punts <= 60 yards from the opponents endzone since 2000.\n#2021 data through Week 13. Data courtesy of nflfastR.\n\nnflfastR_2000_2021_punt_pbp <- read.csv('../input/2000-2020-nflfastr-punt-play-by-play/punt_pbp_2000_2021.csv')\n\npunts <- nflfastR_2000_2021_punt_pbp %>% group_by(season) %>% filter(yardline_100 <= 60, play_type == 'punt') %>% summarise(punts = n())\n\n# I picked the distance of <= 60 yards from the opponents end zone because it seems like a distance that most,\n#if not all, punters should be capable of getting a touchback from.\n\npunts_touchback <- nflfastR_2000_2021_punt_pbp %>% group_by(season) %>% filter(yardline_100 <= 60, touchback == '1', play_type == 'punt') %>% summarise(touchbacks = n())\n\ntotal_punts <- left_join(punts_touchback, punts)\n\ntotal_punts <- total_punts %>% mutate(touchback_rate = touchbacks/punts)\n\ntotal_punts$touchback_rate <- round(total_punts$touchback_rate, 2)\n\ntotal_punts %>% ggplot(aes(x = season, y = touchback_rate*100)) +\n  geom_point() +\n  geom_smooth(method=lm) +\n  labs(x = 'Season', y = 'Touchback Rate (%)',\n       title = 'Touchback Rate on Punts 2000-2021',\n       subtitle = 'On punts <= 60 yards from opponent end zone',\n       caption = 'Graph by @Mike_Lounsberry, data from nflfastR')","metadata":{"_kg_hide-input":true,"execution":{"iopub.status.busy":"2022-01-06T13:46:16.326568Z","iopub.execute_input":"2022-01-06T13:46:16.329098Z","iopub.status.idle":"2022-01-06T13:46:38.443558Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The ability of NFL punters to avoid touchbacks has improved quite a bit over the last 20 years. This got me thinking, if punters have continued to improve at reducing their touchback rate, should teams reconsider telling their returners to plant their heels at the 10 yard line and never field punts inside of it?","metadata":{}},{"cell_type":"markdown","source":"# Touchback Rate","metadata":{}},{"cell_type":"markdown","source":"To start, let's take a look at what percent of punts that initially made contact inside of the 10 yard line actually end up as touchbacks. Here we'll use the x and y coordinates from the tracking data, along with the \"punt_land\" event, to capture only punts that landed inside the 10.","metadata":{}},{"cell_type":"code","source":"#Filtering the plays dataset to just include punt plays.\n\nplays <- read.csv('../input/nfl-big-data-bowl-2022/plays.csv')\n\npunt_plays <- plays %>% filter(specialTeamsPlayType == 'Punt')\n\n#Joining the punt_plays data set and PFFScoutingData data set together.\n\nPFFScoutingData <- read.table('../input/nfl-big-data-bowl-2022/PFFScoutingData.csv',\n                              header = TRUE,\n                              sep = \",\",\n                              colClasses = c(\"numeric\", \"numeric\", \"NULL\",\n                                             \"numeric\", \"NULL\", \"NULL\",\n                                             \"NULL\", \"NULL\", \"NULL\",\n                                             \"NULL\", \"NULL\", \"NULL\",\n                                             \"NULL\", \"NULL\", \"NULL\",\n                                             \"NULL\", \"NULL\", \"NULL\",\n                                             \"NULL\", \"character\"))\n\npff_punt_plays <- left_join(punt_plays, PFFScoutingData)\n\n#Combining all the tracking data into one data set.\n\ntracking2018 <- read.table('../input/nfl-big-data-bowl-2022/tracking2018.csv',\n                           header = TRUE,\n                           sep = \",\",\n                           colClasses = c(\"NULL\", \"numeric\", \"numeric\",\n                                          \"NULL\", \"NULL\", \"NULL\", \"NULL\",\n                                          \"NULL\", \"character\", \"NULL\", \"character\",\n                                          \"NULL\", \"NULL\", \"NULL\", \"NULL\",\n                                          \"numeric\", \"numeric\", \"NULL\"))\n\ntracking2019 <- read.table('../input/nfl-big-data-bowl-2022/tracking2019.csv',\n                           header = TRUE,\n                           sep = \",\",\n                           colClasses = c(\"NULL\", \"numeric\", \"numeric\",\n                                          \"NULL\", \"NULL\", \"NULL\", \"NULL\",\n                                          \"NULL\", \"character\", \"NULL\", \"character\",\n                                          \"NULL\", \"NULL\", \"NULL\", \"NULL\",\n                                          \"numeric\", \"numeric\", \"NULL\"))\n\ntracking2020 <- read.table('../input/nfl-big-data-bowl-2022/tracking2020.csv',\n                           header = TRUE,\n                           sep = \",\",\n                           colClasses = c(\"NULL\", \"numeric\", \"numeric\",\n                                          \"NULL\", \"NULL\", \"NULL\", \"NULL\",\n                                          \"NULL\", \"character\", \"NULL\", \"character\",\n                                          \"NULL\", \"NULL\", \"NULL\", \"NULL\",\n                                          \"numeric\", \"numeric\", \"NULL\"))\n\ncomplete_tracking <- rbind(tracking2018, tracking2019, tracking2020)\n\n#Joining both of our new data sets together.\n\npff_punt_plays_tracking <- left_join(pff_punt_plays, complete_tracking)\n\n#Getting all the punts that landed inside of the 10 yard line.\n\n#Don't need to be more specific on X values because punts don't get assigned a kickContactType if they\n#land in the endzone. Fair catch is filtered out because occasionally a returner was interfered with\n#and this resulted in a kickContactType being assigned.\n\ninside_10_all <- pff_punt_plays_tracking %>% filter(kickContactType == 'BB' | kickContactType == 'BF' |\n                                                    kickContactType == 'KTB' | kickContactType == 'KTC',\n                                                    event == 'punt_land',\n                                                    x < 20 | x > 100,\n                                                    y > 0 | y < 53.3,\n                                                    specialTeamsResult != 'Fair Catch',\n                                                    specialTeamsResult != 'Return',\n                                                    displayName == 'football')\n\n#Getting the punts that landed inside the 10 yard line that didn't result in a touchback.\n\ninside_10_touchback <- pff_punt_plays_tracking %>% filter(kickContactType == 'BB' | kickContactType == 'BF' |\n                                                          kickContactType == 'KTB' | kickContactType == 'KTC',\n                                                          event == 'punt_land',\n                                                          x < 20 | x > 100,\n                                                          y > 0 | y < 53.3,\n                                                          specialTeamsResult == 'Touchback',\n                                                          specialTeamsResult != 'Fair Catch',\n                                                          displayName == 'football')\n\nnrow(inside_10_touchback)/nrow(inside_10_all)","metadata":{"_kg_hide-output":false,"_kg_hide-input":true,"execution":{"iopub.status.busy":"2022-01-06T13:46:38.446708Z","iopub.execute_input":"2022-01-06T13:46:38.597793Z","iopub.status.idle":"2022-01-06T13:49:33.665091Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"47.05% of punts from <= 60 yards that made contact inside the 10 yard line ended up as touchbacks from 2018-2020. Probably a little lower than most people would expect. Let's take a look at how field surface and temperature can affect touchback rates.","metadata":{}},{"cell_type":"markdown","source":"# Field Surface","metadata":{}},{"cell_type":"code","source":"#Bringing in play by play data for just 2018-2020 from nflfastR\n\npbp_2018 <- read.csv('../input/nfl-play-data-2010-2020/play_by_play_2018.csv')\npbp_2019 <- read.csv('../input/nfl-play-data-2010-2020/play_by_play_2019.csv')\npbp_2020 <- read.csv('../input/nfl-play-data-2010-2020/play_by_play_2020.csv')\n\npbp2018_2020 <- rbind(pbp_2018, pbp_2019, pbp_2020)\n\n#Renaming columns to help with joining.\n\npbp2018_2020 <- pbp2018_2020 %>% rename(playId = play_id)\npbp2018_2020 <- pbp2018_2020 %>% rename(gameId = old_game_id)\n\n#Removing game_id from nflfastR to avoid confusion.\n\npbp2018_2020$game_id <- NULL\n\n#Changing the playId and gameId to numeric so we can complete a left join later on.\n\npbp2018_2020$playId <- as.numeric(pbp2018_2020$playId)\npbp2018_2020$gameId <- as.numeric(pbp2018_2020$gameId)\n\n#Bringing in field surfaces from nflfastR\n\npbp_with_surface <- pbp2018_2020 %>% select(gameId, playId, surface, stadium, season, temp, roof)\n\n#Correcting stadium names to be more uniform\n\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"New Era Field\", \"Bills Stadium\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"CenturyField\", \"CenturyLink Field\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"Lumen Field\", \"CenturyLink Field\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"Broncos Stadium at Mile High\", \"Empower Field at Mile High\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"NRG Stadium\", \"NRG\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"NRG\", \"NRG Stadium\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"MetLife Stadium\", \"MetLife\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"MetLife\", \"MetLife Stadium\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"Los Angeles Memorial Coliesum\", \"Los Angeles Memorial Coliseum\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"Lambeau field\", \"Lambeau Field\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"FedexField\", \"FedExField\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"FirstEnergyStadium\", \"FirstEnergy Stadium\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"First Energy Stadium\", \"FirstEnergy Stadium\")\npbp_with_surface$stadium <- str_replace(pbp_with_surface$stadium, \"Dignity Health Sports Park\", \"StubHub Center\")\n\n#Correcting multiple spellings of the same type of field surface\n\npbp_with_surface$surface <- str_replace(pbp_with_surface$surface, \"fieldturf \", \"fieldturf\")\npbp_with_surface$surface <- str_replace(pbp_with_surface$surface, \"matrixturf\", \"matrix\")\n\n#Correcting field surfaces\n\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'Bills Stadium'] <- 'a_turf')\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'New Era Field'] <- 'a_turf')\n\npbp_with_surface <- within(pbp_with_surface, surface[surface == 'fieldturf' & stadium == 'MetLife Stadium' & season == '2018'] <- 'UBU')\npbp_with_surface <- within(pbp_with_surface, surface[surface == 'fieldturf' & stadium == 'MetLife Stadium' & season == '2019'] <- 'UBU')\n\npbp_with_surface <- within(pbp_with_surface, surface[surface == 'astroturf' & stadium == 'Arrowhead Stadium'] <- 'grass')\n\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'AT&T Stadium'] <- 'matrix')\n\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'Mercedes-Benz Superdome' & season == '2018'] <- 'UBU')\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'Mercedes-Benz Superdome' & season == '2019'] <- 'turf_nation')\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'Mercedes-Benz Superdome' & season == '2020'] <- 'turf_nation')\n\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'Lucas Oil Stadium'] <- 'shaw')\n\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'NRG Stadium'] <- 'matrix')\n\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'Paul Brown Stadium'] <- 'shaw')\n\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'U.S. Bank Stadium'] <- 'UBU')\n\npbp_with_surface <- within(pbp_with_surface, surface[stadium == 'Gillette Stadium'] <- 'fieldturf')\n\n#Adjusting temperature, domes in this data frequently have a temp of NA. Setting dome temperatures to 68.\n#For open, assuming it's a mild day and also went with 68.\n\npbp_with_surface <- within(pbp_with_surface, temp[roof == 'dome'] <- '68')\npbp_with_surface <- within(pbp_with_surface, temp[roof == 'closed'] <- '68')\npbp_with_surface <- within(pbp_with_surface, temp[roof == 'open'] <- '68')\n\n#There are two more punts that still appear as NA, setting these to 68.\n\npbp_with_surface$temp[is.na(pbp_with_surface$temp)]<- '68'\n\n#Joining together with existing data\n\nall_punts_inside_10_with_surface <- left_join(inside_10_all, pbp_with_surface)\npunts_inside_10_with_surface_TB <- left_join(inside_10_touchback, pbp_with_surface)\n\n#Creating tables\n\nall_punts_by_surface <- all_punts_inside_10_with_surface %>%\n  group_by(surface) %>%\n  summarise(total_punts_inside_10 = n())\n\ntouchback_punts_by_surface <- punts_inside_10_with_surface_TB %>% \n  group_by(surface) %>%\n  summarise(touchback_punts = n())\n\nTouchback_By_Surface <- left_join(all_punts_by_surface, touchback_punts_by_surface)\n\nTouchback_By_Surface <- Touchback_By_Surface %>%\n  mutate(touchback_percentage = round(touchback_punts/total_punts_inside_10, 2))\n\nTouchback_By_Surface %>% ggplot(aes(x = surface, y = touchback_percentage*100)) +\n    geom_col(fill = \"#85C285\", color = \"black\") +\n    geom_text(aes(label = paste0(total_punts_inside_10, \" punts\"), vjust = -0.5)) +\n    labs(title = \"Touchback Rate On Punts By Field Surface\",\n         subtitle = \"When punts land inside of the 10 yard line, 2018-2020\",\n         x = \"Field Surface\",\n         y = \"Touchback Percentage (%)\") +\n    scale_y_continuous(breaks = seq(0,80,10)) +\n    geom_hline(yintercept = sum(Touchback_By_Surface$touchback_punts)/sum(Touchback_By_Surface$total_punts_inside_10)*100,\n               linetype = 'dashed')\n","metadata":{"_kg_hide-input":true,"execution":{"iopub.status.busy":"2022-01-06T13:49:33.668778Z","iopub.execute_input":"2022-01-06T13:49:33.670232Z","iopub.status.idle":"2022-01-06T13:49:59.476189Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Let's take a closer look at Shaw. Shaw is in use in only two cities; Indianapolis and Cincinnati. The touchback rate in Indianapolis is 14.29% (2/14) and 58.82% (10/17) in Cincinnati. In Indianapolis, 10 of the 14 punts inside of the 10 came courtesy of Rigoberto Sanchez, the Colts punter. In Cincinnati, 10 of the 17 were by Kevin Huber, the Bengals punter. It's important to keep in mind that the touchback rate for field surfaces with small sample sizes can be greatly influenced by just one or two punters.","metadata":{"_kg_hide-input":false}},{"cell_type":"markdown","source":"# Temperature\n\nAnother factor that should be considered is the temperature at the time of kickoff (Weather data courtesy of nflfastR). Most temperatures seem to hover around the league average touchback rate, but below 39 degrees and into freezing temperatures we see a significant increase in the touchback percentage. This is most likely due to the ground freezing and getting harder. The harder the ground, the less give it will have, causing larger than expected bounces.","metadata":{}},{"cell_type":"code","source":"#Creating temperature df\n\n#90-97\n\npunts_97_90 <- all_punts_inside_10_with_surface %>%\n  filter(between(temp, 90, 97))\n\ntouchback_punts_97_90 <- punts_inside_10_with_surface_TB %>%\n  filter(between(temp, 90, 97))\n\ntouchback_percentage_97_90 <- nrow(touchback_punts_97_90)/nrow(punts_97_90)*100\n\ntouchback_percentage_97_90 <- round(touchback_percentage_97_90, 2)\n\n#89-80\n\npunts_89_80 <- all_punts_inside_10_with_surface %>%\n  filter(between(temp, 80, 89))\n\ntouchback_punts_89_80 <- punts_inside_10_with_surface_TB %>%\n  filter(between(temp, 80, 89))\n\ntouchback_percentage_89_80 <- nrow(touchback_punts_89_80)/nrow(punts_89_80)*100\n\ntouchback_percentage_89_80 <- round(touchback_percentage_89_80, 2)\n\n#79-70\n\npunts_79_70 <- all_punts_inside_10_with_surface %>%\n  filter(between(temp, 70, 79))\n\ntouchback_punts_79_70 <- punts_inside_10_with_surface_TB %>%\n  filter(between(temp, 70, 79))\n\ntouchback_percentage_79_70 <- nrow(touchback_punts_79_70)/nrow(punts_79_70)*100\n\ntouchback_percentage_79_70 <- round(touchback_percentage_79_70, 2)\n\n#69-60\n\npunts_69_60 <- all_punts_inside_10_with_surface %>%\n  filter(between(temp, 60, 69))\n\ntouchback_punts_69_60 <- punts_inside_10_with_surface_TB %>%\n  filter(between(temp, 60, 69))\n\ntouchback_percentage_69_60 <- nrow(touchback_punts_69_60)/nrow(punts_69_60)*100\n\ntouchback_percentage_69_60 <- round(touchback_percentage_69_60, 2)\n\n#59-50\n\npunts_59_50 <- all_punts_inside_10_with_surface %>%\n  filter(between(temp, 50, 59))\n\ntouchback_punts_59_50 <- punts_inside_10_with_surface_TB %>%\n  filter(between(temp, 50, 59))\n\ntouchback_percentage_59_50 <- nrow(touchback_punts_59_50)/nrow(punts_59_50)*100\n\ntouchback_percentage_59_50 <- round(touchback_percentage_59_50, 2)\n\n#49-40\n\npunts_49_40 <- all_punts_inside_10_with_surface %>%\n  filter(between(temp, 40, 49))\n\ntouchback_punts_49_40 <- punts_inside_10_with_surface_TB %>%\n  filter(between(temp, 40, 49))\n\ntouchback_percentage_49_40 <- nrow(touchback_punts_49_40)/nrow(punts_49_40)*100\n\ntouchback_percentage_49_40 <- round(touchback_percentage_49_40, 2)\n\n#39 >\n\npunts_under_39 <- all_punts_inside_10_with_surface %>%\n  filter(temp <= 39)\n\ntouchback_punts_under_39 <- punts_inside_10_with_surface_TB %>%\n  filter(temp <= 39)\n\ntouchback_percentage_under_39 <- nrow(touchback_punts_under_39)/nrow(punts_under_39)*100\n\ntouchback_percentage_under_39 <- round(touchback_percentage_under_39, 2)\n\ntemp_df <- data.frame(\n  Temperature = c(\"<= 39\", \"40-49\", \"50-59\", \"60-69\", \"70-79\", \"80-89\", \"90-97\"),   \n  Touchbacks = c(nrow(touchback_punts_under_39), nrow(touchback_punts_49_40), nrow(touchback_punts_59_50), nrow(touchback_punts_69_60), nrow(touchback_punts_79_70), nrow(touchback_punts_89_80), nrow(touchback_punts_97_90)),\n  Total_Punts = c(nrow(punts_under_39), nrow(punts_49_40), nrow(punts_59_50), nrow(punts_69_60), nrow(punts_79_70), nrow(punts_89_80), nrow(punts_97_90)),\n  Touchback_Percentage = c(touchback_percentage_under_39, touchback_percentage_49_40, touchback_percentage_59_50, touchback_percentage_69_60, touchback_percentage_79_70, touchback_percentage_89_80, touchback_percentage_97_90))\n\ntemp_df %>% ggplot(aes(x = Temperature, y = Touchback_Percentage)) +\n    geom_col(fill = \"#4FC3F7\", color = \"black\") +\n    geom_text(aes(label = paste0(Total_Punts, \" punts\"), vjust = -0.25)) +\n    labs(title = \"Touchback Rate On Punts By Temperature\",\n         subtitle = \"When punts land inside of the 10 yard line, 2018-2020\",\n         x = \"Temperature (Fahrenheit)\",\n         y = \"Touchback Percentage (%)\") +\n    scale_y_continuous(breaks = seq(0,80,10)) +\n    geom_hline(yintercept = sum(Touchback_By_Surface$touchback_punts)/sum(Touchback_By_Surface$total_punts_inside_10)*100,\n               linetype = 'dashed')","metadata":{"_kg_hide-input":true,"execution":{"iopub.status.busy":"2022-01-06T13:49:59.478586Z","iopub.execute_input":"2022-01-06T13:49:59.480019Z","iopub.status.idle":"2022-01-06T13:50:02.320534Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"# Punter Scouting Tool and Coverage Team Performance\n\nTo go along with this project I've created a punter scouting tool that teams can use for advanced scouting. I created it using Shiny App, and on it you can filter by attempts, surface, temperature, stadium, and by individual punter. There is also another tab where you can look at each stadium's touchback rate and use temperature and surface filters.\n\nI also should acknowledge that football is a team game, and the coverage team around the punter will have an affect on their touchback rate.\n\nThe final tab on the Shiny App takes a look at the down rates for the coverage teams around each punter, just to provide some additional context.\n\nYou can find the Shiny App here: https://mike-lounsberry.shinyapps.io/Punter_Touchback_Rates/","metadata":{}},{"cell_type":"code","source":"#Code for ShinyApp\n\n#Creating dataset to work off\n\n#players <- read.csv('../input/nfl-big-data-bowl-2022/players.csv')\n\n#inside_10_all_with_pbp <- left_join(inside_10_all, pbp2018_2020)\n\n#inside_10_all_with_pbp$displayName <- NULL\n\n#inside_10_all_with_pbp <- inside_10_all_with_pbp %>% rename(nflId = kickerId)\n\n#data <- left_join(inside_10_all_with_pbp, players)\n\n#data$stadium <- str_replace(data$stadium, \"New Era Field\", \"Bills Stadium\")\n#data$stadium <- str_replace(data$stadium, \"CenturyField\", \"CenturyLink Field\")\n#data$stadium <- str_replace(data$stadium, \"Lumen Field\", \"CenturyLink Field\")\n#data$stadium <- str_replace(data$stadium, \"Broncos Stadium at Mile High\", \"Empower Field at Mile High\")\n#data$stadium <- str_replace(data$stadium, \"NRG Stadium\", \"NRG\")\n#data$stadium <- str_replace(data$stadium, \"NRG\", \"NRG Stadium\")\n#data$stadium <- str_replace(data$stadium, \"MetLife Stadium\", \"MetLife\")\n#data$stadium <- str_replace(data$stadium, \"MetLife\", \"MetLife Stadium\")\n#data$stadium <- str_replace(data$stadium, \"Los Angeles Memorial Coliesum\", \"Los Angeles Memorial Coliseum\")\n#data$stadium <- str_replace(data$stadium, \"Lambeau field\", \"Lambeau Field\")\n#data$stadium <- str_replace(data$stadium, \"FedexField\", \"FedExField\")\n#data$stadium <- str_replace(data$stadium, \"FirstEnergyStadium\", \"FirstEnergy Stadium\")\n#data$stadium <- str_replace(data$stadium, \"First Energy Stadium\", \"FirstEnergy Stadium\")\n#data$stadium <- str_replace(data$stadium, \"Dignity Health Sports Park\", \"StubHub Center\")\n  \n#data$surface <- str_replace(data$surface, \"fieldturf \", \"fieldturf\")\n#data$surface <- str_replace(data$surface, \"matrixturf\", \"matrix\")\n  \n#Correcting Field Surfaces\n  \n#data <- within(data, surface[surface == 'astroturf' & stadium == 'Bills Stadium'] <- 'a_turf')\n#data <- within(data, surface[surface != 'a_turf' & stadium == 'Bills Stadium' | stadium == 'New Era Field'] <- 'a_turf')\n  \n#data <- within(data, surface[surface == 'fieldturf' & stadium == 'MetLife Stadium' & season == '2018'] <- 'UBU')\n#data <- within(data, surface[surface == 'fieldturf' & stadium == 'MetLife Stadium' & season == '2019'] <- 'UBU')\n  \n#data <- within(data, surface[surface == 'astroturf' & stadium == 'Arrowhead Stadium'] <- 'grass')\n  \n#data <- within(data, surface[stadium == 'AT&T Stadium'] <- 'matrix')\n  \n#data <- within(data, surface[stadium == 'Mercedes-Benz Superdome' & season == '2018'] <- 'UBU')\n#data <- within(data, surface[stadium == 'Mercedes-Benz Superdome' & season == '2019'] <- 'turf_nation')\n#data <- within(data, surface[stadium == 'Mercedes-Benz Superdome' & season == '2020'] <- 'turf_nation')\n  \n#data <- within(data, surface[stadium == 'Lucas Oil Stadium'] <- 'shaw')\n  \n#data <- within(data, surface[stadium == 'NRG Stadium'] <- 'matrix')\n  \n#data <- within(data, surface[stadium == 'Paul Brown Stadium'] <- 'shaw')\n  \n#data <- within(data, surface[stadium == 'U.S. Bank Stadium'] <- 'UBU')\n  \n#data <- within(data, surface[stadium == 'Gillette Stadium'] <- 'fieldturf')\n\n#Adjusting temperature, setting dome temperatures to 68. For open,\n#assuming it's a mild climate and also went with 68.\n  \n#data <- within(data, temp[roof == 'dome'] <- '68')\n#data <- within(data, temp[roof == 'closed'] <- '68')\n#data <- within(data, temp[roof == 'open'] <- '68')\n\n#UI\n\n#ui <- fluidPage(\n#  titlePanel(\"Punter Scouting Tool\"),\n#  h3(\"By Mike Lounsberry\"),\n#  \n#  mainPanel(\n#    tabsetPanel(type = \"tabs\",\n#      tabPanel(\"Punters\",\n#        br(),\n#        sidebarPanel(\n#            sliderInput(\"punt_amount\", \"Punts Inside 10 Yard Line\", round = TRUE, min = 1, max = 30, value = 1),\n#            sliderInput(\"temp_slider\", \"Temperature\", round = TRUE, min = 14, max = 97, value = c(14, 97)),\n#              radioButtons(\"surface_type\", \"Surface Type\",\n#                           c(\"A-Turf\" = \"a_turf\",\n#                             \"FieldTurf\" = \"fieldturf\",\n#                             \"Grass\" = \"grass\",\n#                             \"Matrix Turf\" = \"matrix\",\n#                             \"Shaw Turf\" = \"shaw\",\n#                             \"Turf Nation\" = \"turf_nation\",\n#                             \"UBU Turf\" = \"UBU\",\n#                             \"All\" = \"All\"),\n#                           selected = \"All\"),\n#            selectInput(\"punter_name\", \"Punter Name\",\n#                        c(\"All\" = \"All\",\n#                          \"A.J. Cole\" = \"A.J. Cole\",\n#                          \"Andy Lee\" = \"Andy Lee\",\n#                          \"Austin Seibert\" = \"Austin Seibert\",\n#                          \"Braden Mann\" = \"Braden Mann\",\n#                          \"Bradley Pinion\" = \"Bradley Pinion\",\n#                          \"Brett Kern\" = \"Brett Kern\",\n#                          \"Britton Colquitt\" = \"Britton Colquitt\",\n#                          \"Bryan Anger\" = \"Bryan Anger\",\n#                          \"Cameron Johnston\" = \"Cameron Johnston\",\n#                          \"Chris Jones\" = \"Chris Jones\",\n#                          \"Colby Wadman\" = \"Colby Wadman\",\n#                          \"Colton Schmidt\" = \"Colton Schmidt\",\n#                          \"Corey Bojorquez\" = \"Corey Bojorquez\",\n#                          \"Donnie Jones\" = \"Donnie Jones\",\n#                          \"Drew Kaser\" = \"Drew Kaser\",\n#                          \"Dustin Colquitt\" = \"Dustin Colquitt\",\n#                          \"Hunter Niswander\" = \"Hunter Niswander\",\n#                          \"J.K. Scott\" = \"J.K. Scott\",\n#                          \"Jack Fox\" = \"Jack Fox\",\n#                          \"Jake Bailey\" = \"Jake Bailey\",\n#                          \"Jamie Gillan\" = \"Jamie Gillan\",\n#                          \"Johnny Hekker\" = \"Johnny Hekker\",\n#                          \"Johnny Townsend\" = \"Johnny Townsend\",\n#                          \"Jordan Berry\" = \"Jordan Berry\",\n#                          \"Joseph Charlton\" = \"Joseph Charlton\",\n#                          \"Kevin Huber\" = \"Kevin Huber\",\n#                          \"Lachlan Edwards\" = \"Lachlan Edwards\",\n#                          \"Logan Cooke\" = \"Logan Cooke\",\n#                          \"Marquette King\" = \"Marquette King\",\n#                          \"Matt Bosher\" = \"Matt Bosher\",\n#                          \"Matt Haack\" = \"Matt Haack\",\n#                          \"Matt Wile\" = \"Matt Wile\",\n#                          \"Michael Dickson\" = \"Michael Dickson\",\n#                          \"Michael Palardy\" = \"Michael Palardy\",\n#                          \"Mitch Wishnowsky\" = \"Mitch Wishnowsky\",\n#                          \"Pat O'Donnell\" = \"Pat O'Donnell\",\n#                          \"Rigoberto Sanchez\" = \"Rigoberto Sanchez\",\n#                          \"Riley Dixon\" = \"Riley Dixon\",\n#                          \"Ryan Allen\" = \"Ryan Allen\",\n#                          \"Ryan Winslow\" = \"Ryan Winslow\",\n#                          \"Sam Koch\" = \"Sam Koch\",\n#                          \"Sam Martin\" = \"Sam Martin\",\n#                          \"Sterling Hofrichter\" = \"Sterling Hofrichter\",\n#                          \"Thomas Morstead\" = \"Thomas Morstead\",\n#                          \"Tommy Townsend\" = \"Tommy Townsend\",\n#                          \"Tress Way\" = \"Tress Way\",\n#                          \"Trevor Daniel\" = \"Trevor Daniel\",\n#                          \"Ty Long\" = \"Ty Long\")),\n#            selectInput(\"stadium_select\", \"Stadium\",\n#                        c(\"All\" = \"All\",\n#                          \"Allegiant Stadium\" = \"Allegiant Stadium\",\n#                          \"Arrowhead Stadium\" = \"Arrowhead Stadium\",\n#                          \"AT&T Stadium\" = \"AT&T Stadium\",\n#                          \"Bank of America Stadium\" = \"Bank of America Stadium\",\n#                          \"Bills Stadium\" = \"Bills Stadium\",\n#                          \"CenturyLink Field\" = \"CenturyLink Field\",\n#                          \"Empower Field at Mile High\" = \"Empower Field at Mile High\",\n#                          \"FedExField\" = \"FedExField\",\n#                          \"FirstEnergy Stadium\" = \"FirstEnergy Stadium\",\n#                          \"Ford Field\" = \"Ford Field\",\n#                          \"Gillette Stadium\" = \"Gillette Stadium\",\n#                          \"Hard Rock Stadium\" = \"Hard Rock Stadium\",\n#                          \"Heinz Field\" = \"Heinz Field\",\n#                          \"Lambeau Field\" = \"Lambeau Field\",\n#                          \"Levi's Stadium\" = \"Levi's Stadium\",\n#                          \"Lincoln Financial Field\" = \"Lincoln Financial Field\",\n#                          \"Los Angeles Memorial Coliseum\" = \"Los Angeles Memorial Coliseum\",\n#                          \"Lucas Oil Stadium\" = \"Lucas Oil Stadium\",\n#                          \"M&T Bank Stadium\" = \"M&T Bank Stadium\",\n#                          \"Mercedes-Benz Stadium\" = \"Mercedes-Benz Stadium\",\n#                          \"Mercedes-Benz Superdome\" = \"Mercedes-Benz Superdome\",\n#                          \"MetLife Stadium\" = \"MetLife Stadium\",\n#                          \"Nissan Stadium\" = \"Nissan Stadium\",\n#                          \"NRG Stadium\" = \"NRG Stadium\",\n#                          \"Oakland-Alameda County Coliseum\" = \"Oakland-Alameda County Coliseum\",\n#                          \"Paul Brown Stadium\" = \"Paul Brown Stadium\",\n#                          \"Raymond James Stadium\" = \"Raymond James Stadium\",\n#                          \"SoFi Stadium\" = \"SoFi Stadium\",\n#                          \"Soldier Field\" = \"Soldier Field\",\n#                          \"State Farm Stadium\" = \"State Farm Stadium\",\n#                          \"StubHub Center\" = \"StubHub Center\",\n#                          \"TIAA Bank Field\" = \"TIAA Bank Field\",\n#                          \"Tottenham Hotspur Stadium\" = \"Tottenham Hotspur Stadium\",\n#                          \"U.S. Bank Stadium\" = \"U.S. Bank Stadium\",\n#                          \"Wembley Stadium\"))),\n#      tableOutput(\"performance\")),\n#    \n#      tabPanel(\"Stadium\",\n#        br(),\n#        sidebarPanel(\n#          sliderInput(\"temp_slider_stadium\", \"Temperature\", round = TRUE, min = 14, max = 97, value = c(14, 97)),\n#          radioButtons(\"stadium_surface\", \"Surface Type:\",\n#                       c(\"A-Turf\" = \"a_turf\",\n#                         \"FieldTurf\" = \"fieldturf\",\n#                         \"Grass\" = \"grass\",\n#                         \"Matrix Turf\" = \"matrix\",\n#                         \"Shaw Turf\" = \"shaw\",\n#                         \"Turf Nation\" = \"turf_nation\",\n#                         \"UBU Turf\" = \"UBU\",\n#                         \"All\" = \"All\"),\n#                       selected = \"All\"),\n#          ),#\n\n#        tableOutput(\"stadiums\")),\n#      \n#      tabPanel(\"Coverage Team\",\n#               br(),\n#               sidebarPanel(\n#                 sliderInput(\"punt_amount_cov\", \"Punts Inside 10 Yard Line\", round = TRUE, min = 1, max = 30, value = 1)),\n#               tableOutput(\"coverage\")),\n#)\n#)\n#)\n\n\n#Server\n\n#library(gert)\n#library(dplyr)\n#library(tidyverse)\n#library(gt)\n\n#server <- function(input, output) {\n\n      #output$performance <- render_gt({\n\n     #     if (input$surface_type == 'All') {\n     #     data <- data\n     #   } else {\n     #     data <- data %>% filter(surface == input$surface_type)\n     #   }\n\n     #   if (input$punter_name == 'All') {\n     #     data <- data\n     #   } else{\n     #     data <- data %>% filter(displayName == input$punter_name)\n     #   }\n\n     #   if (input$stadium_select == 'All') {\n     #     data <- data\n     #   } else{\n     #     data <- data %>% filter(stadium == input$stadium_select)\n     #   }\n\n        #data <- data %>% filter(between(temp, input$temp_slider[1], input$temp_slider[2]))\n\n      #  all <- data %>% group_by(displayName) %>% summarise(all_punts_inside_10 = n())\n      #  touchbacks <- data %>% filter(touchback == '1') %>% group_by(displayName) %>% summarise(punts_inside_10_touchback = n())\n\n      #  punts_inside_10 <- left_join(all, touchbacks)\n\n      #  punts_inside_10[is.na(punts_inside_10)] <- 0\n\n      #  punts_inside_10 <- punts_inside_10 %>% mutate(touchback_percentage = (punts_inside_10_touchback/all_punts_inside_10)*100)\n\n      #  punts_inside_10$touchback_percentage <- round(punts_inside_10$touchback_percentage, 2)\n\n      #  punts_inside_10 <- punts_inside_10 %>% arrange(touchback_percentage)\n\n      #  punts_inside_10 <- punts_inside_10 %>% filter(all_punts_inside_10 >= input$punt_amount)\n\n      #  punts_inside_10 %>%\n      #    ungroup() %>%\n      #    gt() %>%\n      #    tab_header(\n      #      title = \"Touchback Rates By Punter, 2018-2020\",\n      #      subtitle = \"On Punts That Land Inside Of The 10 Yard Line\") %>%\n      #    cols_move(\n      #      columns = all_punts_inside_10,\n      #      after = punts_inside_10_touchback) %>%\n      #    cols_label(\n      #      displayName = \"Punter\",\n      #      all_punts_inside_10 = \"Punts Inside 10\",\n      #      punts_inside_10_touchback = \"Touchbacks\",\n      #      touchback_percentage = \"Touchback Percentage\") %>%\n      #    cols_align(\"center\") %>%\n      #    data_color(columns = c(touchback_percentage),\n      #               colors = scales::col_numeric(\n      #                 palette = c(\"#085D29\", \"#FD8C24\", \"#D70915\"),\n      #                 domain = NULL))\n      #})\n\n      #output$stadiums <- render_gt({\n\n        #if (input$stadium_surface == 'All') {\n        #  data <- data\n        #} else {\n        #  data <- data %>% filter(surface == input$stadium_surface)\n        #}\n\n        #all_punts_stadium <- data %>% group_by(stadium, surface) %>% summarise(all_punts_inside_10 = n())\n\n        #touchback_punts_stadium <- data %>% filter(touchback == '1') %>%\n        #  group_by(stadium, surface) %>%\n        #  summarise(touchback_punts_inside_10 = n())\n\n        #combined_stadium <- left_join(touchback_punts_stadium, all_punts_stadium)\n\n        #combined_stadium[is.na(combined_stadium)] <- 0\n\n        #combined_stadium <- combined_stadium %>% mutate(touchback_percentage = touchback_punts_inside_10/all_punts_inside_10*100)\n\n        #combined_stadium$touchback_percentage <- round(combined_stadium$touchback_percentage, 2)\n\n        #combined_stadium <- combined_stadium %>% arrange(touchback_percentage)\n\n        #combined_stadium %>%\n        #  ungroup() %>%\n        #  gt() %>%\n        #  tab_header(\n        #    title = \"Touchback Rates By Stadium, 2018-2020\",\n        #    subtitle = \"On Punts That Land Inside Of The 10 Yard Line\") %>%\n        #  cols_move(\n        #    columns = all_punts_inside_10,\n        #    after = touchback_punts_inside_10) %>%\n        #  cols_label(\n        #    stadium = \"Stadium\",\n        #    all_punts_inside_10 = \"Punts Inside 10\",\n        #    touchback_punts_inside_10 = \"Touchbacks\",\n        #    touchback_percentage = \"Touchback Percentage\") %>%\n        #  cols_align(\"center\") %>%\n        #  data_color(columns = c(touchback_percentage),\n        #             colors = scales::col_numeric(\n        #               palette = c(\"#085D29\", \"#FD8C24\", \"#D70915\"),\n        #               domain = NULL))\n\n      #})\n\n      #output$coverage <- render_gt({\n\n      #data_all <- data %>% group_by(displayName) %>% summarise(total_punts = n())\n\n      #data_downed <- data %>% filter(specialTeamsResult == 'Downed') %>%\n      #  group_by(displayName) %>%\n      #  summarise(downed_punts = n())\n\n      #data_combined <- left_join(data_downed, data_all)\n\n      #data_combined <- data_combined %>% mutate(down_rate = downed_punts/total_punts*100)\n      #data_combined$down_rate <- round(test$down_rate, 2)\n\n      #data_combined <- data_combined %>% mutate(down_rate_above_average = down_rate - (sum(data_combined$downed_punts)/sum(data_combined$total_punts)*100))\n      #data_combined$down_rate_above_average <- round(data_combined$down_rate_above_average, 2)\n\n      #data_combined <- data_combined %>% filter(total_punts >= input$punt_amount_cov)\n\n      #data_combined %>% ungroup() %>%\n      #    arrange(desc(down_rate)) %>%\n      #    gt() %>%\n      #    tab_header(\n      #      title = \"Downed Punt Rate On Punts Inside 10\",\n      #      subtitle = \"Average punt down rate is 46.44%\") %>%\n      #    cols_label(\n      #      displayName = \"Punter\",\n      #      downed_punts = \"Downed Punts\",\n      #      down_rate = \"Down Rate\",\n      #      total_punts = \"Total Punts Inside 10\",\n      #      down_rate_above_average = \"Down Rate Above Average\") %>%\n      #    cols_align(\"center\") %>%\n      #    data_color(columns = c(down_rate_above_average),\n      #               colors = scales::col_numeric(\n      #                 palette = c(\"#D70915\", \"#FD8C24\", \"#085D29\"),\n      #                 domain = NULL))\n  #})\n  \n#}","metadata":{"_kg_hide-input":true,"execution":{"iopub.status.busy":"2022-01-06T13:50:02.323734Z","iopub.execute_input":"2022-01-06T13:50:02.325275Z","iopub.status.idle":"2022-01-06T13:50:02.350212Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"# Limitations\n\nThis is a project that would have benefitted from a larger sample size when it came to the playing surface. Grass is by far the most popular surface in the NFL, and as such has a large sample size, but it would be nice to see how the numbers change with equally large sample sizes for every surface.","metadata":{}},{"cell_type":"markdown","source":"# Conclusion\n\nUsing the Shiny App I built, it's clear to me that allowing a punt to bounce inside of the 10 yard line against some punters (ex. Tress Way/Matt Haack on a grass playing surface) is probably yielding a much lower touchback rate than some teams might expect. The thought that you should never field a punt inside of the 10 yard line expecting that it will be end up as a touchback more times than not appears to be an outdated view point.","metadata":{}},{"cell_type":"markdown","source":"Additional:\n\n* Code On GitHub: [Big Data Bowl 2022 Entry](https://github.com/mlounsberry/Big-Data-Bowl-2022/blob/main/Big%20Data%20Bowl%202022%20Entry.R)\n\n* Find Me On Twitter:  [@Mike_Lounsberry](https://twitter.com/Mike_Lounsberry)\n\n* Email: lounsberrym@gmail.com","metadata":{}}]}