{"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":"For our submission, we look both at field goals and punts. We will start with analyzing and ranking NFL kickers based on their field goal kicking efficiency, then dive into NFL punting impact.","metadata":{}},{"cell_type":"code","source":"#loading in packages\nlibrary(readxl)\nlibrary(tidyverse)\nlibrary(ggplot2)\n\n#importing data sets\npffdata <- read.csv(\"../input/nfl-big-data-bowl-2022/PFFScoutingData.csv\")\nplayers <- read.csv(\"../input/nfl-big-data-bowl-2022/players.csv\")\nplays <- read.csv(\"../input/nfl-big-data-bowl-2022/plays.csv\")\ngames <- read.csv(\"../input/nfl-big-data-bowl-2022/games.csv\")\npunts <- read.csv(\"../input/premodel-punts/premodel_punts.csv\")\n\n# tracking2018 <- read.csv(\"tracking2018.csv\")\n# tracking2019 <- read.csv(\"tracking2019.csv\")\n# tracking2020 <- read.csv(\"tracking2020.csv\")\n# pff.plus <- merge(pffdata,plays,on = c(gameId,playId))\n# punts <- pff.plus %>% filter(specialTeamsPlayType == \"Punt\",!is.na(kickType))\n# punts <- left_join(punts,games)\n\n#just the punts\n# punts.tracking2018 <- tracking2018 %>% filter(str_c(gameId,playId) %in% str_c(punts$gameId,punts$playId))\n# punts.tracking2019 <- tracking2019 %>% filter(str_c(gameId,playId) %in% str_c(punts$gameId,punts$playId))\n# punts.tracking2020 <- tracking2020 %>% filter(str_c(gameId,playId) %in% str_c(punts$gameId,punts$playId))","metadata":{"_kg_hide-output":true,"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## Field Goal Kicker Rating\n\nWith the first goal of ranking each NFL kickers based on field goals, first we had to get the kicking percentage of each kicker over the 2018-2020 NFL seasons. Here, it doesn't matter what team each kicker is on (if they played for more than one team in this span); it's just the kicker's own percentage of field goals made. ","metadata":{}},{"cell_type":"code","source":"# changing this to a character variable so it matches the plays dataset\nplayers_fgs <- players %>% \n  summarise(nflId, displayName)\n#players_fgs$nflId <- as.character(players_fgs$nflId)\n\n# fg percent of each kicker (just in general, not based on their team)\nplays_fgs <- plays %>% \n  summarise(specialTeamsPlayType, specialTeamsResult, kickerId, kickLength, possessionTeam) %>%\n  filter(specialTeamsPlayType == \"Field Goal\") %>% \n  group_by(kickerId) %>% \n  mutate(num_fgs2 = ifelse(specialTeamsResult==\"Kick Attempt Good\",\"Kick Attempt Good\",\"Kick Attempt No Good\")) %>% \n  count(num_fgs2) %>%\n  mutate(num_fgs = sum(n)) %>% \n  mutate(fg_pct = n) %>% \n  filter(num_fgs2 == \"Kick Attempt Good\") %>% \n  mutate(fg_pct = n/num_fgs * 100) %>% \n  ungroup()\n\n# kicking percent with their name \nkicker_pct <- plays_fgs %>% \n  left_join(players_fgs, by = c(\"kickerId\"=\"nflId\")) %>% \n  filter(num_fgs >= 10) %>% \n  arrange(desc(fg_pct))\n\n# viewing the table\nkicker_pcttop10 <- kicker_pct %>% \n  arrange(desc(fg_pct)) %>% \n  slice(1:10) %>% \n  summarise(displayName, n, num_fgs, fg_pct) %>% \n  rename(\"Field Goals Made\" = n) %>% \n  rename(\"Field Goals Attempted\" = num_fgs) %>% \n  rename(\"Kicker Name\" = displayName) %>% \n  rename(\"Field Goal Percent\" = fg_pct)\n\nkicker_pcttop10$\"Field Goal Percent\" <- round(kicker_pcttop10$\"Field Goal Percent\", 2)\n\nkicker_pcttop10","metadata":{"_kg_hide-output":false,"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"We cut down the plays data set for field goals only, calculated the number of field goals each kicker attempted and how many field goals each kicker made, and divided these two to get each kicker's field goal kicking percentage. We set the number of field goals kicked to be over 9, so it gets rid of kickers without a large enough sample size.\n\nJosh Lambo had the highest percent of made field goals at 94.74%, only missing 3 out of 57. However, Justin Tucker kicked 94 field goals and only missed 7. In addition, Lambo and Gano did not kick nearly as many field goals as Tucker and Myers, so we need to quantify this into a metric that effectively ranks NFL kickers. We will ultimately determine what is the most impressive, based on each kicker's percent of field goals made from different length ranges and the number of games they played in.\n\nNow we got each kicker's kicking percentage from different ranges of field goal length. We chose the ranges 0-29 yards, 30-39 yards, 40-49 yards, and over 50 yards to best model the data. Each kicker has field goal percent for each range, and we modeled this in a bar graph.","metadata":{}},{"cell_type":"code","source":"# fg percent based on how long the field goal is and the player kicking it\nplays_fg_length <- plays %>% \n  filter(specialTeamsPlayType == \"Field Goal\") %>% \n  mutate(kick_length_range = ifelse(kickLength<30, \"0-29\", \n                             ifelse(kickLength<40, \"30-39\",\n                             ifelse(kickLength<50, \"40-49\", \"50+\")))) %>% \n  group_by(kickerId, kick_length_range) %>% \n  mutate(num_fgs2 = ifelse(specialTeamsResult==\"Kick Attempt Good\",\"Kick Attempt Good\",\"Kick Attempt No Good\")) %>% \n  count(num_fgs2) %>%\n  mutate(num_fgs = sum(n)) %>% \n  mutate(fg_pct = n) %>% \n  filter(num_fgs2 == \"Kick Attempt Good\") %>% \n  mutate(fg_pct = n/num_fgs * 100) %>% \n  ungroup()\n\n# the above with their name\nkicker_pct_range_team <- plays_fg_length %>% \n  left_join(players_fgs, by = c(\"kickerId\"=\"nflId\")) %>% \n  filter(num_fgs >= 4) %>% \n  arrange(desc(fg_pct))\n\nkicker_pct_cutdown <- kicker_pct %>% \n  summarise(kickerId, fg_pct)\n\nkrangegraph <- kicker_pct_range_team %>% \n  left_join(kicker_pct_cutdown, by=\"kickerId\")\n\nkrangegraph1 <- krangegraph %>% \n  arrange(desc(fg_pct.y)) %>%\n  slice(1:20) %>% \n  ungroup() \n\n#DONE\nkrangegraph1 %>% \n  ggplot(aes(x=reorder(displayName,-fg_pct.y),y=fg_pct.x, fill=kick_length_range)) +\n  geom_col(position = position_dodge2(preserve = \"single\")) +\n  labs(title=\"Field Goal Kicking Percentage by Range\", x=\"Kicker Name\", y=\"Field Goal Percentage\", subtitle=\"Of the Top 5 Kickers Based on Overall Field Goal Percentage\") +\n  geom_text(aes(label=num_fgs),position=position_dodge(width=0.9), vjust=-0.25) +\n  theme(plot.title=element_text(face=\"bold\")) +\n  theme(axis.title.y=element_text(face=\"bold\")) +\n  theme(axis.title.x=element_text(face=\"bold\")) +\n  scale_fill_discrete(name=\"Field Goal Length\")","metadata":{"_kg_hide-output":false,"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"We took the top 5 kickers based on the overall field goal percentage from before, and made a bar chart of their field goal percentages from each range. Each of these kickers were perfect from 0-29 yards, and there is a downward trend as the field goal length increases. However, Younghoe Koo was the only kicker perfect from 50+ yards (going 7 for 7) which is very impressive. He may be the most impressive kicker, but will his subpar percentages from both 30-39 and 40-49 yards be too much to overcome?\n\nGiven these percentages, we will develop a new way to rank kickers other than just by overall kicking percentages. We will also take into account the number of games each kicker played in the 2018-2020 NFL seasons.\n\nIn order to rank each kicker, we need to develop a field goal rating. This will be very similar to a quarterback's passer rating. First, we need to find out how many games each kicker played in the past 3 seasons by counting how many game appearances each kicker had.","metadata":{}},{"cell_type":"code","source":"games_played <- plays %>% \n  group_by(kickerId) %>% \n  distinct(gameId, .keep_all = TRUE) %>% \n  mutate(gameplayed = 1) %>% \n  mutate(num_games_played = sum(gameplayed)) %>% \n  ungroup()\n\ngames_played_names <- games_played %>% \n  left_join(players_fgs, by = c(\"kickerId\"=\"nflId\")) %>% \n  summarise(kickerId, displayName, num_games_played)","metadata":{"_kg_hide-output":false,"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Now, we can quantify a kicker's field goal rating. We changed the ranges for field goals to just 3: 0-39 yards, 40-49 yards, and over 50 yards. Our kicker rating will be a number that is quantified by:\n- Weight of each field goal range - multiplying the number of field goals kicked from each range by a number (3 for 0-39, 4 for 40-49, and 5 for 50+). For example, if a kicker kicked 20 field goals from 0-39 yards, their weighted field goal range would be 20*3 = 60 for that yardage range. This places more weight on 50+ yard field goals, because they're more impressive than 30 yard field goals.\n- Total number of field goals attempted.\n- Total number of field goals made. \n- Number of games played (maximum of 48 for 3 NFL regular seasons).\n\nThe best formula we developed gives us the field goal kicker rating for each NFL kicker: \n((sum of the weight of each field goal range) - (total field goals attempted - field goals made)) / (number of games played)\n\nThe kickers with the top 10 kicker ratings are below.","metadata":{}},{"cell_type":"code","source":"kicker_rating3 <- plays %>% \n  filter(specialTeamsPlayType == \"Field Goal\") %>% \n  mutate(kick_length_range = ifelse(kickLength<40, \"0-39\", \n                             ifelse(kickLength<50, \"40-49\",\"50+\"))) %>% \n  group_by(kickerId, kick_length_range) %>% \n  mutate(num_fgs2 = ifelse(specialTeamsResult==\"Kick Attempt Good\",\"Kick Attempt Good\",\"Kick Attempt No Good\")) %>% \n  count(num_fgs2) %>%\n  mutate(num_fgs = sum(n)) %>% \n  mutate(fg_pct = n) %>% \n  filter(num_fgs2 == \"Kick Attempt Good\") %>%\n  mutate(fg_pct = n/num_fgs) %>%\n  ungroup() %>% \n  group_by(kickerId) %>% \n  mutate(total_fgs_kicked = sum(num_fgs)) %>% \n  ungroup() %>% \n  mutate(fg_range_weight = ifelse(kick_length_range == \"0-39\", n*3,\n                           ifelse(kick_length_range == \"40-49\", n*4, n*5))) %>%\n  group_by(kickerId) %>% \n  mutate(kicker_rating_num = (sum(fg_range_weight) - (sum(num_fgs)-sum(n))) / sum(num_fgs)) %>% \n  ungroup() %>% \n  filter(total_fgs_kicked >= 10) %>% \n  arrange(desc(kicker_rating_num))\n\nkicker_rating3name <- kicker_rating3 %>% \n  left_join(players_fgs, by = c(\"kickerId\"=\"nflId\"))\n\ntotal_kr <- games_played_names %>% \n  left_join(kicker_rating3, by=\"kickerId\") %>% \n  drop_na(num_fgs2)\n\ntotal_kr1 <- total_kr %>% \n  group_by(kickerId) %>% \n  mutate(final_kr = ((sum(fg_range_weight) - (sum(num_fgs)-sum(n))) / num_games_played / num_games_played)*10) %>% \n  ungroup()\n\ntotal_kr1$final_kr <- round(total_kr1$final_kr, 2)\n\ntotal_kr1graph <- total_kr1 %>%\n  distinct(displayName, .keep_all = TRUE) %>% \n  arrange(desc(final_kr)) %>% \n  slice(1:10) \n\nkicker_pct_cutdown <- kicker_pct %>% \n  summarise(kickerId, fg_pct)\n\nkicker_rating_plot <- total_kr1graph %>% \n  left_join(kicker_pct_cutdown, by=\"kickerId\")\n\nkicker_rating_plot$fg_pct.y <- round(kicker_rating_plot$fg_pct.y, 2)\n\nkickerplotcut <- kicker_rating_plot %>% \n  summarise(displayName, final_kr) %>% \n  rename(\"Kicker Name\" = displayName) %>%\n  rename(\"Kicker Rating\" = final_kr)\n\nkickerplotcut","metadata":{"_kg_hide-output":false,"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Younghoe Koo had the best kicker rating in the NFL over the 2018-2020 seasons, followed by Justin Tucker and Rodrigo Blankenship.\n\nWe can model the kickers with the top 10 highest ratings with other factors.","metadata":{}},{"cell_type":"code","source":"# DONE\nkicker_rating_plot %>% \n  mutate(g_played = ifelse(num_games_played > 32, \"3 seasons\", \n                           ifelse(num_games_played > 16, \"2 seasons\", \"1 season\"))) %>% \n  ggplot(aes(x=reorder(displayName, -final_kr), y=final_kr)) +\n  geom_col(aes(fill=g_played)) +\n  geom_text(aes(label=final_kr),vjust=-0.25) +\n  geom_text(aes(label=fg_pct.y),vjust=13) +\n  labs(title=\"Field Goal Kicker Rating with Field Goal Percentage and Games Played\", x=\"Kicker Name\", y=\"Field Goal Kicker Rating\") +\n  theme(plot.title=element_text(face=\"bold\")) +\n  theme(axis.title.y=element_text(face=\"bold\")) +\n  theme(axis.title.x=element_text(face=\"bold\")) +\n  scale_fill_discrete(name=\"Seasons Played\") +\n  theme(axis.text.x=element_text(angle=90,vjust=0.6))","metadata":{"_kg_hide-output":false,"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Here we have the kickers with the top 10 field goal ratings. The middle of each bar is the kicker's overall field goal percentage, and they are colored with the kicker's number of seasons played.\n\nBased on the overall field goal percentage, Younghoe Koo was not the best, but his perfect percent of 7 out of 7 for 50+ yard field goals was a key factor that put him over Tucker and Lambo, who had higher overall field goal percentages. Josh Lambo had the highest percentage, but he missed kicks from 40-49 and 50+ yards; with the stressed importance of those ranges in our formula, he is only ranked 6th.\n\nBased on the number of seasons each kicker played, most kickers were long term kickers who played in all three seasons. However, Blankenship and Forbath only played in 1 season, and were very efficient field goal kickers. \n\nGoing back to our initial analysis and questions, our formula shows it was more impressive for Tucker to kick and make more field goals than Lambo, even though Lambo had a higher overall kicking percentage. Koo's impressive percentage of field goals over 50 yards was indeed enough to override his subpar percentages from 30-39 and 40-49 yards, ultimately putting him on top, showing the importance of how much field goals over 50 yards matter to each kicker's ability and rating. \n\nIt is worth noting that Forbath and Lambo are free agents as of January 2022, which is surprising given their top 10 kicker ratings over the 2018-2020 NFL seasons. We encourage NFL teams to look at our kicker rating in determining which kickers to sign.\n\n\n## Punt Yards Over Expectation (PYOE)\n\nThe job of the punter falls at the intersection of technique, power, and precision. While a short drive might leave the punter winding up for a long punt, a shorter field situation may ask a completely different job. Thus, traditional counting measures of punters may not actually account for their impact on the game. A team that punts often from deep in their own territory might boast a punter with a high average kick length while a team that punts from further up on average may own a punter with many punts downed inside the opposition 20-yard line. Which punter is more valuable?\n\nWe introduce Punt Yards Over Expectation (PYOE), a new framework for evaluating punt impact. At the heart of the new metric is a comprehensive model using the XGBoost regression algorithm to predict the result of a punt. While including many of the features provided by PFF, we began by adding more features; we first modified some of the counting metrics to include variables like the number of gunners, seconds until the end of the game, and the score differential for the possession team. We then used the tracking data to get the speed and distance of the three closest players to the punt returner when the punt lands to include as features. In addition, we used the k-means clustering algorithm to group locations of players at the snap of the ball and at the point of the punt landing. This grouped the snap formations into two clusters and the landing formations into three clusters, adjusted for play direction. \n\nFeature Selection and Engineering","metadata":{}},{"cell_type":"code","source":"### add distance from line of scrimmage to endzone\n\n# punts$LOSdistance <- 0\n# for(i in 1:nrow(punts)){\n#   if(punts$yardlineNumber[i] == 50){\n#     punts$LOSdistance[i] <- punts$yardlineNumber[i]\n#   } else if(punts$yardlineSide[i] == punts$possessionTeam[i]){\n#     punts$LOSdistance[i] <- 100 - punts$yardlineNumber[i]\n#   } else{\n#     punts$LOSdistance[i] <- punts$yardlineNumber[i]\n#   }\n# }\n\n### add new version of snapDetail without the symbols\n\n# punts$snapDetailNew <- ifelse(punts$snapDetail == \"<\",\"Left\",ifelse(punts$snapDetail == \"OK\",\"OK\",ifelse(punts$snapDetail == \">\",\"Right\",ifelse(punts$snapDetail == \"H\",\"High\",\"Low\"))))\n\n### add a variable for whether the intended direction matches the actual\n\n# punts$kickDirectionSuccess <- ifelse(punts$kickDirectionIntended == punts$kickDirectionActual,1,0)\n\n### add a variable for the number of gunners in the punt coverage team\n\n# punts$numGunners <- ifelse(nchar(punts$gunners) == 5 | nchar(punts$gunners) == 6,1,ifelse(nchar(punts$gunners) == 12 | nchar(punts$gunners) == 14,2,ifelse(is.na(punts$gunners),0,ifelse(nchar(punts$gunners) == 19 | nchar(punts$gunners) == 22,3,4))))\n# punts$numGunners[is.na(punts$numGunners)] <- 0\n\n### add a dummy variable for whether the punting team is home or away\n\n# punts$isHome <- ifelse(punts$possessionTeam == punts$homeTeamAbbr,1,0)\n# punts$isAway <- ifelse(punts$possessionTeam == punts$homeTeamAbbr,1,0)\n\n### add a dummy variable for whether either team commits a penalty\n\n# punts$isKickingPen <- 0\n# punts$isReturningPen <- 0\n# for(i in 1:nrow(punts)){\n#   if(grepl(punts$possessionTeam[i],punts$penaltyJerseyNumbers[i])){\n#     punts$isKickingPen[i] <- 1\n#   } else if(!is.na(punts$penaltyJerseyNumbers[i]) && grepl(punts$possessionTeam[i],punts$penaltyJerseyNumbers[i]) == F){\n#     punts$isReturningPen[i] <- 1\n#   }\n# }\n\n### convert the gameClock time to two numeric variables\n\n# punts$secondsRemainingQuarter <- (as.numeric(substring(punts$gameClock,1,2)) * 60) + (as.numeric(substring(punts$gameClock,4,5)))\n# punts$secondsRemainingGame <- punts$secondsRemainingQuarter + ((4 - punts$quarter)*900) \n\n# punts$penaltyYards[is.na(punts$penaltyYards)] <- 0\n\n### get score differential for the possession team\n\n# punts$possessionTeamScoreDiff <- 0\n# for (i in 1:nrow(punts)){\n#   if(punts$possessionTeam[i] == punts$homeTeamAbbr[i]){\n#     punts$possessionTeamScoreDiff[i] <- punts$preSnapHomeScore[i] - punts$preSnapVisitorScore[i]\n#   } else{\n#     punts$possessionTeamScoreDiff[i] <- punts$preSnapHomeScore[i] - punts$preSnapVisitorScore[i]\n#   }\n# }","metadata":{"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Looping through tracking data for various feature additions","metadata":{}},{"cell_type":"code","source":"### create a dataframe that will contain an index of each punt to hold the tracking variables\n\n# all.tracking.stats <- data.frame()\n# playindex <- unique(punts[,c(\"gameId\",\"playId\")])\n\n### connect to a sqlite database to pull the punting data\n\n# con <- dbConnect(SQLite(),dbname = \"Punts.sqlite\")\n# dbDisconnect(con)\n\n# for (i in 1:nrow(punts)){\n\n### get the gameId and playId of the current play and add the symbols to put in the SQL query\n\n#   gameid.int <- str_c(\"'\",playindex[i,1],\"'\")\n#   playid.int <- str_c(\"'\",playindex[i,2],\"'\")\n\n### pull the tracking data for the play\n\n#   play.int <- dbGetQuery(con,str_c(\"\n#                      SELECT * \n#                        FROM punts_trackingall\n#                       WHERE gameId = \",gameid.int,\" AND playId = \",playid.int))\n\n### convert variables to numeric\n\n#   play.int$gameId <- as.numeric(play.int$gameId)\n#   play.int$playId <- as.numeric(play.int$playId)\n#   play.int$x <- as.numeric(play.int$x)\n#   play.int$y <- as.numeric(play.int$y)\n\n### add important variables\n\n#   playint.joined <- left_join(play.int,games[,c(\"gameId\",\"homeTeamAbbr\",\"visitorTeamAbbr\")])\n#   playint.joined <- left_join(playint.joined,punts[,c(\"gameId\",\"playId\",\"gunners\",\"numGunners\",\"returnerId\",\"kickerId\")])\n\n### get team abbreviation for individual player\n\n#   playint.joined$teamAbbr <- ifelse(playint.joined$team == \"home\",playint.joined$homeTeamAbbr,ifelse(playint.joined$team == \"football\",\"football\",playint.joined$visitorTeamAbbr))\n\n### determine whether player is gunner or not\n\n#   playint.joined$isGunner <- 0\n#   for(j in 1:nrow(playint.joined)){\n#     if(grepl(playint.joined$teamAbbr[j],playint.joined$gunners[j]) && grepl(playint.joined$jerseyNumber[j],playint.joined$gunners[j])){\n#       playint.joined$isGunner[j] <- 1\n#     }\n#   }\n#   playint.joined$isGunner[playint.joined$position == \"P\" & !is.na(playint.joined$position)] <- 0\n\n### get id for kicking or return team\n\n#   playint.joined$kickOrReturn <- 0\n#   for(k in 1:nrow(playint.joined)){\n#     if(grepl(playint.joined$teamAbbr[k],playint.joined$gunners[k])){\n#       playint.joined$kickOrReturn[k] <- \"kick\"\n#     } else if(playint.joined$teamAbbr[k] == \"football\"){\n#       playint.joined$kickOrReturn[k] <- NA\n#     } else{\n#       playint.joined$kickOrReturn[k] <- \"return\"\n#     }\n#   }\n\n### add abbr for kick and return team\n\n#   playint.joined$kickTeamAbbr <- rep(unique(playint.joined[,c(\"kickOrReturn\",\"teamAbbr\")]) %>% filter(kickOrReturn == \"kick\") %>% select(teamAbbr),nrow(playint.joined))\n#   playint.joined$returnTeamAbbr <- rep(unique(playint.joined[,c(\"kickOrReturn\",\"teamAbbr\")]) %>% filter(kickOrReturn == \"return\") %>% select(teamAbbr),nrow(playint.joined))\n\n### gets distance from punter to add returner id when given as NA\n\n#   playint.joined <- playint.joined %>% mutate(distfrompunter.x = abs(x - playint.joined$x[playint.joined$position == \"P\" | playint.joined$position == \"K\"][1]))\n# \n#   if(is.na(playint.joined$returnerId[1])){\n#     maxdist <- max(playint.joined$distfrompunter.x[playint.joined$frameId == 1])\n#     playint.joined$returnerId <- playint.joined$nflId[playint.joined$frameId == 1 & playint.joined$distfrompunter.x == maxdist]\n#   } \n\n### only take the first returner if there are multiple\n\n#   if(grepl(\";\",playint.joined$returnerId[1])){\n#     playint.joined$returnerId <- substring(playint.joined$returnerId[1],1,5)\n#   }\n\n### create a new df that will contain the final features for this play\n\n#   playint.joined.end <- unique(playint.joined[,c(\"gameId\",\"playId\")])\n\n### get the x and y distances from the punter and returner for every player\n\n#   for(m in 1:nrow(playint.joined)){\n\n####dist from returner in x\n\n#     playint.joined$distFromReturner.x[m] <- abs(playint.joined$x[m] - playint.joined$x[playint.joined$nflId == playint.joined$returnerId[1] & playint.joined$frameId == playint.joined$frameId[m] & !is.na(playint.joined$nflId)])\n\n###dist from returner in y\n\n#     playint.joined$distFromReturner.y[m] <- abs(playint.joined$y[m] - playint.joined$y[playint.joined$nflId == playint.joined$returnerId[1] & playint.joined$frameId == playint.joined$frameId[m] & !is.na(playint.joined$nflId)])\n\n###dist from punter in x\n\n#     playint.joined$distFromPunter.x[m] <- abs(playint.joined$x[m] - playint.joined$x[(playint.joined$position == \"P\" | playint.joined$position == \"K\") & playint.joined$frameId == playint.joined$frameId[m] & !is.na(playint.joined$nflId)])\n\n###dist from punter in y\n\n#     playint.joined$distFromPunter.y[m] <- abs(playint.joined$y[m] - playint.joined$y[(playint.joined$position == \"P\" | playint.joined$position == \"K\") & playint.joined$frameId == playint.joined$frameId[m] & !is.na(playint.joined$nflId)])\n#   }\n\n### get euclidean distance\n\n#   playint.joined$euclidDistanceFromPunter <- sqrt(playint.joined$distFromPunter.x^2 + playint.joined$distFromPunter.y^2)\n#   playint.joined$euclidDistanceFromReturner <- sqrt(playint.joined$distFromReturner.x^2 + playint.joined$distFromReturner.y^2)\n\n### add variables for distance from returner\n\n#   playint.joined.end$numPlayers15FromReturnerLand <- nrow(playint.joined %>% filter(event == \"punt_land\" | event == \"punt_received\" | event == \"fair_catch\" | event == \"punt_muffed\",kickOrReturn == \"kick\",euclidDistanceFromReturner <= 15))\n#   playint.joined.end$distClosestPlayer <- (playint.joined %>% filter(event == \"punt_land\" | event == \"punt_received\" | event == \"fair_catch\" | event == \"punt_muffed\",kickOrReturn == \"kick\") %>% select(euclidDistanceFromReturner) %>% arrange(euclidDistanceFromReturner))[1,]\n#   playint.joined.end$dist2ndClosestPlayer <- (playint.joined %>% filter(event == \"punt_land\" | event == \"punt_received\" | event == \"fair_catch\" | event == \"punt_muffed\",kickOrReturn == \"kick\") %>% select(euclidDistanceFromReturner) %>% arrange(euclidDistanceFromReturner))[2,]\n#   playint.joined.end$dist3rdClosestPlayer <- (playint.joined %>% filter(event == \"punt_land\" | event == \"punt_received\" | event == \"fair_catch\" | event == \"punt_muffed\",kickOrReturn == \"kick\") %>% select(euclidDistanceFromReturner) %>% arrange(euclidDistanceFromReturner))[3,]\n\n### get the speed of the three closest variables\n\n#   playint.joined.end$speedClosestPlayer <- (playint.joined %>% filter(event == \"punt_land\" | event == \"punt_received\" | event == \"fair_catch\" | event == \"punt_muffed\",kickOrReturn == \"kick\") %>% select(euclidDistanceFromReturner,s) %>% arrange(euclidDistanceFromReturner))[1,2]\n#   playint.joined.end$speed2ndClosestPlayer <- (playint.joined %>% filter(event == \"punt_land\" | event == \"punt_received\" | event == \"fair_catch\" | event == \"punt_muffed\",kickOrReturn == \"kick\") %>% select(euclidDistanceFromReturner,s) %>% arrange(euclidDistanceFromReturner))[2,2]\n#   playint.joined.end$speed3rdClosestPlayer <- (playint.joined %>% filter(event == \"punt_land\" | event == \"punt_received\" | event == \"fair_catch\" | event == \"punt_muffed\",kickOrReturn == \"kick\") %>% select(euclidDistanceFromReturner,s) %>% arrange(euclidDistanceFromReturner))[3,2]\n\n### add the variables from this play to the dataframe\n\n#   all.tracking.stats <- rbind(all.tracking.stats,playint.joined.end)\n# \n# }","metadata":{"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Clustering Snap Locations","metadata":{}},{"cell_type":"code","source":"### set seed for repeatability and load in the tracking data for the frame at the snap\n\n# set.seed(1234)\n# con <- dbConnect(SQLite(),dbname = \"Punts.sqlite\")\n# \n# startformation <- dbGetQuery(con,\"SELECT *\n#                   FROM punts_trackingall\n#                  WHERE event = 'ball_snap'\")\n\n### adjust variables and do some left joins\n\n# startformation$gameId <- as.numeric(startformation$gameId)\n# startformation$playId <- as.numeric(startformation$playId)\n# startformation$x <- as.numeric(startformation$x)\n# startformation$y <- as.numeric(startformation$y)\n# startformation.joined <- left_join(startformation,games[,c(\"gameId\",\"homeTeamAbbr\",\"visitorTeamAbbr\")])\n# startformation.joined <- left_join(startformation.joined,punts[,c(\"gameId\",\"playId\",\"gunners\")])\n# startformation.joined$teamAbbr <- ifelse(startformation.joined$team == \"home\",startformation.joined$homeTeamAbbr,ifelse(startformation.joined$team == \"football\",\"football\",startformation.joined$visitorTeamAbbr))\n\n### identify the punting team\n\n# startformation.joined$kickOrReturn <- 0\n# for(k in 1:nrow(startformation.joined)){\n#   if(grepl(startformation.joined$teamAbbr[k],startformation.joined$gunners[k])){\n#     startformation.joined$kickOrReturn[k] <- \"kick\"\n#   } else if(startformation.joined$teamAbbr[k] == \"football\"){\n#     startformation.joined$kickOrReturn[k] <- NA\n#   } else{\n#     startformation.joined$kickOrReturn[k] <- \"return\"\n#   }\n# }\n\n### this method doesn't work in 2 cases so need to loop through the plays that include more than 11 players. the loop works but may read an error\n\n# kick.startformation <- startformation.joined %>% filter(kickOrReturn == \"kick\")\n# \n# bad.plays <- kick.startformation %>% group_by(gameId,playId) %>% summarise(count =n()) %>% filter(count > 11)\n# \n# for(i in 1:nrow(bad.plays)){\n#   play.int <- kick.startformation %>% filter(gameId == bad.plays$gameId[i],playId == bad.plays$playId[i])\n#   punt.team <- play.int %>% filter(position == \"P\"|position == \"K\") %>% select(team)\n#   for (k in 1:nrow(play.int)){\n#     if(play.int$team[k] != punt.team){\n#       play.int$kickOrReturn[k] <- \"return\"\n#     }\n#   }\n#   play.int <- play.int %>% filter(kickOrReturn == \"kick\")\n#   kick.startformation <- kick.startformation %>% filter(gameId != bad.plays$gameId[i],playId != bad.plays$playId[i])\n#   kick.startformation <- rbind(kick.startformation,play.int)\n# }\n\n### get the orientation of the punter to add the direction of the play\n \n# kick.startformation <- kick.startformation %>% group_by(gameId,playId) %>% mutate(punterOrientation = o[position == \"P\"|position == \"K\"])\n# kick.startformation <- kick.startformation %>% mutate(puntDirection = ifelse(as.numeric(punterOrientation) <= 180,\"L to R\",\"R to L\"))\n\n### split the kicks into left to right and right to left. flip the left to right kicks. assign labels P1-P11 to players from left to right\n\n# kick.RtoL.start <- kick.startformation %>% filter(puntDirection == \"R to L\") %>% group_by(gameId,playId) %>% arrange(y) %>% mutate(playernum = str_c(\"P\",row_number())) %>% arrange(-gameId,-playId)\n# kick.LtoR.start <- kick.startformation %>% filter(puntDirection == \"L to R\") %>% group_by(gameId,playId) %>% arrange(-y) %>% mutate(playernum = str_c(\"P\",row_number())) %>% arrange(-gameId,-playId) %>% mutate(y = 53.3-y,x = 120 - x)\n\n# kick.startformation <- rbind(kick.RtoL.start,kick.LtoR.start)\n\n### get a dataframe with only the gameid,playid,playernum, and coordinate\n### scale the coordinates for k-means algorithm\n \n# start.basic <- kick.startformation[,c(\"gameId\",\"playId\",\"playernum\",\"x\",\"y\")]\n# start.basic$x <- scale(start.basic$x)\n# start.basic$y <- scale(start.basic$y)\n\n### widen the dataframe\n\n# start.df <- unnest(start.basic %>% pivot_wider(names_from = playernum,values_from = c(x,y)))\n\n### use two methods to determine the optimal number of clusters\n\n# fviz_nbclust(start.df[,c(-1,-2)],kmeans,method = \"wss\")\n# fviz_nbclust(start.df[,c(-1,-2)],kmeans,method = \"silhouette\")\n\n### run the k-means algorithm and assign the clusters to the start.df dataframe before joining to the punts\n\n# k1 <- kmeans(start.df[,c(-1,-2)],centers = 2,nstart = 25)\n\n# start.df$snapCluster <- k1$cluster\n\n# fviz_cluster(k1,data = start.df.noid)\n\n# punts <- left_join(punts,start.df[,c(\"gameId\",\"playId\",\"snapCluster\")])","metadata":{"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Clustering Punt Landing Locations","metadata":{}},{"cell_type":"code","source":"### this is the same as above but for a different frame\n\n# set.seed(1234)\n# con <- dbConnect(SQLite(),dbname = \"Punts.sqlite\")\n\n# endformation <- dbGetQuery(con,\"SELECT *\n#                   FROM punts_trackingall\n#                  WHERE event = 'punt_land' OR event = 'punt_received' OR event = 'fair_catch' OR event == 'punt_muffed'\")\n\n# endformation$gameId <- as.numeric(endformation$gameId)\n# endformation$playId <- as.numeric(endformation$playId)\n# endformation$x <- as.numeric(endformation$x)\n# endformation$y <- as.numeric(endformation$y)\n# endformation.joined <- left_join(endformation,games[,c(\"gameId\",\"homeTeamAbbr\",\"visitorTeamAbbr\")])\n# endformation.joined <- left_join(endformation.joined,punts[,c(\"gameId\",\"playId\",\"gunners\")])\n# endformation.joined$teamAbbr <- ifelse(endformation.joined$team == \"home\",endformation.joined$homeTeamAbbr,ifelse(endformation.joined$team == \"football\",\"football\",endformation.joined$visitorTeamAbbr))\n\n# endformation.joined$kickOrReturn <- 0\n# for(k in 1:nrow(endformation.joined)){\n#   if(grepl(endformation.joined$teamAbbr[k],endformation.joined$gunners[k])){\n#     endformation.joined$kickOrReturn[k] <- \"kick\"\n#   } else if(endformation.joined$teamAbbr[k] == \"football\"){\n#     endformation.joined$kickOrReturn[k] <- NA\n#   } else{\n#     endformation.joined$kickOrReturn[k] <- \"return\"\n#   }\n# }\n\n# kick.endformation <- endformation.joined %>% filter(kickOrReturn == \"kick\")\n# \n# # get rid of plays with multiple appearances\n# \n# mult.plays <- unique(kick.endformation[,c(\"gameId\",\"playId\",\"frameId\")]) %>% group_by(gameId,playId) %>% summarise(count = n()) %>% filter(count > 1) %>% arrange(-count)\n# \n# for(i in 1:nrow(mult.plays)){\n#   kick.endformation <- kick.endformation %>% filter(playId != mult.plays$playId[i] | gameId != mult.plays$gameId[i] | frameId == kick.endformation$frameId[kick.endformation$gameId == mult.plays$gameId[i] & kick.endformation$playId == mult.plays$playId[i]][1])\n# }\n\n# bad.plays <- kick.endformation %>% group_by(gameId,playId) %>% summarise(count =n()) %>% filter(count > 11)\n# \n# for(i in 1:nrow(bad.plays)){\n#   play.int <- kick.endformation %>% filter(gameId == bad.plays$gameId[i],playId == bad.plays$playId[i])\n#   punt.team <- play.int %>% filter(position == \"P\"|position == \"K\") %>% select(team)\n#   for (k in 1:nrow(play.int)){\n#     if(play.int$team[k] != punt.team){\n#       play.int$kickOrReturn[k] <- \"return\"\n#     }\n#   }\n#   play.int <- play.int %>% filter(kickOrReturn == \"kick\")\n#   kick.endformation <- kick.endformation %>% filter(gameId != bad.plays$gameId[i],playId != bad.plays$playId[i])\n#   kick.endformation <- rbind(kick.endformation,play.int)\n# }\n\n# kick.endformation <- kick.endformation %>% group_by(gameId,playId) %>% mutate(punterOrientation = o[position == \"P\"|position == \"K\"])\n# kick.endformation <- kick.endformation %>% mutate(puntDirection = ifelse(as.numeric(punterOrientation) <= 180,\"L to R\",\"R to L\"))\n\n# kick.RtoL.end <- kick.endformation %>% filter(puntDirection == \"R to L\") %>% group_by(gameId,playId) %>% arrange(y) %>% mutate(playernum = str_c(\"P\",row_number())) %>% arrange(-gameId,-playId)\n# kick.LtoR.end <- kick.endformation %>% filter(puntDirection == \"L to R\") %>% group_by(gameId,playId) %>% arrange(-y) %>% mutate(playernum = str_c(\"P\",row_number())) %>% arrange(-gameId,-playId) %>% mutate(y = 53.3-y,x = 120 - x)\n\n# kick.endformation <- rbind(kick.RtoL.end,kick.LtoR.end)\n\n# end.basic <- kick.endformation[,c(\"gameId\",\"playId\",\"playernum\",\"x\",\"y\")]\n# end.basic$x <- scale(end.basic$x)\n# end.basic$y <- scale(end.basic$y)\n# end.df <- unnest(end.basic %>% pivot_wider(names_from = playernum,values_from = c(x,y)))\n\n# fviz_nbclust(end.df[,c(-1,-2)],kmeans,method = \"wss\")\n# fviz_nbclust(end.df[,c(-1,-2)],kmeans,method = \"silhouette\")\n\n# k2 <- kmeans(end.df[,c(-1,-2)],centers = 3,nstart = 25)\n\n# end.df$landCluster <- k2$cluster\n\n# fviz_cluster(k2,data = end.df.noid)\n#\n# punts <- left_join(punts,end.df[,c(\"gameId\",\"playId\",\"landCluster\")])","metadata":{"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Now with a robust set of features, we used the evaluation metric of mean average error and 10-fold cross validation to create the model. Note: We loaded in the premodel_punts.csv file that includes the tracking variables because the loops above would take too long to run.","metadata":{}},{"cell_type":"code","source":"future::plan(\"multisession\")\nlibrary(caret)\nlibrary(xgboost)\nlibrary(gganimate)\nlibrary(RSQLite)\nlibrary(cluster)\nlibrary(factoextra)\n\n### select the features from punts to use in the model\nset.seed(1234)\nmodelpunts <- punts %>% select(gameId,playId,playResult,kickLength,hangTime,snapDetailNew,kickType,kickDirectionSuccess,kickDirectionIntended,kickDirectionActual,numGunners,quarter,yardsToGo,isHome,isAway,isKickingPen,isReturningPen,LOSdistance,secondsRemainingGame,secondsRemainingQuarter,penaltyYards,possessionTeamScoreDiff,numPlayers15FromReturnerLand,distClosestPlayer,dist2ndClosestPlayer,dist3rdClosestPlayer,speedClosestPlayer,speed2ndClosestPlayer,speed3rdClosestPlayer,snapCluster,landCluster)\n\n### add dummy variables and remove the original variables with character type\nmodelpunts <- modelpunts %>% mutate(\n  isSnapDetailOK = ifelse(snapDetailNew == \"OK\",1,0),\n  isSnapDetailLeft = ifelse(snapDetailNew == \"Left\",1,0),\n  isSnapDetailHigh = ifelse(snapDetailNew == \"High\",1,0),\n  isSnapDetailRight = ifelse(snapDetailNew == \"Right\",1,0),\n  isSnapDetailLow = ifelse(snapDetailNew == \"Low\",1,0),\n  isKickTypeN = ifelse(kickType == \"N\",1,0),\n  isKickTypeA = ifelse(kickType == \"A\",1,0),\n  isKickTypeR = ifelse(kickType == \"R\",1,0),\n  isKickDirectionIntendedR = ifelse(kickDirectionIntended == \"R\",1,0),\n  isKickDirectionIntendedC = ifelse(kickDirectionIntended == \"C\",1,0),\n  isKickDirectionIntendedL = ifelse(kickDirectionIntended == \"L\",1,0),\n  isKickDirectionActualR = ifelse(kickDirectionActual == \"R\",1,0),\n  isKickDirectionActualC = ifelse(kickDirectionActual == \"C\",1,0),\n  isKickDirectionActualL = ifelse(kickDirectionActual == \"L\",1,0),\n  isSnapCluster1 = ifelse(snapCluster == 1,1,0),\n  isSnapCluster2 = ifelse(snapCluster == 2,1,0),\n  isLandCluster1 = ifelse(landCluster == 1,1,0),\n  isLandCluster2 = ifelse(landCluster == 2,1,0),\n  isLandCluster3 = ifelse(landCluster == 3,1,0)\n)\nmodelpunts$snapDetailNew <- NULL\nmodelpunts$kickType <- NULL\nmodelpunts$kickDirectionActual <- NULL\nmodelpunts$kickDirectionIntended <- NULL\nmodelpunts$snapCluster <- NULL\nmodelpunts$landCluster <- NULL\n\nmodelpunts$speedClosestPlayer <- as.numeric(modelpunts$speedClosestPlayer)\nmodelpunts$speed2ndClosestPlayer <- as.numeric(modelpunts$speed2ndClosestPlayer)\nmodelpunts$speed3rdClosestPlayer <- as.numeric(modelpunts$speed3rdClosestPlayer)\n\n### create the split in the data, 80% for train and 20% for the test, we only use train to train the model\ntrainindex <- createDataPartition(modelpunts$playResult,p = 0.8,list = F)\ntrain <- modelpunts[trainindex,c(-1,-2)]\ntest <- modelpunts[-trainindex,c(-1,-2)]\n\n### assign the response variable to train_lab and test_lab\ntrain_lab <- train$playResult\ntest_lab <- test$playResult\n\n### create the train and test objects, but when inputting the data leave out the target variable which is play result\nxgb.train = xgb.DMatrix(data = as.matrix(train[,-1]), label = train_lab)\nxgb.test = xgb.DMatrix(data = as.matrix(test[, -1]), label = test_lab)\n\n### Set the parameters for the model, since it's linear regression, use the booster of gblinear and the objective red:squarederror\nparams <- list(booster = \"gblinear\",\n               objective = \"reg:squarederror\",\n               eval_metric = \"mae\",\n               subsample = 0.9,\n               max_depth = 8,\n               colsample_bytree = 0.8,\n               eta = 0.75,\n               min_child_weight = 10)\n\n### train the model\npunt.model.first <- xgb.train(params = params, data = xgb.train, nrounds = 100)\n\n### run the 10 fold cross validation then select the optimal number of rounds for the final model\nxgb_cv <- xgb.cv(data=xgb.train,\n                 label = train_lab,\n                 params=params,\n                 nrounds=100,\n                 prediction=TRUE,\n                 maximize=FALSE,\n                 nfold=10,\n                 early_stopping_rounds = 30,\n                 print_every_n = 5\n)\n\nnrounds <- xgb_cv$best_iteration\n\n### train the final model\nxgb_final <- xgb.train(params = params,\n                       data = xgb.train,\n                       nrounds = nrounds,\n                       verbose = 1,\n                       print_every_n = 5\n)","metadata":{"_kg_hide-input":true,"_kg_hide-output":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Reviewing the error metrics for the model’s predictions of the test dataset, the root mean square error was 8.48. However, further analysis of the errors found the model handled outlier punt results events poorly. The plot below measures the distribution of errors against play result; the punts that result in large negative plays (ie long punt returns) have large errors.","metadata":{}},{"cell_type":"code","source":"### prediction\npreds <- predict(xgb_final,xgb.test)\ntest$predPlayResult <- preds\n\n### error analysis, first the rmse,mae, and R^2 for the predictions both raw and removing the outlier errors. then a plot\npostResample(test$predPlayResult,test$playResult)\npostResample(test$predPlayResult[test$error < 30],test$playResult[test$error < 30])\n\nmodel_error <- test %>% ggplot(aes(x = playResult,y = error))+geom_point()+ggtitle(\"Error Distribution\")+xlab(\"Punt Result\")+ylab(\"Error\")+theme(\n  panel.background = element_rect(fill = \"white\"),\n  panel.grid = element_line(color = \"light grey\"),\n  axis.ticks = element_blank(),\n  plot.title = element_text(hjust = 0.5)\n)","metadata":{"_kg_hide-input":true,"_kg_hide-output":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Removing all observations with an error greater than 30 yields a RMSE of 6.47. Reviewing the importance of the features yields the plot below with the weights of the top 10 most important features. The presence of a penalty on either side of the ball played a significant role in determining play result as did the variation in snap detail. ","metadata":{}},{"cell_type":"code","source":"### feature importance\nimportance_matrix <- xgb.importance(model = xgb_final)\n\nimportance_plot <- importance_matrix %>% head(10) %>% mutate(absWeight = abs(Weight)) %>% ggplot(aes(x = reorder(Feature,-absWeight),y = absWeight))+geom_bar(stat = \"identity\",fill = \"light blue\")+theme(\n  axis.text.x = element_text(angle = 45,hjust = 1),\n  plot.title = element_text(hjust = 0.5),\n  panel.background = element_rect(fill = \"ivory\"),\n  panel.grid = element_blank()\n  )+xlab(\"Feature\")+ylab(\"Weight (absolute value)\")+ggtitle(\"Model Feature Importance\")+geom_text(aes(label = round(absWeight,2),vjust = -0.5))+ylim(c(0,8.5))\n\nimportance_plot","metadata":{"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Now with the model in place, we can determine an expected punt result for every punt over the three seasons of data. PYOE is the result of subtracting this expectation from the actual play result. Taking the average PYOE for each punter over the course of a season can reveal which punters consistently exceed expectations. The table below presents the top 10 punter seasons ranked by average PYOE (excluding punters with fewer than 10 punts).","metadata":{}},{"cell_type":"code","source":"### get predictions for all punts set as the expectation\nxgb.all <- xgb.DMatrix(as.matrix(modelpunts[,c(-1,-2,-3)]),label = modelpunts$playResult)\nallpreds <- predict(xgb_final,xgb.all)\nmodelpunts$predPlayResult <- allpreds\n\n### get a new dataframe that has the kicker, season, and play information\nmetricdf <- left_join(modelpunts,punts[,c(\"gameId\",\"playId\",\"kickerId\")])\nmetricdf <- left_join(metricdf,players[,c(\"nflId\",\"displayName\")],by = c(\"kickerId\" = \"nflId\"))\nmetricdf <- left_join(metricdf,games[,c(\"gameId\",\"season\")])\n\n### create analysis tables\nmetricdf <- metricdf %>% mutate(pyoe = playResult - predPlayResult)\navgpyoe_table <- metricdf %>% group_by(displayName,season) %>% summarise(count = n(),avgpyoe = mean(pyoe)) %>% filter(count > 10) %>% arrange(-avgpyoe) %>% rename(\"Punter\" = displayName, \"Season\" = season,\"Num of Punts\" = count,\"Average PYOE\" = avgpyoe) %>% head(10)","metadata":{"_kg_hide-input":true,"_kg_hide-output":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"avgpyoe_table","metadata":{"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The top three punting seasons featured punters who consistently pinned opponents at least two yards beyond expected. When comparing this list to the list of top punters using traditional statistics, pure average punt distance does not exactly add up. Each of the three punters finished outside the top five in average yards. However, all three finished at the top of the league in net yards per punt; Bryan Anger and Logan Cooke tied at 44.5 net yards in the 2019 season while Jake Bailey bested both with a 45.6 net yard average in 2020. Not all the punters in this list rank as highly as these three. Riley Dixon for example falls outside the top 10 in average punt length, however he outperforms his neighbors in net yards per punt. The general aligning of this list of punters and that of players overperforming others in net yardage suggests validity in this method of modeling.\n\nAnother metric we used to evaluate punters leveraging our model was Punt Success Rate (PSR). We define a successful punt as any punt that matched or exceeded the median PYOE which is 1.51. We chose median instead of mean as the measure of center due to the skewed nature of the PYOE distribution. We can then group the punters by season and determine the punters with the highest PSR through the three seasons. The following table displays this data.","metadata":{}},{"cell_type":"code","source":"succ_rate_table <- metricdf %>% mutate(isSuccessful = ifelse(pyoe >= median(metricdf$pyoe),1,0)) %>% group_by(displayName,season) %>% summarise(count = n(),successRate = sum(isSuccessful)/n()) %>% filter(count > 10) %>% arrange(-successRate) %>% rename(\"Punter\" = displayName,\"Season\" = season,\"Num of Punts\" = count,\"Success Rate\" = successRate) %>% head(10)","metadata":{"_kg_hide-input":true,"_kg_hide-output":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"succ_rate_table","metadata":{"_kg_hide-input":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The PSR metric ranks punters in a similar way. Anger and Bailey in their respective seasons once again appear as the top two. However, there is enough of a difference to prove this metric provides an alternative view of punt success. Mitch Wishnowsky’s 2020 season provides an example of a kicker weighed down by negative events. He finished 7th in the list of punters ranked by PSR, but his average PYOE for the season hit only .58. Looking only at his average PYOE would not display Wishnowsky aptitude for successful punts due to outlier punt returns. Cross-referencing these lists can provide insights on various aspects of a punter’s game.\n\nWe believe these metrics could prove useful from both the team and media sides of the league. Teams could use these metrics to evaluate their punter’s performance, allowing for special teams coordinators to make adjustments as needed. PSR takes an easy-to-understand concept, considers many features, and yields a statistic that could be easy to understand for analysts and broadcasters. The measure provides some simplicity in a way that eases accessibility to one of the more obscure parts of the game. We hope that our exploration of punts could impact the NFL and its use of analytics.","metadata":{}}]}