{"cells":[{"metadata":{"_uuid":"ef947b98e2ba71d0cd9c2efdefb0423c5431f85d"},"cell_type":"markdown","source":"# NFL Punt Analytics Competition\n    -By Jeff Saltz and Daniel Saltz\n\n\n# Introduction\nThere are endless possible rule changes that could make NFL punt plays safer. Very few, however, can be practically enforced without undermining the integrity of the game. In this kernel, we analyze punt data from 2016 and 2017, as well as data from the 1970s, to derive specific, and actionable rule changes that the NFL could implement to dramatically decrease concussions.\n\n\n# Summary\nBefore delving into the analysis, we want to state our conclusions at the outset. Afterwards, we will show how we arrived at our findings. Our kernel can be summarized by following points:\n* Returned punts are **8** times more likely to cause a concussion than non returned punts\n* Only **44%** of punts are returned, but those returns account for **86%** of concussions during punt plays\n* Therefore, in order to reduce concussions during punt plays, we have to minimize punt *returns*\n* As we will show in our analysis, the quality of the punt coverage is a huge factor in determining the rate of punt returns\n* Hence, substantially improving the punt coverage defense will reduce concussions\n\n**These findings ultimately lead us to the following two rules changes:**\n1. Fair catches should be incentivized with a 5 yard bonus (Add the rule under Rule 10, Section 2, Article 4)\n2. All members of the punting team should be permitted to cross the line of scrimmage prior to the punt being kicked\n   * To make this rule change, simply eliminate the \"Ineligible Downfield Kick\" penalty\n   * This would revert back to the existing NFL rule before 1974, and would be similar to NCAA rules\n\nHow did we arrive at these findings? First, we tried to determine the key factors that lead to concussions during punt plays.\n\n\n# 1. What is they driver for concussions on punt plays?\n\nAfter extracting how each punt play ended, we were able to compare the rate of concussions for each type of punt play. The results were as follows:"},{"metadata":{"trusted":true,"_uuid":"cbbb5a405594c17560a492a2e7669b30222064c7","_kg_hide-output":true,"_kg_hide-input":true},"cell_type":"code","source":"## Importing packages\nlibrary(tidyverse) # metapackage with lots of helpful functions\n\n# Listing available datasets\nlist.files(path = \"../input\")\n\n################################################################################################\n#   Load punt data, concussion data, and determine the play outcomes and the penalties\n################################################################################################\n\n# Load data from CSVs\npunts <- read.csv(\"../input/NFL-Punt-Analytics-Competition/play_information.csv\")\nconcussion_data <- read.csv(\"../input/NFL-Punt-Analytics-Competition/video_review.csv\")\n\n# Merge punt plays and concussion data\npunts <- merge(x = punts, y = concussion_data, by=c(\"Season_Year\",\"GameKey\",\"PlayID\"), all = TRUE)\npunts$withConcussion <- !is.na(punts$GSISID)\n\n# Temporarily remove any tricky plays - determining the distances on these are difficult]\nremoveWithKeyword <- function(keyword, ignore_case){\n  return(punts[aregexec(keyword,punts$PlayDescription,max.distance=0, ignore.case=ignore_case) < 0,]) \n}\n\n# Manually save the 3 punts that resulted in concussions during \"MUFFS\" or \"No Play\" plays\nhard_coded_punt_outcomes1 <- list(538,29,\"Returned\",51,-16,89,73)\nhard_coded_punt_outcomes2 <- list(1976,231,\"Returned\",58,13,73,86)\nhard_coded_punt_outcomes3 <- list(3312,399,\"Returned\",36,3,44,47)\nhard_coded_punts1 <- punts[punts$PlayID==538 & punts$GameKey==29,]\nhard_coded_punts2 <- punts[punts$PlayID==1976 & punts$GameKey==231,]\nhard_coded_punts3 <- punts[punts$PlayID==3312 & punts$GameKey==399,]\n\n# Remove the tricky plays\npunts <- removeWithKeyword(\"- No Play.\",FALSE);\npunts <- removeWithKeyword(\"MUFFS\",TRUE);\npunts <- removeWithKeyword(\"FUMBLES\",TRUE);\npunts <- removeWithKeyword(\"BLOCKED\",TRUE);\npunts <- removeWithKeyword(\"CHALLENGED\",TRUE);\npunts <- removeWithKeyword(\"got a hand on the punt\",TRUE);\n\ngetPuntYards <- function(playDesc){\n  regex <- regexpr(\"punts \\\\d{1,3} yards? to\", playDesc, perl=FALSE)\n  matched <- regmatches(playDesc, regex);\n  punt_yards = as.integer(regmatches(matched, regexpr(\"\\\\d{1,3}\",matched,perl=TRUE)))\n  return (punt_yards);\n}\n\ngetFairCatchAlternative <- function(play){\n  playDesc <- play$PlayDescription\n  punting_team <- play$Poss_Team\n  regex_to_50 <- regexpr(\"punts \\\\d{1,3} yards? to 50\", playDesc, perl=FALSE)\n  if (regex_to_50[1] > 0){\n    fair_catch_alternative = 50;\n  } else {\n    regex <- regexpr(\"punts \\\\d{1,3} yards? to [A-Z]{2,3} \\\\d{1,3}\", playDesc, perl=FALSE)\n    if (regex[1] < 0){ \"to end zone\"\n      fair_catch_alternative = NA;\n    }\n    else {\n      matched <- regmatches(playDesc, regex);\n      regex <- regexpr(\"to [A-Z]{2,3} \\\\d{1,3}\", playDesc, perl=FALSE)\n      matched <- regmatches(playDesc, regex);\n      field = regmatches(matched, regexpr(\"[A-Z]{2,3}\",matched,perl=TRUE))\n      yard_line = as.integer(regmatches(matched, regexpr(\"\\\\d{1,3}\",matched,perl=TRUE)))\n      fair_catch_alternative = scaleTo100(field,yard_line,punting_team)\n    }\n  }\n  return (fair_catch_alternative);\n}\n\nscaleTo100 <- function(field, yard_line, punting_team){\n  return (if (field == punting_team) yard_line else (100 - yard_line))\n}\n\ngetReturnYards <- function(play, fair_catch_alternative, penalty){\n  playDesc <- as.character(play$PlayDescription)\n  punting_team <- as.character(play$Poss_Team)\n  regex <- regexpr(\"for -?\\\\d{1,3} yards?\", playDesc, perl=TRUE)\n  if (regex[1] < 0){ # \"touchback\", \"downed by\", \"out of bounds\", or a return \"for no gain\"\n    return_yards = 0;\n  } else {\n    matched <- regmatches(playDesc, regex);\n    return_yards = as.integer(regmatches(matched, regexpr(\"-?\\\\d{1,3}\",matched,perl=TRUE)))\n    \n    if (penalty$Has_Penalty){\n      penalized_team <- penalty$Penalized_Team\n      penaltyDesc <- penalty$Penalty_Desc\n      regex <- regexpr(\"\\\\d{1,3} yards?, enforced at\", penaltyDesc, perl=FALSE)\n      matched <- regmatches(penaltyDesc, regex);\n      penalty_yards <- as.integer(regmatches(matched, regexpr(\"\\\\d{1,3}\",matched,perl=TRUE)))\n      enforced_at <- getEnforcedAtYardLine(penaltyDesc,punting_team)\n      \n      if (penalized_team == punting_team){\n        return_yards = return_yards + penalty_yards\n      } else {\n        return_starting_field_position = enforced_at + penalty_yards\n        return_yards = fair_catch_alternative - return_starting_field_position\n      }\n    }\n  }\n  return (return_yards);\n}\n\ngetEnforcedAtYardLine <- function(penaltyDesc, punting_team){\n  if (aregexec(\"enforced at 50\",penaltyDesc,max.distance=0, ignore.case=TRUE) > 0){\n    enforced_at = 50\n  } else {\n    enforced_at_regex = regexpr(\"[A-Z]{2,3} \\\\d{1,3}\", penaltyDesc, perl=FALSE)\n    matched <- regmatches(penaltyDesc, enforced_at_regex);\n    enforced_at_field = regmatches(matched, regexpr(\"[A-Z]{2,3}\",matched,perl=TRUE))\n    enforced_at_yard_line = as.integer(regmatches(matched, regexpr(\"\\\\d{1,3}\",matched,perl=TRUE)))\n    enforced_at = scaleTo100(enforced_at_field,enforced_at_yard_line,punting_team)\n  }\n  return (enforced_at)\n}\n\ngetReturnOutcome <- function(play){\n  possible_outcomes <- c(\"fair catch\",\"out of bounds\",\"downed by\",\"Touchback\")\n  for (outcome in possible_outcomes){\n    if (aregexec(outcome,play,max.distance=0, ignore.case=FALSE) > 0){\n      return (outcome);\n    }\n  }\n  if (regexpr(\"punts \\\\d{1,3} yards? to\", play, perl=FALSE) < 0){\n    return (\"Not Punted\");\n  } else {\n    return (\"Returned\");\n  }\n}\n\ngetReturningTeam <- function(play){\n  punting_team <- as.character(play$Poss_Team)\n  teams <- as.list(strsplit(as.character(play$Home_Team_Visit_Team), \"-\"))[[1]]\n  return (if (punting_team == teams[1]) teams[2] else teams[1])\n}\n\ngetPenalty <- function(play){\n  playDesc <- as.character(play$PlayDescription)\n  punting_team <- as.character(play$Poss_Team)\n  returning_team <- getReturningTeam(play)\n  playID = play$PlayID\n  gameKey = play$GameKey\n  has_penalty = FALSE\n  penalty <- list(playID,gameKey,punting_team,returning_team,has_penalty,NA,NA,NA,NA,NA)\n  penalties <- as.list(strsplit(playDesc, '(?i)Penalty on '))[[1]]\n  \n  if (length(penalties) > 1){\n    for (i in 2:length(penalties)){\n      penaltyDesc <- trimws(penalties[i])\n      if (aregexec(\"offsetting\",penaltyDesc,max.distance=0, ignore.case=TRUE) < 0\n          & aregexec(\"declined\",penaltyDesc,max.distance=0, ignore.case=TRUE) < 0\n          & aregexec(\"enforced between downs\",penaltyDesc,max.distance=0, ignore.case=TRUE) < 0){\n        \n        has_penalty = TRUE\n        penalized_team <- regmatches(penaltyDesc, regexpr(\"[A-Z]{2,3}\",penaltyDesc,perl=FALSE))\n        penalty_yards <- getPenaltyYards(penaltyDesc)\n        enforced_at <- getEnforcedAtYardLine(penaltyDesc,punting_team)\n        penalty_type = getPenaltyType(penaltyDesc)\n        penalty <- list(playID,gameKey,punting_team,returning_team,has_penalty,penaltyDesc,penalized_team,penalty_yards,penalty_type,enforced_at)\n      }\n    }\n  }\n  return (penalty);\n}\n\ngetPenaltyType <- function(penaltyDesc){\n  comma_list <- as.list(strsplit(penaltyDesc, ','))[[1]]\n  penalty_type <- trimws(comma_list[2])\n  return (penalty_type)\n}\n\ngetPenaltyYards <- function(penaltyDesc){\n  regex <- regexpr(\"\\\\d{1,3} yards?, enforced at\", penaltyDesc, perl=FALSE)\n  matched <- regmatches(penaltyDesc, regex);\n  penalty_yards <- as.integer(regmatches(matched, regexpr(\"\\\\d{1,3}\",matched,perl=TRUE)))\n  return (penalty_yards)\n}\n\npunt_outcomes <- data.frame(matrix(ncol = 7, nrow = nrow(punts)))\ncolnames(punt_outcomes) <- c(\"PlayID\", \"GameKey\", \"Outcome\", \"Punt_Yards\", \"Return_Yards\",\n                             \"Return_Yards_To_Go\", \"Fair_Catch_Yards_To_Go\")\n\npenalty_table <- data.frame(matrix(ncol = 10, nrow = nrow(punts)))\ncolnames(penalty_table) <- c(\"PlayID\", \"GameKey\", \"Punting_Team\", \"Returning_Team\", \"Has_Penalty\",\n                             \"Penalty_Desc\", \"Penalized_Team\", \"Penalty_Yards\",\n                             \"Penalty_Type\", \"Enforced_At_Yards_To_Go\")\n\nfor (i in 1:nrow(punts)){\n  playID = punts$PlayID[i];\n  gameKey = punts$GameKey[i];\n  playDesc = as.character(punts$PlayDescription[i]);\n  outcome = getReturnOutcome(playDesc);\n  \n  if (outcome != \"Not Punted\"){\n    play <- punts[i,]\n    punt_yards = getPuntYards(playDesc);\n    penalty_table[i,] <- getPenalty(play)\n    \n    fair_catch_alternative = getFairCatchAlternative(play);\n    return_yards = getReturnYards(play,fair_catch_alternative,penalty_table[i,]);\n    return_starting_field = fair_catch_alternative - return_yards;\n    punt_outcomes[i,] <- list(playID,gameKey,outcome,punt_yards,return_yards,return_starting_field,fair_catch_alternative)\n  } \n  else {\n    punt_outcomes[i,] <- list(playID,gameKey,outcome,NA,NA,NA,NA)\n    penalty_table[i,] <- list(playID,gameKey,NA,NA,NA,NA,NA,NA,NA,NA)\n  }\n}\n\n# Add back the 3 manual punt returns that we saved at the beginning\npunt_outcomes[i+1,] <- hard_coded_punt_outcomes1\npunt_outcomes[i+2,] <- hard_coded_punt_outcomes2\npunt_outcomes[i+3,] <- hard_coded_punt_outcomes3\npunts[i+1,] <- hard_coded_punts1\npunts[i+2,] <- hard_coded_punts2\npunts[i+3,] <- hard_coded_punts3\npenalty_table[i+1,] <- list(punts[i+1,]$PlayID,punts[i+1,]$GameKey,\"NYJ\",\"WAS\",FALSE,NA,NA,NA,NA,NA)\npenalty_table[i+2,] <- list(punts[i+2,]$PlayID,punts[i+2,]$GameKey,\"CIN\",\"BLT\",FALSE,NA,NA,NA,NA,NA)\npenalty_table[i+3,] <- list(punts[i+3,]$PlayID,punts[i+3,]$GameKey,\"KC\",\"NE\",FALSE,NA,NA,NA,NA,NA)\n\n# Merge punt plays data with punt outcomes and penalty outcomes\npunts <- merge(x = punts, y = punt_outcomes, by=c(\"GameKey\",\"PlayID\"), all = TRUE)\npunts <- merge(x = punts, y = penalty_table, by=c(\"GameKey\",\"PlayID\"), all = TRUE)\n\n# Purge plays that were not punted\npunts <- punts[punts$Outcome != \"Not Punted\",]          \n\n# Create play_result field for convenience\npunts$play_result <- punts$Outcome","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"c3384271551587fd8aed4b3dd248d693a7b785be"},"cell_type":"code","source":"# Get the likelihood of a concussion for each outcome of a punt play\ntouchback = sum(punts$play_result==\"Touchback\")\nout_of_bounds = sum(punts$play_result==\"out of bounds\")\ndowned_by = sum(punts$play_result==\"downed by\")\nfair_catch = sum(punts$play_result==\"fair catch\")\nreturned = sum(punts$play_result==\"Returned\")\ntotal = touchback+out_of_bounds+downed_by+fair_catch+returned\nnon_returned = total - returned\n          \ntouchback_conc = sum(punts$play_result == \"touchback\" & !is.na(punts$GSISID))\nout_of_bounds_conc = sum(punts$play_result==\"out of bounds\" & !is.na(punts$GSISID))\ndowned_by_conc = sum(punts$play_result==\"downed by\" & !is.na(punts$GSISID))\nfair_catch_conc = sum(punts$play_result==\"fair catch\" & !is.na(punts$GSISID))\nreturned_conc = sum(punts$play_result==\"Returned\" & !is.na(punts$GSISID))\ntotal_conc = touchback_conc+out_of_bounds_conc+downed_by_conc+fair_catch_conc+returned_conc\nnon_returned_conc = total_conc - returned_conc\n\ncat(\"% of Concussions during 'touchbacks': \", round(100*touchback_conc/touchback,3))\ncat(\"\\n% of Concussions during 'out of bounds': \", round(100*out_of_bounds_conc/out_of_bounds,3))\ncat(\"\\n% of Concussions during 'downed by': \", round(100*downed_by_conc/downed_by,3))\ncat(\"\\n% of Concussions during 'fair catch': \", round(100*fair_catch_conc/fair_catch,3))\ncat(\"\\n% of Concussions during 'returned': \", round(100*returned_conc/returned,3))\ncat(\"\\n% of Concussions during non returned plays: \", round(100*non_returned_conc/non_returned,3))\ncat(paste0(\"\\nReturns are \", round((returned_conc/returned)/(non_returned_conc/non_returned),3), \" times more likely to cause concussions than non returns\"))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"9f10081e1c3de30faee2e184d174ae862acb26e9"},"cell_type":"markdown","source":"Punt returns are **8** times more likely to cause concussions than non returns. That is a drastic difference that should be heavily analyzed."},{"metadata":{"trusted":true,"_uuid":"fb15a3cd37008b4ba27afde49a0331505dd96b12","_kg_hide-input":true},"cell_type":"code","source":"totalConc <- c(touchback_conc, out_of_bounds_conc, downed_by_conc, fair_catch_conc, returned_conc)\ntotals <- c(touchback, out_of_bounds, downed_by, fair_catch, returned)\ntotalConc <- c(touchback_conc, out_of_bounds_conc, downed_by_conc, fair_catch_conc, returned_conc)\ntype <- c(\"touchback\", \"out_of_bounds\", \"downed_by\", \"fair_catch\", \"returned\")\n\npercentOfConc <- round(100*totalConc/sum(totalConc), 2)\nnoConc <- totals - totalConc\nnumPlays <- c(totalConc, noConc)\n\npercentConc <- c( \n  if (touchback_conc == 0) 0.00000 else round(100*touchback_conc/touchback,2),\n  if (out_of_bounds_conc == 0) 0.00000 else round(100*out_of_bounds_conc/out_of_bounds,2),\n  if (downed_by_conc == 0) 0.00000 else round(100*downed_by_conc/downed_by,2),\n  if (fair_catch_conc == 0) 0.00000 else round(100*fair_catch_conc/fair_catch,2),\n  if (returned_conc == 0) 0.00000 else round(100*returned_conc/returned,2)\n)\n\npercentPlay <- c( \n  round(100*touchback/total,2), \n  round(100*out_of_bounds/total,2),\n  round(100*downed_by/total,2), \n  round(100*fair_catch/total,2), \n  round(100*returned/total,2)\n)\n      \npercentPlays <- c(percentConc/sum(percentConc), percentPlay/sum(percentPlay))\npercentOfConc <- round(100*totalConc/sum(totalConc), 2)\nPunt_Plays <- c(\"Touchback\", \"Out of Bounds\", \"Downed\", \"Fair Catch\", \"Returned\")\ndfSummary <- data.frame(totals, totalConc, Punt_Plays, percentPlay, percentConc, percentOfConc)\ndfSummary$NumberOfPlays <- dfSummary$totals\n    \nhjustV <- c(0.18, 0.18, 0.18, 0.18, 0.8)\nvjustV <- c(1.5, -1.3, -1.1, -1.1, 1.8)\noptions(repr.plot.width=5.5, repr.plot.height=4.5)\nggplot(dfSummary, aes(y = percentConc, x = percentPlay, group=Punt_Plays,color=Punt_Plays, size = NumberOfPlays)) + \n  geom_point() + geom_text(size=3.5, aes(label=Punt_Plays),hjust=hjustV, vjust=vjustV) + theme(text = element_text(size=10)) +\n  labs(y=\"Percentage of Concussions by Play Type\", x=\"Percentage of All Plays\",\n      color=\"Play Type\", size=\"Number of Plays\") +\n  ylim(0, 1.2) + xlim(0,50)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"2400138bb4dec2cb1cdb6e920d83e902702d5156"},"cell_type":"markdown","source":"In addition, punt returns account for **44%** of punt plays, but cause **86%** of punt-related concussions. "},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"880bb0886a3289387b3930ccc3aade70a9e3199e"},"cell_type":"code","source":"percentOfConc <- round(100*totalConc/sum(totalConc), 2)\nPunt_Plays <- c(\"Touchback\", \"Out of Bounds\", \"Downed\", \"Fair Catch\", \"Returned\")\ndfSummary <- data.frame(totals, totalConc, Punt_Plays, percentPlay, percentConc, percentOfConc)\ndfSummary$NumberOfPlays <- dfSummary$totals\nhjustV <- c(0.18, 0.18, 0.18, 0.18, 0.8)\nvjustV <- c(1.5, -1.3, -1.1, -1.1, 1.8)\noptions(repr.plot.width=5.5, repr.plot.height=4.5)\nggplot(dfSummary, aes(y = percentOfConc, x = percentPlay, group=Punt_Plays,color=Punt_Plays, size = NumberOfPlays)) + \n  geom_point() + geom_text(size=3, aes(label=Punt_Plays),hjust=hjustV, vjust=vjustV) +\n  labs(y=\"Percentage of Punt-Related Concusions\", x=\"Percentage of Punt Plays\",\n  size=\"Number of Plays\", color=\"Play Type\") + theme(text = element_text(size=10))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"c3ea01135bc9c68dcc5e369c7d185afa128f0a2f"},"cell_type":"markdown","source":"These two statistics combined tell us that punt returns are extremely dangerous, especially compared to all other punt plays. \n\n ### **This means that in order to decrease concussions, punt returns should be minimized.**\n\n\n\n\n# 2. What is the best way to minimize punt returns?\n\nWe are only considering rule changes that wouldn't undermine the integrity of the game. For example, simply abolishing punt returns altogether is not an actionable rule suggestion. Would teams be forced to go for it on every 4th down? This type of rule suggestion would overhaul the integrity.\n \nHowever, what if teams *chose* to go for it more on 4th down, rather than punting? What if teams *chose* to bypass punt returns more frequently? The question becomes, what type of incentive or situation would lead teams to make those decisions?  There's a few ways to do this. We can either make punt returns so difficult that teams are no longer gaining positive yardage, or we can make the alternatives to punt returns more attractive. We will address both of these strategies.\n\nThe alternatives to returning a punt are letting the ball bounce and be downed by the punting team, letting the ball go out of bounds, attempting to let the ball roll for a touchback, and making a fair catch. We want to change the incentives such that returners will choose non return options. Punts that are headed out of bounds aren't able to be returned. Punts that result in touchbacks are seldom returned, as a touchback is usually a better outcome than a punt return. Fair catches on the other hand, are primed for a rule change. Even with only a few yards of separation between the punt returner and the oncoming defenders, returners aren't incentivized to make a fair catch. But changing the rules could tilt the incentives in favor of a fair catch. We propose instituting a 5 yard bonus for every fair catch. After this rule change, a punt returner knows that he should only return the punt if he can gain more than 5 yards. Otherwise, he risks losing yardage relative to the free 5 yard fair catch bonus, plus he takes on the additional risk of fumbling the football. **The effect of a 5 yard fair catch bonus would be significant, as 45% of punt returns go for under 5 net yards (after factoring in penalties).** "},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"1294c23cc74546a3427f37adc932717ce0af3cc3"},"cell_type":"code","source":"tmpPunts <- punts[punts$play_result == \"Returned\",]\npercentReturnedAbove <- c(replicate(50, 0))\npercentYards <- c(replicate(50, 0))\n\nfor (i in 1:50){\n  percentReturnedAbove[i] <- nrow(tmpPunts[tmpPunts$Return_Yards > i*2,])/nrow(tmpPunts) * 100\n  percentYards[i] <- i*2\n}\n\ndfTmp <- data.frame(percentYards, percentYards)\n\npercentOfReturns <- c(1:999)/1000\nreturnYards <- quantile(tmpPunts$Return_Yards, percentOfReturns)\ndfTmp <- data.frame(returnYards, percentOfReturns)\n\nreturnYardsV <- 5\npercentBetterThan <- round(100-nrow(tmpPunts[tmpPunts$Return_Yards > returnYardsV,])/nrow(tmpPunts) * 100)\npercentValues <- 0.45\npointLabels <- \"5 yards is more than\\n 45% of all punt returns\"\ndfTmp1 <- data.frame(returnYardsV, percentValues, pointLabels)\n\noptions(repr.plot.width=5, repr.plot.height=4.5)\nggplot(dfTmp1, aes(y=returnYardsV, x=percentValues)) + \n  geom_text(data=dfTmp1, size=3.5, aes(label=pointLabels),vjust=1.75)  + \n  geom_point(data= dfTmp1, y=returnYardsV, x = percentValues, size=4) + \n  stat_smooth(data=dfTmp, aes(x = percentOfReturns , y = returnYards), method = \"lm\",\n              formula = y ~ poly(x, 10), se = FALSE) +\n  ylab(\"Net Return Yards\") + xlab(\"Percent of Punt Returns\") + theme(text = element_text(size=12)) +\n  ggtitle(\"Tracking the Length of Punt Returns\") + theme(plot.title = element_text(hjust = 0.5))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"f3fa24f4f0616479c1c00c2a2007fb03f532e9fb"},"cell_type":"markdown","source":"In addition to making fair catches more desirable than punt returns, we want to make punt returns more difficult so that returners think twice before bypassing the fair catch bonus. To do this, we looked at the player role data in order to gain insights from punt formations. Did certain punt coverages lead to more concussions than others? \n\nThere appears to be a reduction in concussions from havings single coverage on gunners rather than double coverage. This makes sense, becuase single covered gunners are able to get downfield quicker, forcing punt returners into making fair catches more often. When a gunner is double covered, the punt returner has more time to return the punt. The increased rate of punt returns is what causes the large majority of punt-related concussions.\n\nTherefore, one possible rule change would be to mandate single coverage on gunners. That seems simple enough, except there are a few factors that make this rule change suggestion less than ideal. First, it is not entirely clear how to prohibit double coverage on gunners. You can prohibit two defenders from standing across a gunner at the line of scrimmage, but what if one defender stays at the line of scrimmage while another waits 20 yards downfield? Enforcing such a rule would be difficult and would require additional rule changes for the rule to be enforceable. Second of all, simply comparing single vs double coverage might be misleading. Single coverage could be an indication that the punt return team is trying to set up a punt block. In other words, single vs. double coverage does not indicate whether the return team is setting up a return or a punt block. And finally, single vs. double coverage on gunners does not solve the main problem. As shown in the chart below, the vast majority of punt returns already occur with single coverage on a gunner. Therefore, we need more drastic measures in order to improve punt coverage well enough to deter a larger percentage of punt returns. "},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":false,"trusted":true,"_uuid":"c6b173d358595d5cfc2922b94b4a1778fe757516"},"cell_type":"code","source":"\nplayerRole_data <- read.csv(\"../input/NFL-Punt-Analytics-Competition/play_player_role_data.csv\")\n\nrole.vr <- playerRole_data[playerRole_data$Role == 'VR', ]\nrole.vr$singleLeftGunner <- TRUE\nrole.vr$Role <- NULL\n\nrole.vl <- playerRole_data[playerRole_data$Role == 'VL', ]\nrole.vl$singleRightGunner <- TRUE\nrole.vl$Role <- NULL\n\npunts1 <- merge(x = punts, y = role.vl, by=c(\"Season_Year\",\"GameKey\",\"PlayID\"), all.x = TRUE)\npunts2 <- merge(x = punts1, y = role.vr, by=c(\"Season_Year\",\"GameKey\",\"PlayID\"), all = TRUE)\npunts2 <- punts2[!is.na(punts2$withConcussion),]\n\n####################\n#plays with single, double or bybrid coverage\n##################\npunts2$singleCoverage <- !is.na(punts2$singleLeftGunner) & !is.na(punts2$singleRightGunner)\npunts2$doubleCoverage <- is.na(punts2$singleLeftGunner) & is.na(punts2$singleRightGunner)\npunts2$hybridCoverage <- (!punts2$singleCoverage & !punts2$doubleCoverage)\n\npunts2$coverageType <- \"Hybrid\"\npunts2$coverageType[punts2$doubleCoverage == TRUE] <- \"Double\"\npunts2$coverageType[punts2$singleCoverage == TRUE] <- \"Single\"\n\npunts <- punts2\n\n###########\n#get punting yard line position#\n###########\npunts$YardLine <- as.character(punts$YardLine)\nteam <- trimws(substring(punts$YardLine, 1, 3))\ntmp <- trimws(substring(punts$YardLine, 4))\npunts$puntingPosition <- as.integer(tmp)\n\npunts$amountToAdd <- 50 - punts$puntingPosition\npunts$amountToAdd [team == punts$Punting_Team] <- 0\npunts$puntingPosition <- punts$puntingPosition + punts$amountToAdd*2\npunts$amountToAdd <- NULL\n\n#look at punts that are \"full distance\"\npunts.long <- punts[punts$puntingPosition < 35,]\n\npunts.long.single <- punts.long[punts.long$singleCoverage == TRUE,]\npunts.long.double <- punts.long[punts.long$doubleCoverage == TRUE,]\n\n#see concussions on both\np1 <- sum(punts.long.single$withConcussion)/nrow(punts.long.single)*100\np2 <- sum(punts.long.double$withConcussion)/nrow(punts.long.double)*100\n\n#cat(\"Percent of plays with concussions, punting 'normal/long' inside the team's 30 yard line, single coverage\", p1, \"\\n\")\n#cat(\"Percent of plays with concussions, punting 'normal/long' inside the team's 30 yard line, double coverage\", p2,\"\\n\")\n\npunts.middle <- punts[punts$puntingPosition < 51,]\npunts.middle <- punts.middle[punts.middle$puntingPosition > 34,]\npunts.middle.single <- punts.middle[punts.middle$singleCoverage == TRUE,]\npunts.middle.double <- punts.middle[punts.middle$doubleCoverage == TRUE,]\n\n#look at punts that are not \"full distance\"\npunts.short <- punts[punts$puntingPosition > 50,]\n\npunts.short.single <- punts.short[punts.short$singleCoverage == TRUE,]\npunts.short.double <- punts.short[punts.short$doubleCoverage == TRUE,]\n\n#see concussions on both\np1 <- sum(punts.short.single$withConcussion)/nrow(punts.short.single)*100\np2 <- sum(punts.short.double$withConcussion)/nrow(punts.short.double)*100\n\n#cat(\"Percent of plays with concussions, punting 'shorter punts' outside the team's 40 yard line, single coverage\", p1, \"\\n\")\n#cat(\"Percent of plays with concussions, punting 'shorter punts' outside the team's 40 yard line, double coverage\", p2, \"\\n\")\n\npunts.full <- punts\n\ngetPercentOfPlays <- function(punts) {\n  touchback = sum(punts$play_result==\"Touchback\")\n  out_of_bounds = sum(punts$play_result==\"out of bounds\")\n  downed_by = sum(punts$play_result==\"downed by\")\n  fair_catch = sum(punts$play_result==\"fair catch\")\n  returned = sum(punts$play_result==\"Returned\")\n  total = touchback+out_of_bounds+downed_by+fair_catch+returned\n  v <- c(0,0,0,0,0,0)\n  \n  v[1] <- round(touchback/total*100,2)\n  v[2] <- round(out_of_bounds/total*100,2)\n  v[3] <- round(downed_by/total*100,2)\n  v[4] <- round(fair_catch/total*100,2)\n  v[5] <- round(returned/total*100,2)\n  v[6] <- 100\n  \n  return( v )\n}\n\ngetPercentConc <- function(punts) {\n  touchback = sum(punts$play_result==\"Touchback\")\n  out_of_bounds = sum(punts$play_result==\"out of bounds\")\n  downed_by = sum(punts$play_result==\"downed by\")\n  fair_catch = sum(punts$play_result==\"fair catch\")\n  returned = sum(punts$play_result==\"Returned\")\n  total = touchback+out_of_bounds+downed_by+fair_catch+returned\n  \n  touchback_conc = sum(punts$play_result == \"touchback\" & punts$withConcussion)\n  out_of_bounds_conc = sum(punts$play_result==\"out of bounds\" & punts$withConcussion)\n  downed_by_conc = sum(punts$play_result==\"downed by\" & punts$withConcussion)\n  fair_catch_conc = sum(punts$play_result==\"fair catch\" & punts$withConcussion)\n  returned_conc = sum(punts$play_result==\"Returned\" & punts$withConcussion)\n  total_conc = touchback_conc+out_of_bounds_conc+downed_by_conc+fair_catch_conc+returned_conc\n  \n  v <- c(0,0,0,0,0,0)\n  \n  if (touchback_conc == 0) v[1] <- 0 else v[1] <- round(touchback_conc/touchback*100,2)\n  if (out_of_bounds_conc == 0) v[2] <- 0 else v[2] <- round(out_of_bounds_conc/out_of_bounds*100,2)\n  if (downed_by_conc == 0) v[3] <- 0 else v[3] <- round(downed_by_conc/downed_by*100,2)\n  if (fair_catch_conc == 0) v[4] <- 0 else v[4] <- round(fair_catch_conc/fair_catch*100,2)\n  if (returned_conc == 0) v[5] <- 0 else v[5] <- round(returned_conc/returned*100,2)\n  if (total_conc == 0) v[6] else v[6] <- round(total_conc/total*100,2)\n  \n  return( v )\n}\n\ngetConc <- function(punts) {\n  touchback_conc = sum(punts$play_result == \"touchback\" & punts$withConcussion)\n  out_of_bounds_conc = sum(punts$play_result==\"out of bounds\" & punts$withConcussion)\n  downed_by_conc = sum(punts$play_result==\"downed by\" & punts$withConcussion)\n  fair_catch_conc = sum(punts$play_result==\"fair catch\" & punts$withConcussion)\n  returned_conc = sum(punts$play_result==\"Returned\" & punts$withConcussion)\n  total_conc = touchback_conc+out_of_bounds_conc+downed_by_conc+fair_catch_conc+returned_conc\n  v1 <- c(touchback_conc, out_of_bounds_conc, downed_by_conc, fair_catch_conc, returned_conc, total_conc)\n  return( v1 )\n}\n\nconc.short.double <- getPercentOfPlays(punts.short.double)\nconc.short.single <- getPercentOfPlays(punts.short.single)\nconc.middle.double <- getPercentOfPlays(punts.middle.double)\nconc.middle.single <- getPercentOfPlays(punts.middle.single)\n\nconc.long.double <- getPercentOfPlays(punts.long.double)\nconc.long.single <- getPercentOfPlays(punts.long.single)\ntypeOfPlays1 <- c(\"Touchback\", \"Out of Bounds\", \"Downed\", \"Fair Catch\", \"Returned\", \"All (Overall)\")\ndfPercent <- data.frame(conc.long.double, conc.middle.double, conc.short.double, conc.short.single, conc.middle.single, conc.long.single, typeOfPlays1)\n\nconc.short.double <- getPercentConc(punts.short.double)\nconc.short.single <- getPercentConc(punts.short.single)\nconc.middle.double <- getPercentConc(punts.middle.double)\nconc.middle.single <- getPercentConc(punts.middle.single)\n\nconc.long.double <- getPercentConc(punts.long.double)\nconc.long.single <- getPercentConc(punts.long.single)\ntypeOfPlays1 <- c(\"Touchback\", \"Out of Bounds\", \"Downed\", \"Fair Catch\", \"Returned\", \"All (Overall)\")\ndfConcPercent <- data.frame(conc.long.double, conc.middle.double, conc.short.double, conc.short.single, conc.middle.single, conc.long.single, typeOfPlays1)\n\nconc.short.double <- getConc(punts.short.double)\nconc.short.single <- getConc(punts.short.single)\nconc.middle.double <- getConc(punts.middle.double)\nconc.middle.single <- getConc(punts.middle.single)\nconc.long.double <- getConc(punts.long.double)\nconc.long.single <- getConc(punts.long.single)\ntypeOfPlays1 <- c(\"Touchback\", \"Out of Bounds\", \"Downed\", \"Fair Catch\", \"Returned\", \"All (Overall)\")\ndfConc <- data.frame(conc.long.double, conc.middle.double, conc.short.double, conc.short.single, conc.middle.single, conc.long.single, typeOfPlays1)\n\nt <- paste0(\"percent long: \", round(nrow(punts.long)/nrow(punts)*100, 2), \n    \"  percent middle: \", round(nrow(punts.middle)/nrow(punts)*100, 2), \n    \"  percent short: \",  round(nrow(punts.short)/nrow(punts)*100, 2), \"\\n\")\n\npercent <- c(dfPercent$conc.long.double[1:5], dfPercent$conc.middle.double[1:5],dfPercent$conc.short.double[1:5],\n             dfPercent$conc.long.single[1:5], dfPercent$conc.middle.single[1:5],dfPercent$conc.short.single[1:5])\ntypeOfKick <- c(replicate(5, \"long\"), replicate(5, \"middle\"),replicate(5, \"short\"),\n                replicate(5, \"long\"), replicate(5, \"middle\"),replicate(5, \"short\"))\npuntPlays <- c(\"Touchback\", \"Out of Bounds\", \"Downed\", \"Fair Catch\", \"Returned\")\ntypeOfPlays <- c(puntPlays, puntPlays)\ntypeOfPlay <- c(typeOfPlays, typeOfPlays, typeOfPlays)\n\ndfPercent1 <- data.frame(percent, typeOfKick, typeOfPlay)\n#ggplot(dfPercent1, aes(x=typeOfPlay, y=percent, fill=typeOfKick)) + \n#  geom_col(position=\"dodge\", width=0.4) +\n#  scale_fill_manual(values=c(\"darkgrey\",\"lightgreen\", \"darkgreen\")) +  \n#  ylab(\"Percentage of Punts\") + xlab(\"Type of Punt Play\") + theme(text = element_text(size=20))\n#+ ggtitle(\"Expected Impact of New Rules on Types of Punt Returns\")  \n\nsingleDf <- punts[punts$singleCoverage==TRUE,]\ndoubleDf <- punts[punts$doubleCoverage==TRUE,]\n\nsingleDf.short <- singleDf[singleDf$puntingPosition > 50,]\nsingleDf.long <- singleDf[singleDf$puntingPosition > 34,]\nsingleDf.middle <- singleDf[singleDf$puntingPosition < 51,]\nsingleDf.middle <- singleDf[singleDf.middle$puntingPosition > 34,]\n\ndoubleDf.short <- doubleDf[doubleDf$puntingPosition > 50,]\ndoubleDf.long <- doubleDf[doubleDf$puntingPosition > 34,]\ndoubleDf.middle <- doubleDf[doubleDf$puntingPosition < 51,]\ndoubleDf.middle <- doubleDf[doubleDf.middle$puntingPosition > 34,]\n\ncoveragePercent <- c(nrow(doubleDf.long), nrow(doubleDf.middle), nrow(doubleDf.short),\n                     nrow(singleDf.long), nrow(singleDf.middle), nrow(singleDf.short))\n\ntypeOfCoverage <- c(replicate(3, \"double\"), replicate(3, \"single\")) \n\ntypeOfKick <- c(\"short\", \"middle\", \"long\", \"short\", \"middle\", \"long\") \ntypeOfKick <- c(\"Inside the 35\", \"35 to 50\", \"Beyond the 50\", \"Inside the 35\", \"35 to 50\", \"Beyond the 50\")\ntypeOfKick <- factor(typeOfKick, levels = c(\"Inside the 35\", \"35 to 50\", \"Beyond the 50\"))\n\ndfPercent2 <- data.frame(coveragePercent, typeOfKick,  typeOfCoverage)\n\noptions(repr.plot.width=7, repr.plot.height=5)\nggplot(dfPercent2, aes(x=typeOfCoverage, y=coveragePercent, fill=typeOfKick)) + \n  geom_col(position=\"dodge\", width=0.4) +\n  scale_fill_manual(values=c(\"darkgrey\",\"lightgreen\", \"darkgreen\")) +  \n  labs(fill=\"Line of Scrimage\") + \n  labs(y=\"Number of Punt Plays\",x=\"Type of Punt Coverage\",\n      title=\"The Vast Majority of Coverages are Already Single\") +\n  theme(text = element_text(size=10), plot.title = element_text(hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":false,"trusted":true,"_uuid":"a30353a3594d03ee928562b6a6723f5c204489df","_kg_hide-output":false},"cell_type":"markdown","source":"Up until 1973, the NFL did not have a problem of having too many punt returns. In fact, they had they opposite problem. The rules were different back then. Today, only the 2 gunners are allowed to cross the line of scrimmage before the ball is punted. Back then, every member of the punting team was eligible to run downfield to cover the punt as soon as the ball was snapped. The punt covererage was so good, and punt returns were so difficult, that in 1974 the NFL changed these rules in order to increase punt return opportuniites and add excitement. Analyzing punt return data from 1971-1976 (3 years before and after the rule change), we can see a huge jump in the number of punts that were returned and the average yards gained per return. "},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":false,"trusted":true,"_uuid":"a697b71def85299baa1ac9e521fa2f955c45eae7"},"cell_type":"code","source":"# Reference for historical punt returns: https://www.pro-football-reference.com/years/1975/returns.htm\nreturns_1971 <- read.csv(\"../input/historical-punt-return-data/1971_Returns.csv\")\nreturns_1972 <- read.csv(\"../input/historical-punt-return-data/1972_Returns.csv\")\nreturns_1973 <- read.csv(\"../input/historical-punt-return-data/1973_Returns.csv\")\nreturns_1974 <- read.csv(\"../input/historical-punt-return-data/1974_Returns.csv\")\nreturns_1975 <- read.csv(\"../input/historical-punt-return-data/1975_Returns.csv\")\nreturns_1976 <- read.csv(\"../input/historical-punt-return-data/1976_Returns.csv\")\n\n# Clean up 70's punt return data\nreturns_1971 <- returns_1971[!is.na(returns_1971$Ret),]\nreturns_1972 <- returns_1972[!is.na(returns_1972$Ret),]\nreturns_1973 <- returns_1973[!is.na(returns_1973$Ret),]\nreturns_1974 <- returns_1974[!is.na(returns_1974$Ret),]\nreturns_1975 <- returns_1975[!is.na(returns_1975$Ret),]\nreturns_1976 <- returns_1976[!is.na(returns_1976$Ret),]\n\n# Get average return from the 70's\nattempts_1971 <- sum(returns_1971$Ret)\nattempts_1972 <- sum(returns_1972$Ret)\nattempts_1973 <- sum(returns_1973$Ret)\nattempts_1974 <- sum(returns_1974$Ret)\nattempts_1975 <- sum(returns_1975$Ret)\nattempts_1976 <- sum(returns_1976$Ret)\n\nreturn_yards_1971 <- sum(returns_1971$Yds)\nreturn_yards_1972 <- sum(returns_1972$Yds)\nreturn_yards_1973 <- sum(returns_1973$Yds)\nreturn_yards_1974 <- sum(returns_1974$Yds)\nreturn_yards_1975 <- sum(returns_1975$Yds)\nreturn_yards_1976 <- sum(returns_1976$Yds)\n\nave_return_1971 <- round(return_yards_1971/attempts_1971,2)\nave_return_1972 <- round(return_yards_1972/attempts_1972,2)\nave_return_1973 <- round(return_yards_1973/attempts_1973,2)\nave_return_1974 <- round(return_yards_1974/attempts_1974,2)\nave_return_1975 <- round(return_yards_1975/attempts_1975,2)\nave_return_1976 <- round(return_yards_1976/attempts_1976,2)\n\n# Years before rule changes vs. 3 years after\nattempts_three_yrs_before <- attempts_1971 + attempts_1972 + attempts_1973\nattempts_three_yrs_after <- attempts_1974 + attempts_1975 + attempts_1976\nyards_three_yrs_before <- return_yards_1971 + return_yards_1972 + return_yards_1973\nyards_three_yrs_after <- return_yards_1974 + return_yards_1975 + return_yards_1976\nave_three_yrs_before <- yards_three_yrs_before/attempts_three_yrs_before\nave_three_yrs_after <- yards_three_yrs_after/attempts_three_yrs_after\ncat(\"Ave returns/year from 1971-1973: \", round(attempts_three_yrs_before/3))\ncat(\"\\nAve returns/year from 1974-1976: \", round(attempts_three_yrs_after/3))\ncat(\"\\nAve punt return from 1971-1973: \", round(ave_three_yrs_before,2))\ncat(\"\\nAve punt return from 1974-1976: \", round(ave_three_yrs_after,2))\n\n# Percent increase in number of returns and ave return\npercent_inc_in_returns <- 1- round(attempts_three_yrs_before/attempts_three_yrs_after,5)\npercent_inc_in_ave_return <- 1- round(ave_three_yrs_before/ave_three_yrs_after,5)\ncat(\"\\nPercent increase in the number of returns/year: \", percent_inc_in_returns)\ncat(\"\\nPercent increase in average return yards: \", percent_inc_in_ave_return)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"56227918083a556386f123b3997872cafb462913"},"cell_type":"markdown","source":"Average punt return yardage increased by **20%** (roughly 2 yards), and the number of punt returns per year increased by **30%**.  Allowing all players on the coverage team to defend the punt return will have a much more significant impact than mandating single coverage on gunners. Additionally, we know that such a rule change is very much \"in the spirit of the game\", since it was an NFL rule until 1974 and still is a rule in college football. \n\n\n\n# 3. How many fewer punt returns will there be?\n\n\nWe've discussed a few different factors that would lead to a decrease in the number of punt returns. The first is the 5 yard fair catch bonus. As previously mentioned, 45% of punt returns go for less than 5 yards. This 45% reduction could be spread out in any number of ways, but we believe in the following logic:\n* Fair catches will increase becuase receiving teams will want the 5 yard fair catch bonus\n* Punts out of bounds will increase because punting teams will want to avoid fair catches, especially near the goal line where they won't lose much yardage on a \"coffin corner\" punt\n* Downed punts will increase if punters react to the rule change and try to \"squib\" the ball in an attempt to avoid a fair catch\n* Touchbacks will largely remain the same\n* Teams will go for it more on 4th down, since it will be harder to pin the returning team deep in their own territory\n\nThe punt formation change (rule change 2) will both decrease the average yards earned per punt return, and it will also reduce the overall number of punt returns. When the NFL initially changed the punt formation rules in 1974, average punt returns increased by 20% (2 yards), and the overall number of punt returns decreased by 30%. Given the huge advancement in punt coverage, both of these statistics make intuitive sense. We will use them as guidelines for what would happen if the the 1974 rule is reversed and our rule change is accepted.\n\nCombining the two rules together:\n* We estimate that the average punt return from 2016-2017 would have to go for more than 7 yards for it to be returned (5 yards from the fair catch bonus, plus 2 yards from the enhanced punt coverage)\n* **55%** of punt returns from 2016 and 2017 went for less than 7 yards, and that is the percent decrease in punt returns that we will use in our analysis."},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"78849816eee9e61f7d86655908051c68fa6a3791"},"cell_type":"code","source":"tmpPunts <- punts[punts$play_result == \"Returned\",]\npercentReturnedAbove <- c(replicate(50, 0))\npercentYards <- c(replicate(50, 0))\n\nfor (i in 1:50){\n  percentReturnedAbove[i] <- nrow(tmpPunts[tmpPunts$Return_Yards > i*2,])/nrow(tmpPunts) * 100\n  percentYards[i] <- i*2\n}\n\ndfTmp <- data.frame(percentYards, percentYards)\n\npercentOfReturns <- c(1:999)/1000\nreturnYards <- quantile(tmpPunts$Return_Yards, percentOfReturns)\ndfTmp <- data.frame(returnYards, percentOfReturns)\n\nreturnYardsV <- 7\npercentBetterThan <- round(100-nrow(tmpPunts[tmpPunts$Return_Yards > returnYardsV,])/nrow(tmpPunts) * 100)\npercentValues <- 0.55\npointLabels <- \"7 yards is more than\\n 55% of all punt returns\"\ndfTmp1 <- data.frame(returnYardsV, percentValues, pointLabels)\n\noptions(repr.plot.width=5, repr.plot.height=4.5)\nggplot(dfTmp1, aes(y=returnYardsV, x=percentValues)) + \n  geom_text(data=dfTmp1, size=3.5, aes(label=pointLabels),vjust=1.75)  + \n  geom_point(data= dfTmp1, y=returnYardsV, x = percentValues, size=4) + \n  stat_smooth(data=dfTmp, aes(x = percentOfReturns , y = returnYards), method = \"lm\",\n              formula = y ~ poly(x, 10), se = FALSE) +\n  ylab(\"Net Return Yards\") + xlab(\"Percent of Punt Returns\") + theme(text = element_text(size=12)) +\n  ggtitle(\"Tracking the Length of Punt Returns\") + theme(plot.title = element_text(hjust = 0.5))\n\n# Draw chart showing new breakdown of each type of punt play\n#55% scenario\nnewPercentPlay.touchback <- 8\nnewPercentPlay.out_of_bounds <- 16\nnewPercentPlay.downed_by <- 18\nnewPercentPlay.fair_catch <- 100-20-18-16-8\nnewPercentPlay.returned <- 20\n\nnewPercentPlay <- c(\n  newPercentPlay.touchback,\n  newPercentPlay.out_of_bounds,\n  newPercentPlay.downed_by,\n  newPercentPlay.fair_catch,\n  newPercentPlay.returned)\n\npercentOfPlays <- c(percentPlay, newPercentPlay)\nrules <- c(replicate(5, \"Old Rules\"), replicate(5, \"New Rules\"))\nrules <- factor(rules, levels = c(\"Old Rules\", \"New Rules\"))\ndfTmp <- data.frame(typeOfPlays, percentOfPlays, rules)\n\noptions(repr.plot.width=6, repr.plot.height=4.5)\nggplot(dfTmp, aes(x=typeOfPlays, y=percentOfPlays, fill=rules)) + \n  geom_col(position=\"dodge\", width=0.4) +\n  scale_fill_manual(values=c(\"darkgrey\",\"darkgreen\")) +  \n  theme(text = element_text(size=10),plot.title = element_text(hjust = 0.5)) +\n  labs(y=\"Percentage of Punts\", x=\"Type of Punt Play\", fill=\"Rules\",\n      title=\"Comparison of Projected Play Breakdown\")\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"25573d4f2fbfedeff5f20035973e99536005d057"},"cell_type":"markdown","source":"# 4. Net Impact on Concussions\n\nOur method for calculating the net impact on concussions is as follows: First, we calculated the proportion of concussions that each type of punt play caused during the 2016 and 2017 seasons (divided into \"Touchback\", \"Downed\", \"Out of Bounds\", \"Fair Catch\", and “Returned”). Holding these proportions constant, we applied the 55% decrease in punt returns (and the corresponding redistribution towards other punt outcomes), to determine the projected number of concussions that would occur under the suggested rule changes.\n\n### This leads to a projected decrease in concussions by **41%**. "},{"metadata":{"trusted":true,"_uuid":"f328ee757b100fdba7366290729cd996023b7ed5","_kg_hide-input":true},"cell_type":"code","source":"#predicting number of concussions - based on the new rules\ngetNewConcussionsWithNewRules <- function(newPercentPlay){\n  return (round(sum(totals) * newPercentPlay/100 * dfSummary$percentConc/100, 0))\n}\n\n#create barchart comparing the concussions with new/old rule\ngenBarchartComparingConcussionsWithNewRules <- function(numConcussionsWithNewRules, titleText) {\n  numConcussionsMerged <- c(totalConc, numConcussionsWithNewRules)\n  playType  <- c(Punt_Plays, Punt_Plays)\n  rules <- c(replicate(5, \"Old Rules\"), replicate(5, \"New Rules\"))\n  rules <- factor(rules, levels = c(\"Old Rules\", \"New Rules\"))\n  \n  dfSummary2 <- data.frame(numConcussionsMerged,playType, rules)\n  dfSummary2 <- dfSummary2[order(-dfSummary2$numConcussionsMerged),]\n  dfSummary2$playType <- reorder(dfSummary2$playType, dfSummary2$numConcussionsMerged)\n    \n  options(repr.plot.width=6.5, repr.plot.height=4.5)\n  ggplot(dfSummary2, aes(x=playType, y=numConcussionsMerged, fill=rules)) + geom_col(position=\"dodge\", width=0.4) + \n    labs(y=\"Number of Concussions\", x=\"Type of Punt Play\", fill=\"Type of Rules\",title=titleText) +\n    scale_fill_manual(values=c(\"darkgrey\", \"darkgreen\")) +\n    theme(text = element_text(size=12), plot.title = element_text(hjust = 0.5))\n} \n\ngetPercentDifferenceInConcussions <- function(concussionsDF){\n    concussionsBefore <- concussionsDF$Plays * concussionsDF[\"% Concussions\"]/100\n    newRatioOfPlays <- sum(concussionsDF$Plays) * (concussionsDF[\"New Rules\"]/100)\n    concussionsAfter <-  newRatioOfPlays * concussionsDF[\"% Concussions\"]/100\n    concBefore <- sum(concussionsBefore)\n    concAfter <- sum(concussionsAfter)\n    percentDecreased <- round(100*(concBefore-concAfter)/concBefore)\n    return (percentDecreased)\n}\n\n#55% scenario\nnewPercentPlay.touchback <- 8\nnewPercentPlay.out_of_bounds <- 16\nnewPercentPlay.downed_by <- 18\nnewPercentPlay.fair_catch <- 100-20-18-16-8\nnewPercentPlay.returned <- 20\n\nnewPercentPlay <- c(\n  newPercentPlay.touchback,\n  newPercentPlay.out_of_bounds,\n  newPercentPlay.downed_by,\n  newPercentPlay.fair_catch,\n  newPercentPlay.returned)\n\nconcussionsDF <- setNames(data.frame(matrix(ncol = 5, nrow = 5)),\n    c(\"Play Type\",\"Plays\", \"% Concussions\",\"Old Rules\",\"New Rules\"))\n\nconcussionsDF[\"Play Type\"] <- dfSummary$Punt_Plays\nconcussionsDF[\"Plays\"] <- totals\nconcussionsDF[\"% Concussions\"] <- dfSummary$percentConc\nconcussionsDF[\"Old Rules\"] <- dfSummary$percentPlay\nconcussionsDF[\"New Rules\"] <- newPercentPlay\nconcussionsDF\n\nreducedConcussionsBy <- getPercentDifferenceInConcussions(concussionsDF)\n\n# Reduced concussions by 26%\nnumConcussionsWithNewRules <- getNewConcussionsWithNewRules(newPercentPlay)\n\ntitle <- \"How the New Rules Impact Concussions\"\ngenBarchartComparingConcussionsWithNewRules(numConcussionsWithNewRules, title)\n\nlibrary(\"gridExtra\",warn.conflicts = FALSE)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"7b0f3a07c7d7b79c38deee53747aa1edc2c5a944"},"cell_type":"markdown","source":"It's possible that NFL coaches would react slowly to the fair catch bonus. If that were the case, punt returns wouldn't decrease as drastically as we expect right after the rule change. Instead, it may take a couple of years for coaches and returners to grasp the new incentives of bypassing a return for the safety of the 5 yard bonus. Even if that were the case, it's very likely that punt returns would decrease *some* amount. And since punt returns are much more dangerous than all other punt plays, it doesn't take much of a decrease in punt returns to yield a big decrease in concussions. For example, with a 35% decrease in punt returns, concussions are still reduced by 26%."},{"metadata":{"_uuid":"8413edcd45d9a6f0966d7506d5e23351ae07fde6"},"cell_type":"markdown","source":""},{"metadata":{"trusted":true,"_uuid":"d452e016c2cd4b8cc06f51423e8d594b4336fe0b","_kg_hide-input":true,"scrolled":true},"cell_type":"code","source":"#35% scenario\nnewPercentPlay.touchback <- 8\nnewPercentPlay.out_of_bounds <- 13\nnewPercentPlay.downed_by <- 15\nnewPercentPlay.fair_catch <- 100-29-15-13-8\nnewPercentPlay.returned <- 29\n\nnewPercentPlay <- c(\n  newPercentPlay.touchback,\n  newPercentPlay.out_of_bounds,\n  newPercentPlay.downed_by,\n  newPercentPlay.fair_catch,\n  newPercentPlay.returned)\n\nconcussionsDF[\"New Rules\"] <- newPercentPlay\n\n# Reduced concussions by 41%\nreducedConcussionsBy <- getPercentDifferenceInConcussions(concussionsDF)\n\nnumConcussionsWithNewRules <- getNewConcussionsWithNewRules(newPercentPlay)\ntitle <- \"Concussions would still be drop by 26%\"\ng1 <- genBarchartComparingConcussionsWithNewRules(numConcussionsWithNewRules, title)\n\n# Draw chart showing new breakdown of each type of punt play\npercentOfPlays <- c(percentPlay, newPercentPlay)\nrules <- c(replicate(5, \"Old Rules\"), replicate(5, \"New Rules\"))\nrules <- factor(rules, levels = c(\"Old Rules\", \"New Rules\"))\ndfTmp <- data.frame(typeOfPlays, percentOfPlays, rules)\n\n g2 <- ggplot(dfTmp, aes(x=typeOfPlays, y=percentOfPlays, fill=rules)) + \n  geom_col(position=\"dodge\", width=0.4) +\n  scale_fill_manual(values=c(\"darkgrey\",\"darkgreen\")) +  \n  theme(text = element_text(size=12),plot.title = element_text(hjust = 0.5)) +\n  labs(y=\"Percentage of Punts\", x=\"Type of Punt Play\", fill=\"Rules\",\n      title=\"Even if punt returns only decrease by 35%,\")\n\noptions(repr.plot.width=13.5, repr.plot.height=4.5)\ngrid.arrange(g2, g1, ncol=2)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"f020132ac788a2f1d32570c1fa9ba01a6dce3afe"},"cell_type":"markdown","source":"# 4. Won't fans miss the excitement of punt returns?\n\nWhile reducing the number of punt returns may at first seem to lead to less excitement, in the fact the opposite may be true. Long punt returns are exciting to watch, but unfortunately, they rarely happen. In fact, only **8%** of punt returns net more than 20 yards."},{"metadata":{"trusted":true,"_uuid":"ca766366d10f3cecdea96a50ce490cccbf1fc8c7","scrolled":false},"cell_type":"code","source":"returns <- punts[punts$play_result==\"Returned\",]\nround(nrow(returns[returns$Return_Yards>20,])/nrow(returns),2)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"13b3fe96a0afba9e9959d24a94b067902e747222"},"cell_type":"markdown","source":"Even worse is that punt returns are much more likely to have a penalty than other types of punt plays. So not only are most punt returns anticlimactic, but they are leading to high rates of penalties which becomes fustrating for fans. Moreover, penalties lengthen the duration of the game, which is something that the NFL has been trying to address over the past few years."},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"65a83ad185f69ee371f11b3793119abd8baefebf"},"cell_type":"code","source":"# % of returns with penalties\n#returns <- punts[punts$play_result==\"Returned\",]\nreturnsWithPenalties <- round(sum(returns$Has_Penalty)/nrow(returns) * 100, 1)\ncat(paste0(\"Chance of Penalty on Returns: \", returnsWithPenalties,\"%\"))\n\n# % of non returns with penalties\nnonReturns <- punts[punts$play_result!=\"Returned\",]\nnonReturnsWithPenalties <- round(sum(nonReturns$Has_Penalty)/nrow(nonReturns) * 100, 1)\ncat(paste0(\"\\nChance of Penalty on Non-Returns: \", nonReturnsWithPenalties,\"%\"))\n\n#show returns with/without penalties\nTypeOfReturn <- c(\"Non Returns\", \"Returns\")\npercentWithPenalties <- c(nonReturnsWithPenalties, returnsWithPenalties)\ndfTmp <- data.frame(TypeOfReturn, percentWithPenalties)\noptions(repr.plot.width=5, repr.plot.height=4)\nggplot(dfTmp, aes(x=TypeOfReturn, y=percentWithPenalties)) + geom_col(width=0.4) + \n  ylab(\"Percent of Plays with Penalties\") + xlab(\"Type of Punt Play\") +\n  theme(text = element_text(size=10)) +\n  ggtitle(\"Returns more than Twice as Likely to have Penalty\")  \n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"04c7696b9e112a9836e07da26a32f3a4eef09336"},"cell_type":"markdown","source":"What would replace these highly predicatble and heavily penalized punt returns? First of all, teams would go for it more on 4th down, since the expected net punt distance would reduced. This logic will be especially prevelant at around the 50 yard line. Coaches could decide to go for it more often, rather than to punt and concede a fair catch at the 10 yard line, which would start the opposing team's drive at the 15 yard line. More 4th down attempts add drama and excitement to the game, and would certainly be preferred over punts. \n\nAnother stategic reaction to these rule changes that would be interesting is how punters would try to maximize punt distance despite the new fair catch bonus. Would they attempt to angle the punt so it lands out of bounds at its furthest distance? That is hard to execute without kicking it out of bounds too early and risk losing even more yards than the 5 yard fair catch bonus. Perhaps, punters would copy the technique of some college punters, where they attempt to \"squib\" the ball and have the ball skip down the field so as to avoid a fair catch or an easy recovery that would lead lead to a punt return. These strategies would be interesting to follow, and at a minimum they would be less penalized and much safer than punt returns."},{"metadata":{"_uuid":"2fc2160b17cb1bf465afe77cda42f84b2b317e48"},"cell_type":"markdown","source":"# 5. Conclusion\n\n### In closing, we project that the following rule changes will lower concussions by **41%**:\n\n1. Fair catches should be incentivized with a 5 yard bonus (Add this rule under Rule 10, Section 2, Article 4)\n2. All members of the punting team should be permitted to cross the line of scrimmage prior to the punt being kicked\n      * To make this rule change, simply eliminate the \"Ineligible Downfield Kick\" penalty\n      * This would revert back to the existing NFL rule before 1974, and would be similar to NCAA rules\n\nWe began this project with two goals. First, to decipher what factors were causing punt plays to lead to so many concussions. Second, what rule changes could mitigate the risk of concussions without sacrificing the integrity of the game. After all, it wouldn't be helpful to suggest a rule change that dramatically reduced concussions, but ruined the quality of the entertainment on the field. We have come up with two rule changes that would naturally push the incentives away from punt returns. As fans of the NFL, it was a rewarding challenge to design actionable rules that would help make the game substantially safer."}],"metadata":{"kernelspec":{"display_name":"R","language":"R","name":"ir"},"language_info":{"mimetype":"text/x-r-source","name":"R","pygments_lexer":"r","version":"3.4.2","file_extension":".r","codemirror_mode":"r"}},"nbformat":4,"nbformat_minor":1}