{"cells":[{"metadata":{"_uuid":"8e08db08b6a2978661bd7a02811db64b18a6e903"},"cell_type":"markdown","source":"\n**Introduction**\n\nThe overarching theme of this analysis is based around the fact that, at scale, simple and objective constraints will always be more effective than constraints which lack either or both of those features. As such, you'll notice that our analysis intentionally avoids getting bogged down in the robust NGS data set regarding player movements. That data, while fascinating, centers around player player velocity and position. In order to justify an exploration of that data, we would first have to be willing to consider contraints that govern player velocity, location, or interactions between those two features. In our minds, any intervention that exists at the level of player mechanics becomes very difficult to implement at scale, and would very likely lead to subjective rules which would disrupt the experience of both players and fans. The NFL has already taken some agressive and necessary steps to change player mechanics, and while there is still likley room for improvement in that area, it becomes difficult to concretely estimate how mechanic changes will impact concussion rates, if at all.  Instead, our analysis will focus on higher level features of punt plays, where we have a more concrete understanding of how our interventions might decrease concussions. Through this analysis, we will lay out how one simple rule change could possibly decrease punt related concussions by as much as 40-60%. This rule will:\n\n* Be objective and simple to implement at scale\n* Not involve any new penalties\n* Retain the overall balance of punt play outcomes\n* Add excitement and strategy to game scenarios which would normally be routine\n\n\nSaid simply, the rule is as follows:\n\n**On qualifying punts, if the receiving team chooses to call for a fair catch (and catches the ball successfully), their offense takes over at a point 10 yards downfield from the spot of the fair catch. However, in order to qualify for this fair catch dead-ball advance, the line of scrimage of the punt play must be behind the punting team's 45 yard line.  Additionally, the punt play must begin before the 2-minute warning at the end of either half.  If either of these criteria are not met, fair catches no longer receive the 10 yard advance.\n**\n\nThis is clearly an agressive incentive to bias return teams toward calling for a fair catch. However, because of the routine nature of most punts and because of the qualification criteria we have laid out, we believe the net effect of the punt will remain largely unchanged.  Additionally, the agressiveness of this rule will bring new excitement and strategic consideration into the game; plays around midfield now have increased significance. Importantly, the fair catch qualification criterion are as important as the implementation of the bonus itself.  Without these qualification criterion, we would risk having the punt become, in essence, a formality with little liklihood to have an impact on the game.  \n\nIn the following R code, we will go about demonstrating how and why this new rule would be effective at reducing concussions while maintaining game balance.  "},{"metadata":{"_uuid":"8ed962701d00feae93216686519ed5a71044dc57","_execution_state":"idle","trusted":true,"_kg_hide-output":true},"cell_type":"code","source":"#The following code block loads requisite packages, cleans key data frames, and sets up a primary data frame which we will use throughout the analysis\n#As most data scientists likely know, this is bost the most important, and the dullest part of an analysis :)\n\n\nlibrary(RColorBrewer)\nlibrary(stringr)\nlibrary(hms)\n\n#sanity check on working directory\n#getwd()\nsetwd(\"/kaggle/working\")\n\ngame_data <- read.csv(\"/kaggle/input/game_data.csv\", stringsAsFactors = FALSE)\nplay_information <- read.csv(\"/kaggle/input/play_information.csv\", stringsAsFactors = FALSE)\nplay_player_role_data <- read.csv(\"/kaggle/input/play_player_role_data.csv\", stringsAsFactors = FALSE)\nplayer_punt_data <- read.csv(\"/kaggle/input/player_punt_data.csv\", stringsAsFactors = FALSE)\nvideo_footage_control <- read.csv(\"/kaggle/input/video_footage-control.csv\", stringsAsFactors = FALSE)\nvideo_footage_injury <- read.csv(\"/kaggle/input/video_footage-injury.csv\", stringsAsFactors = FALSE)\nvideo_footage_injury$concussion <- 1\nvideo_review <- read.csv(\"/kaggle/input/video_review.csv\", stringsAsFactors = FALSE)\n\n#renaming some of the injury key columns to be consistent with column names in other dataframes#renaming some of the injury key columns to be \n#consistent with column names in other dataframes\ncolnames(video_footage_injury) <- c(\"Season\", \"Type\", \"Week\", \"Home_team\", \"Visit_Team\", \"Qtr\", \"PlayDescription\",\n                                    \"GameKey\", \"PlayID\", \"PREVIEW.LINK..5000K.\")\n#Also creating a concussion column.  this will come in handy later, and all the rows in this data frame will have a value of 1 \n#because these all resulted in a concussion\nvideo_footage_injury$concussion <- 1\n\n#Now for some obligatory data prep. We want to start by parsing out what yard line a punt was made from, absent team name\npunt_locations <- strsplit(play_information$YardLine, \" \", fixed = TRUE)\n\n#creating a simple list of these punt teams and locations.  It'll come in handy to have this information split\nteam_names <- c()\npunt_location <- c()\nfor (ir in 1:length(punt_locations)){\n  team_names <- c(team_names, punt_locations[ir][[1]][1])\n  punt_location <- c(punt_location, punt_locations[ir][[1]][2])\n}\n\n#Now, creating a new data frame which we will use going forward for the basis of our analysis.  \n#I like to leave the original dataset as untouched as posible for reference\n#This data frame will contain both original daat fields and derived data fields\npunt_loc_df <- data.frame()\npunt_loc_df[1:length(punt_locations), \"team\"] <- team_names\npunt_loc_df[1:length(punt_locations), \"yard_line\"] <- punt_location\n\npunt_loc_df$yard_line <- as.numeric(punt_loc_df$yard_line)\n\n#We didnt shuffle the order of the rows during the above process, so we are safe to just slap these columns in the \n#target df\npunt_loc_df$Season_Year <- play_information$Season_Year\npunt_loc_df$Season_Type <- play_information$Season_Type\npunt_loc_df$GameKey <- play_information$GameKey\npunt_loc_df$Game_Date <- play_information$Game_Date\npunt_loc_df$Week <- play_information$Week\npunt_loc_df$PlayID <- play_information$PlayID\npunt_loc_df$Game_Clock <- play_information$Game_Clock\npunt_loc_df$Quarter <- play_information$Quarter\npunt_loc_df$Play_Type <- play_information$Play_Type\npunt_loc_df$Poss_Team <- play_information$Poss_Team\npunt_loc_df$Home_Team_Visit_Team <- play_information$Home_Team_Visit_Team\npunt_loc_df$Score_Home_Visiting <- play_information$Score_Home_Visiting\npunt_loc_df$PlayDescription <- play_information$PlayDescription\n\n\n#Nothing special here, just flagging some important events \n#in their own field so we can reference plays with these events later in the analysis\n#The inputs in the Play Description are very formulaic, so we can infer events based on specific verbiage in the description\n#We will clean a few of these later\npunt_loc_df$fair_catch <- grepl(\"fair catch\", punt_loc_df$PlayDescription)\npunt_loc_df$ball_downed <- grepl(\"downed\", punt_loc_df$PlayDescription)\npunt_loc_df$oob <- grepl(\"out of bounds\", punt_loc_df$PlayDescription)\npunt_loc_df$touchback <- grepl(\"touchback\", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$play_reversed <- grepl(\"reversed\", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$some_injury <- grepl(\"injured\", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$holding_penalty <- grepl(\"holding\", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$punt_returned <- grepl(\"for \", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$punt_returned_no_gain <- grepl(\"no gain\", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$punt_blocked <- grepl(\"blocked\", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$ball_punted <- grepl(\"punts \", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$touchdown_result <- grepl(\"touchdown\", tolower(punt_loc_df$PlayDescription))\npunt_loc_df$returned_touchdown <- (punt_loc_df$punt_returned == 1 & punt_loc_df$touchdown_result)\npunt_loc_df$punt_blocked_touchdown <- (punt_loc_df$punt_blocked == 1 & punt_loc_df$touchdown_result)\n#Also want to get a version of the game clock with which we can do logical comparisons\npunt_loc_df$Game_Clock_hms <- as.hms(paste(\"00:\", punt_loc_df$Game_Clock, sep = \"\"))\npunt_loc_df$within_2m_warning <- ifelse((punt_loc_df$Quarter == 2 | punt_loc_df$Quarter == 4) & punt_loc_df$Game_Clock_hms <= as.hms(\"00:02:00\"), 1, 0)\n#this will come into use later\npunt_loc_df$no_punt_play <- ifelse(punt_loc_df$ball_punted == 1, 0, 1)\npunt_loc_df$play <- 1\n\n\n#Creating a backup because I hate losing data...\npunt_loc_df_bk <- punt_loc_df\n\n#We also want to get a concrete understanding on the distance from the punting team's endzone.  \n#This is more than just the yard line of the kick, as the punting team may be in opponent territory\n#flagging whether or not the yard refences the punting teams terrritory, or the opponents territory\npunt_loc_df$from_own <- punt_loc_df$team == punt_loc_df$Poss_Team\n#most times, the dist from own endzone will be the \"yard_line\" we cacluated earlier.  Exception cases to be handled below\npunt_loc_df$dist_from_own_ez <- punt_loc_df$yard_line\n\n#when the punt is not made from their own side of the field, we can claculate the true dist from own ez by taking 100 - play yard line\npunt_loc_df[punt_loc_df$from_own == 0, \"dist_from_own_ez\"] <- 100 - punt_loc_df[punt_loc_df$from_own == 0, \"yard_line\"] \nplays_past_own_45 <- nrow(punt_loc_df[punt_loc_df$dist_from_own_ez >= 45, ])#approx 26% of punts would be exempt. But are these punt plays where concussions happened?\n\n\n#trying to find the location of the \"for \" statements, as they generally denote some kind of punt return\n#going to use these indicies to extract the punt distance and the return distance, but need to clean it a bit first, as well as account for instances\n#where the statement exists twice\n#This is hacky but effective since we arent dealing with GBs of data :).  May want to revisit this just for the sake of cleanliness.  \n#We could just turn this into 2 functions, 1 for punts and one for returns and then use lapply, but since these processes will only be completed once each, \n#our process would end up being just as complex either way\n\n#we want to find the indicies of the \"for\" or \"punts\" statements, and ultimately strip the distance information from the string based on the location of those keywords\nfor_index <- str_locate_all(tolower(punt_loc_df$PlayDescription), \"for \")\npunts_index <- str_locate_all(tolower(punt_loc_df$PlayDescription), \"punts \")\n\n#working with vectors because they makes life easier\nreturn_yards <- rep(0, nrow(punt_loc_df))\n\n#first going to loop over \"for\" indicies to pull return distance\nedge_cases_return <- c()\nfor (ri in 1:nrow(punt_loc_df)){\n  #getting all (if any) index pairs for the word \"for\" in a given play description\n  play_for_inds <- for_index[[ri]]\n  #if the play was reversed, we want to use the return result from the last \"for\" statment.  this will almost always be the 2nd occurrence, \n  #but making the encoding flexible anyway\n  if (punt_loc_df[ri, \"play_reversed\"] == 1){\n    row_ref <- dim(play_for_inds)[1]\n  }else{\n    #otherwise, for all other play types, including fumbles, we are interested in the return before any other major play event.\n    row_ref <- 1\n  }\n  \n  if (dim(play_for_inds)[1] > 0){\n    exp_end_ind <- play_for_inds[row_ref, 2]\n    target_chars <- gsub(\" \", \"\", substr(punt_loc_df[ri, \"PlayDescription\"], exp_end_ind+1, exp_end_ind+2))\n    #if the substring after the \"for\" flag is the word \"no\", that means there was no gain on the play, so we can infer return yards = 0\n    if(target_chars == \"no\"){\n      target_dist <- 0\n    }else{\n      target_dist <- as.numeric(gsub(\" \", \"\", substr(punt_loc_df[ri, \"PlayDescription\"], exp_end_ind+1, exp_end_ind+2)))\n    }\n    \n    return_yards[ri] <- target_dist               \n  }else{\n    return_yards[ri] <- NA               \n  }\n}\n#adding these results in as a column into our data frame. We now only have to write to the dataframe once\npunt_loc_df$return_yards <- return_yards\n#We want to create a new column where we can impute missing return yard values for non-return plays.  \n#Dont want to tinker with the original column because we still want to be able to distinguish returns for 0 yards from palys with no returns\npunt_loc_df$return_yards_impute <- ifelse(is.na(punt_loc_df$return_yards), 0, punt_loc_df$return_yards)\n\n\npunt_yards <- rep(0, nrow(punt_loc_df))\nfor (ri in 1:nrow(punt_loc_df)){\n  #getting all (if any) index pairs for the word \"for\" in a given play description\n  play_punt_inds <- punts_index[[ri]]\n  #if the play was reversed, we want to use the punt result from the last \"for\" statment.  this will almost always be the 2nd occurrence, but making the encoding flexible anyway\n  if (punt_loc_df[ri, \"play_reversed\"] == 1){\n    row_ref <- dim(play_punt_inds)[1]\n  }else{\n    #otherwise, for all other play types, including fumbles, we are interested in the punt distance before any other major play event.\n    row_ref <- 1\n  }\n  \n  if (dim(play_punt_inds)[1] > 0){\n    exp_end_ind <- play_punt_inds[row_ref, 2]\n    target_chars <- gsub(\" \", \"\", substr(punt_loc_df[ri, \"PlayDescription\"], exp_end_ind+1, exp_end_ind+2))\n    #if the substring after the \"for\" flag is the word \"no\", that means there was no gain on the play, so we can infer return yards = 0\n    if(target_chars == \"no\"){\n      target_dist <- 0\n    }else{\n      target_dist <- as.numeric(gsub(\" \", \"\", substr(punt_loc_df[ri, \"PlayDescription\"], exp_end_ind+1, exp_end_ind+2)))\n    }\n    \n    punt_yards[ri] <- target_dist               \n  }else{\n    punt_yards[ri] <- NA               \n  }\n}\n#adding these results in as a column into our data frame. We now only have to write to the dataframe once\npunt_loc_df$punt_yards <- punt_yards\n#We want to create a new column where we can impute missing punt yard values for non-punt plays.  \n#Dont want to tinker with the original column because we still want to be able to distinguish punts for 0 yards from plays with no punt at all\npunt_loc_df$punt_yards_impute <- ifelse(is.na(punt_loc_df$punt_yards), 0, punt_loc_df$punt_yards)\n\n\n#finally, creating a last few columns of event flags that depend partially on the return or punt yards\n#This will be an important flag be cause we want to use it to determine which plays would qualify for the fair catch advance\npunt_loc_df$past_own_45 <- ifelse(punt_loc_df$dist_from_own_ez >= 45, 1, 0)\n#punt_loc_df$pinned_deep <- ifelse((punt_loc_df$dist_from_own_ez + punt_loc_df$punt_yards) >= 90 & punt_loc_df$ball_punted == 1, 1, 0)\n#ALso want to flag plays where the opponent was pinned deep in their own zone.  In english, the logic is:\n#Condition 1: Punt yard line + punt distance - yards returned (which will be 0 if there was no return) >= 90.  This means that the opposing team ended up on < their own 10 YL\n#Condition 2: Ball had to be punted, and there was no touchback.  \npunt_loc_df$pinned_deep <- ifelse((punt_loc_df$dist_from_own_ez + punt_loc_df$punt_yards - punt_loc_df$return_yards_impute) >= 90 & punt_loc_df$ball_punted == 1 & punt_loc_df$touchback == 0, 1, 0)\n\n#Finally, we set a flag which indicates if a given play would qualify for the fair catch advance.  The play must not be within the 2m warning, and must not be at or beyond the punting teams 45\npunt_loc_df$qualified_plays <- ifelse(punt_loc_df$within_2m_warning == 0 & punt_loc_df$past_own_45 == 0, 1, 0)\n\n\n#Now that we've added in most of the derived fields of interest we will be using to parse the data, we also want to add in a flag indicating whether the play resulted in a concussion.\n#Merging data frame that has data about plays where a concussion occurred. Using GameKey and PlayID to do so\npunt_loc_df <- merge(punt_loc_df, video_footage_injury[, c(\"GameKey\", \"PlayID\", \"concussion\")], by = c(\"GameKey\", \"PlayID\"), all.x = TRUE)\n#If we dont find a key match, we can assume the play was not a concussion. \npunt_loc_df[is.na(punt_loc_df$concussion), \"concussion\"] <- 0\n#Simply adding the resulting \"1\"'s in this field shows we have the correct number of plays flagged as concussions.  \n#If the following statement returns as false, we've messed up..\nsanity_check_on_merge <- sum(punt_loc_df$concussion) == nrow(video_footage_injury)\nprint(sanity_check_on_merge)\n\nconc_plays <- punt_loc_df[punt_loc_df$concussion == 1, ]\n#writing for manual review\n#write.csv(conc_plays, \"concussion_plays.csv\")\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"37e7320b269653d5440a5aff7e89a41e1359ecb3"},"cell_type":"markdown","source":"Phew.  Data cleaning and prep complete.  The last bit of housekeeping we are going to do is create a density plotting function so we dont have to copy and paste our code each time for this class of plot."},{"metadata":{"trusted":true,"_uuid":"667d3fc30dd4e250ab4a63c1b2dfd75b0b6841a5"},"cell_type":"code","source":"#we want to create a small function which will allopw us to look at key event distributions without having to frequently rewrite the plotting code\n#The following function will do just that.\nplot_distribution_by_filter <- function(datain = NULL, filter_flag = NULL, metric = NULL, show_static_yl = 45, title_in = NULL){\n  #globally updating plot titles to be centered\n  theme_update(plot.title = element_text(hjust = 0.5))\n  \n  pnty <- datain[datain[[filter_flag]] == 1 & !is.na(datain[[metric]]), c(filter_flag, metric)]\n  pnty[[filter_flag]]<- as.logical(pnty[[filter_flag]])\n  \n  #renaming the metric column in the df to a static name to make it easier to refer to in ggplot\n  colnames(pnty)[2] <- \"hist_metric\"\n  if (!is.null(show_static_yl)){\n    pt1 <- ggplot(pnty, aes(x = hist_metric)) +\n      geom_histogram(aes(y = ..density..), # the histogram will display \"density\" on its y-axis\n                     binwidth = 2, colour = \"blue\", fill = \"white\", alpha = .2) + \n      geom_density(alpha = .4, fill=\"#FF6655\") +\n      geom_vline(aes(xintercept = mean(hist_metric, na.rm = T)),\n                 colour = \"red\", linetype =\"longdash\", size = .8) + \n      geom_vline(aes(xintercept = median(hist_metric, na.rm = T)),\n                 colour = \"blue\", linetype =\"longdash\", size = .8) +\n      geom_vline(aes(xintercept = show_static_yl),\n                 colour = \"black\", size = .5) +\n      xlab(metric) +\n      ggtitle(title_in)\n  }else{\n    pt1 <- ggplot(pnty, aes(x = hist_metric)) +\n      geom_histogram(aes(y = ..density..), # the histogram will display \"density\" on its y-axis\n                     binwidth = 2, colour = \"blue\", fill = \"white\", alpha = .2) + \n      geom_density(alpha = .4, fill=\"#FF6655\") +\n      geom_vline(aes(xintercept = mean(hist_metric, na.rm = T)),\n                 colour = \"red\", linetype =\"longdash\", size = .8) + \n      geom_vline(aes(xintercept = median(hist_metric, na.rm = T)),\n                 colour = \"blue\", linetype =\"longdash\", size = .8) +\n      xlab(metric) +\n      ggtitle(title_in)\n  }\n  \n  return(pt1)\n  \n}\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"97cf245f3ddfc8250738c2b4de369cef59d9d689"},"cell_type":"markdown","source":"Boom.  Now, we can finally get into the meat-n-potatoes of this analysis.  Our goal in the first half of this analysis will be to whittle down the universe of possible punt plays into smaller play-type subsets to determine if we can reasonably limit the scope of plays where the effect of our new rule will have a negligible effect on the balance of the game, yet a disproportionately high decrease of concussions.\n\nFirst of all, at the highest level, we can break our data into plays where there was a punt vs plays with no punt.  \"No punt: plays include plays where the punt was blocked, fake punts, 1st downs due to penalties before the play starts, etc.).  This seems like a silly exercise, but it will help us understand the scope of our intervention."},{"metadata":{"trusted":true,"_uuid":"557303b225b661201ad1d0263ca643c481250d27"},"cell_type":"code","source":"#Creating simple column sum of plays where the ball was actually punted vs plays where no punt occurred\nlibrary(ggplot2)\npunt_nopunt_all <- colSums(punt_loc_df[punt_loc_df$play == 1, c(\"no_punt_play\", \"ball_punted\")], na.rm = TRUE)\n#putting it into a format that plays nicely with ggplot\npunt_nopunt_freq <- data.frame(play_type = names(punt_nopunt_all), vals = punt_nopunt_all)\n#adding in a frequency column\npunt_nopunt_freq$val_freq <- round(punt_nopunt_freq$vals/ sum(punt_nopunt_freq$vals), 2)\np<-ggplot(data=punt_nopunt_freq, aes(x=play_type, y=val_freq, label = val_freq)) +\n  theme_update(plot.title = element_text(hjust = 0.5)) +\n  geom_bar(stat=\"identity\", fill=\"blue\") + \n  xlab(\"Type of punt play\") +\n  ylab(\"Play frequency\") +\n  geom_text(size = 5, position = position_stack(vjust = 0.75), colour = \"black\") +\n  #geom_label(aes(fill = \"orange4\", color = 'white', size = 3.5)) +\n  #scale_x_discrete(labels = c(\"No Punt\", \"Punt\")) + \n  theme_minimal() +\n  ggtitle(\"Overall frequency of true punt plays vs plays without punt\")\nprint(p)\n\n#What about concussions?  do they occur primarily in punt or non punt plays?\npunt_nopunt_conc <- colSums(punt_loc_df[punt_loc_df$concussion == 1, c(\"no_punt_play\", \"ball_punted\")], na.rm = TRUE)\npunt_nopunt_conc_freq <- data.frame(play_type = names(punt_nopunt_conc), vals = punt_nopunt_conc)\npunt_nopunt_conc_freq$val_freq <- round(punt_nopunt_conc_freq$vals/ sum(punt_nopunt_conc_freq$vals), 2)\np<-ggplot(data=punt_nopunt_conc_freq, aes(x=play_type, y=val_freq, label = val_freq)) +\n  theme_update(plot.title = element_text(hjust = 0.5)) +\n  geom_bar(stat=\"identity\", fill=\"blue\") + \n  xlab(\"Type of punt play\") +\n  ylab(\"Concussion Frequency\") +\n  geom_text(size = 4, position = position_stack(vjust = 0.75), colour = \"black\") +\n  #geom_label(aes(fill = \"orange4\", color = 'white', size = 3.5)) +\n  #scale_x_discrete(labels = c(\"No Punt\", \"Punt\")) + \n  theme_minimal() +\n  ggtitle(\"Overall % of punt play concussions for true punt plays vs plays without punt\")\nprint(p)\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"0bbd68dbe8989e321aa0ffd013590d4f51869ab2"},"cell_type":"markdown","source":"Those results probably aren't very surprising.\n\nSo, to simplify the scope of our intervention and analysis going forward, we will only analyze plays on which punts occurred.  This means we need to come up with an intervention that would only occur occurrs plays where the ball is actually punted.  This is fine for us, since ~97% of concussions occur durint plays where there was an actual punt."},{"metadata":{"trusted":true,"_uuid":"4f517075d10f5a049e6340df6905f87a4e85fe5d"},"cell_type":"code","source":"#Creating a new data frame that only includes those plays where a punt occurred.  we will use this as the basis of our analysis going forward\npunt_loc_df_refined <- punt_loc_df[punt_loc_df$ball_punted == 1, ]","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"3e425d2b58b3ca9d86c4dc49605e541c64d3922d"},"cell_type":"markdown","source":"Additionally, we want to look into the concussion frequency by more specific play types.  These different classes of punt play types include fair catch plays, plays where the ball was downed, touchbacks, plays where the punt was returned, and punts where the ball went out of bounds (OOB).  The results here will show us if there is a type of play where we see a disproportionate amount of concussions occurring as compared to the other play types.  If there is such a pattern, we can further refine the \"universe\" of plays on which we would like to intervene.\n"},{"metadata":{"trusted":true,"_uuid":"3cb06fd648cef44162e7916ea30094204fcdb105"},"cell_type":"code","source":"#For all plays where there was a punt, what is the breakdown of how those plays proceeded?\nAllplays_by_playtype_forchart <- colSums(punt_loc_df_refined[punt_loc_df_refined$play == 1, c(\"fair_catch\", \"ball_downed\", \"touchback\", \"punt_returned\", \"oob\")], na.rm = TRUE)\nAll_play_freq <- data.frame(play_type = names(Allplays_by_playtype_forchart), vals = Allplays_by_playtype_forchart)\nAll_play_freq$val_freq <- round(All_play_freq$vals/sum(All_play_freq$vals), 2)\np<-ggplot(data=All_play_freq, aes(x=play_type, y=val_freq, label = val_freq)) + \ntheme_update(plot.title = element_text(hjust = 0.5)) +\n  geom_bar(stat=\"identity\", fill=\"blue\") + \n  xlab(\"Type of punt play\") +\n  ylab(\"Play Frequency\") +\n  geom_text(size = 5, position = position_stack(vjust = 0.75), colour = \"black\") +\n  #geom_label(aes(fill = \"orange4\", color = 'white', size = 3.5)) +\n  #scale_x_discrete(labels = c(\"Fair catch\", \"Ball downed\", \"Touchback\", \"Punt returned\", \"oob\")) + \n  theme_minimal() +\nggtitle(\"Punt play frequency by play outcome\")\nprint(p)\n\n\n#Creating a simple table of concussions by play type\nAllplays_by_playtype_forchart <- colSums(punt_loc_df_refined[punt_loc_df_refined$concussion == 1, c(\"fair_catch\", \"ball_downed\", \"touchback\", \"punt_returned\", \"oob\")], na.rm = TRUE)\nAll_play_freq <- data.frame(play_type = names(Allplays_by_playtype_forchart), vals = Allplays_by_playtype_forchart)\n#For all concussion related graphs, we will still calculate concussion frequency using the original 37 concussion as the base for calculations\nAll_play_freq$val_freq <- round(All_play_freq$vals/37, 2)\np<-ggplot(data=All_play_freq, aes(x=play_type, y=val_freq, label = val_freq)) +\n  geom_bar(stat=\"identity\", fill=\"blue\") + \n  xlab(\"Type of punt play\") +\n  ylab(\"Play Frequency\") +\n  geom_text(size = 5, position = position_stack(vjust = 0.75), colour = \"black\") +\n  #geom_label(aes(fill = \"orange4\", color = 'white', size = 3.5)) +\n  #scale_x_discrete(labels = c(\"Fair catch\", \"Ball downed\", \"Touchback\", \"Punt returned\", \"oob\")) + \n  theme_minimal() +\n  ggtitle(\"% Of punt related concussions by play type\")\nprint(p)\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"7297e809546e6931110094e9fb70035334b5c5c3"},"cell_type":"markdown","source":"It's probably not surprising that plays which result in a punt return of any type have a disproportionate contribution to concussions during punt plays.  What is somewhat surprising, however, is how profound this pattern is.  Theoretically, if we were to outlaw any type of return, we could expect punt-related concussions to drop by 32/37 = 86.5%.  However, we don't want to do this because that would turn the punt into a almost meaningless formality.  However, if we were to create conditions that would incentivize fair catches while retaining the option to return without removing the strategic net effect of punts, we would have a great solution.  Going forward, our goal will be to selectively incentivize the returning team to fair catch more frequently, or incentivize the punting team to kick OOB more frequently.\n\nIn order to dig into the data a bit more, we are going to explore some distributions to understand high level patterns in play types, and how those play types relate to concussions, distance from own endzone, punting distances, and return distances.  Unless otherwise noted, in all of the following density plots, the average poisition will be indicated by a dashed vertical red line, the median position will be indicated with a dashed vertical blue line, and the 45 yard line will be indicated with a solid black vertical line.\n\nWe will start with a simple look at the frequency of punts based on the LOS from which the punting team kicks:\n"},{"metadata":{"trusted":true,"_uuid":"d90da0e42053fa924db594deb9a93a7ec36e3aed"},"cell_type":"code","source":"\npunt_freq_by_dist_from_ez_loc <- plot_distribution_by_filter(datain = punt_loc_df_refined, filter_flag = \"ball_punted\", metric = \"dist_from_own_ez\", title_in = \"Punt distribution by distance from own end zone\")\nplot(punt_freq_by_dist_from_ez_loc)\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"d978cbefb9fdd441708ab9acd16bbb3d6360e8c7"},"cell_type":"markdown","source":"As you can see, punt plays have a fairly normal distribution, with a median location of about the 33-34 YL.  However,  as you can see bleow, plays which result in concussions are skewed heavily to punt plays where the punting team is <= their own 45-50 yard line.  \n\nLets look at the LOS distribution for just plays which resulted in some kind of concussion"},{"metadata":{"trusted":true,"_uuid":"a8b765ed95b380aec2f1a38a2e5dfcca13af33c1"},"cell_type":"code","source":"\nconcussion_punt_dist_from_ez_loc <- plot_distribution_by_filter(datain = punt_loc_df_refined, filter_flag = \"concussion\", metric = \"dist_from_own_ez\", title_in = \"Concussion distribution by distance from own End Zone\")\nprint(concussion_punt_dist_from_ez_loc)\nconcussion_pct_before_own_45 <- round((nrow(punt_loc_df_refined[punt_loc_df_refined$past_own_45 == 0 & punt_loc_df_refined$concussion == 1,] )/37) * 100, 2)\nprint(paste(concussion_pct_before_own_45, \"% of punt related concussions occur when the punt team kicks from behind their own 45 yard line\", sep = \"\"))\n\n#In fact, 81% of concussions occur when the kicking team is behind their own 45 YL.  This is a huge skew!\n\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"edf2bb341ce3da002d2cc4935c428f127e499090"},"cell_type":"markdown","source":"This is likely due to a combination of factors.  Primarily, as you can see below, punts made from beyond the puting teams 45 yard line result in a disproportionate amount of touchbacks, fair catches, and kicks OOB.  As we know, these types of plays result in markedly fewer concussions, so it would make sense that kicks made from beyond the kicking teams own 45 YL would result in much fewer concussions than kicks made from less than their 45 YL\n"},{"metadata":{"trusted":true,"_uuid":"11a01953d9fe92494267c49be05536f35187ab3e"},"cell_type":"code","source":"\n#Bar graph of play distribution for just punts made from past own 45\npast45_by_playtype_forchart <- colSums(punt_loc_df_refined[punt_loc_df_refined$past_own_45 == 1, c(\"fair_catch\", \"ball_downed\", \"touchback\", \"punt_returned\", \"punt_blocked\")], na.rm = TRUE)\npast45_play_freq <- data.frame(play_type = names(past45_by_playtype_forchart), vals = past45_by_playtype_forchart)\npast45_play_freq$val_freq <- round(past45_play_freq$vals/sum(past45_play_freq$vals), 2)\np<-ggplot(data=past45_play_freq, aes(x=play_type, y=val_freq, label = val_freq)) +\n  geom_bar(stat=\"identity\", fill=\"blue\") + \n  xlab(\"Type of punt play when punt LOS >= own 45\") +\n  ylab(\"Play frequency\") +\n  geom_text(size = 5, position = position_stack(vjust = 0.75), colour = \"black\") +\n  theme_minimal() + \n  ggtitle(\"Play type frequency when punting team LOS >= own 45\")\nprint(p)\n\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"acdff10fc6b7a188376d9fe98ca707cdeffd46ad"},"cell_type":"markdown","source":"It looks like this checks out.  Among punt plays which occur past the kicking teams own 45 yard line, only 12% of punts result in some kind of return.  The rest result in fair catches, the ball being downed, and touchbacks.  \n\nThis is useful information we can use to further limit the possible spectrum of plays on which we want to intevene.  Additionally, and very importantly, it is crucial that we do not limit the punting teams ability to pin the opposing team deep in their own zone.  Pinning the opposing team deep in their own zone is, arguably, the single most important goal of the punt team. The deeper the opposing team is pinned, the more influential the punt play; successfully doing to can swing the momentum of a game.\n\nBelow, you can see a distribution of punt LOS for all those punt plays where the return team was pinned within their own 10 yard line.  Hopefully, we will see that this distribution is skewed towards punts with a LOS past their own 40-45 YL"},{"metadata":{"trusted":true,"_uuid":"c91dd027ef9d7f2d0901b3a6d456dd63759302fc"},"cell_type":"code","source":"\n#Lets look at the distribution of kicking LOS for plays that end with the returning team getting pinned deep in their own endzone\npinned_within_10_dist_from_ez_loc <- plot_distribution_by_filter(datain = punt_loc_df_refined, filter_flag = \"pinned_deep\", metric = \"dist_from_own_ez\", title_in = \"Distribution of Punting LOS when opponent pinned < own 10 YL\")\nprint(pinned_within_10_dist_from_ez_loc)\n\npct_pinnedDeep_plays_LOS_gte_45 <- round(nrow(punt_loc_df_refined[punt_loc_df_refined$past_own_45 == 1 & punt_loc_df_refined$pinned_deep == 1,] )/nrow(punt_loc_df_refined[punt_loc_df_refined$pinned_deep == 1, ]), 2) * 100\nprint(paste(pct_pinnedDeep_plays_LOS_gte_45, \"% of punts that pin the receiving team behind their own 10 occur when the LOS is >= kicking teams 45\", sep = \"\"))\n#As you can see, Approximately 75% of plays that result in this optimal outcome for the kicking team occur when the kicking team is at or beyond their own 45 yard line.  Again, it is crucial that we maintain this advantage\n\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"3380fc2538abbc8d67d86cad4c72eb419b6de278"},"cell_type":"markdown","source":"As you can see, 74% of punting plays which result in the recieving team being pinned behind their own 10 yard line are punted from or beyond the kicking teams 45 yard line.  Additionally, ~81% of all concussions during any punt play occur when the ball is punted from behind the kicking teams own 45 yard line.  \n\nFrom this, we can assume that if we were to limit the 10 yard fair catch bonus to only those punts which were made with the LOS being behind the kicking teams 45 yard line, We would maintain the vast majority of the dramatic, momentum shifting event of pinning the recieving team deep in their own zone, while still allowing our intervention to effect the plays on which 81% of punt related concussions occur.  Without this caveat, the punt would become essentially a formality, and the recieving team would almost never elect not to fair catch, especially when catching it deep in their own zone.  This would certainly upset the balance of the game and negate the purpose of punts which are intended to land deep in enemy territory.  This is also a \"lever\" that can be adjusted depending on how much the NFL wants to reduce concussions at the cost of handicapping the punting team.  If they wanted to have a slightly smaller effect on the overall concussion reduction, but handicap the punting team less, the required field position could be pushed back to the kicking teams 40 Yard line, or further.  \n\nNow, we also want to ensure that this new rule, even with the 45 YL yard caveat, doesnt result directly in any late game significant shifts in field position.  In the NFL today, many games are coming down to last minute nail-bites decided by only a few points.  We would not want to see a team up by 2 points punt from their own 25 yard line, have the recieving team fair catch, and be marched very close to field goal position without even running a play.  We believe that if the outcome of a game ends up being heavily influenced by a last minute 10 yard advance on a fair catch, fans and players alike would think twice about this new rule - whether or not it greatly reduces concussions.  Becasue of this, we believe it makes sense to only have this rule not be in effect during the last 2 minutes of each half.  Below, we will show that while maintaining the balance of the game, this caveat does not have a sizeable impact on the overall percent of concussions which might be reduced on punt plays.\n"},{"metadata":{"trusted":true,"_uuid":"837fbefa955cc694b13c2049619b24749306c166"},"cell_type":"code","source":"\n#81% concussions occur during qualified plays if bonus qualification only includes the fact that kicking team needs to be behind its on 45\n#% of concussions which occur when the kicking team is behind their own 45 YL, and the game is not within the last 2 minutes\npct_concussions_still_in_qualified_plays <- round(nrow(punt_loc_df_refined[punt_loc_df_refined$past_own_45 == 0 & punt_loc_df_refined$within_2m_warning == 0 & punt_loc_df_refined$concussion == 1,] )/37, 2) * 100\n#~70% concussions occur during qualified plays if bonus qualification includes both the 2 min warning caveat and the fact that kicking team needs to be behind its on 45\nprint(paste(pct_concussions_still_in_qualified_plays, \"% of concussions occur during plays that meet our overall fair catch bonus criteria with the 2m warining caveat in place\", sep = \"\"))\n#Clearly, we still maintain the ability to influence punt plays during which %70 of punt related concussions occur.  We also greatly reduce the possibility that this new rule would contribute to late game swings in field position.\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"04368e40ba1a8f3b087ea53b8e18830d591d5b8d"},"cell_type":"markdown","source":"Finally, we will discuss how we came to the conclusion that a 10 yard fair catch bonus is optimal for qualified plays.  Below you will see a density distribution plot for the return yards on all qualified plays where there was some attempt to return the ball.  The blue dashed line denotes the median distance of those returns, the red line denotes the average return distance, and the solid black line denotes the suggested 10 yard bonus following a fair catch."},{"metadata":{"trusted":true,"_uuid":"9c9ffe460acdcfa74fa20ffb322bf43d25176ab7"},"cell_type":"code","source":"\n#Finally, we will discuss how we came to the conclusion that a 10 yard fair catch bonus is optimal for qualified plays\nreturn_yards_for_qualified_plays <- plot_distribution_by_filter(datain = punt_loc_df_refined, filter_flag = \"qualified_plays\", metric = \"return_yards\", show_static_yl = 10, title_in = \"Distribution of return yards for qualified returns\")\nprint(return_yards_for_qualified_plays)\n\n\n\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"276e8e7dfbd6a0324b81f685da088c13b8b6b551"},"cell_type":"markdown","source":"As you can see, our suggested bonus value falls right on the approximate average return distance for these plays, and is slightly more than the median value.  The average is a bit higher than the median because of the effect of the right tail of infrequent yet long returns.  We chose to have the fair catch bonus approximate the average rather than the median because it means that, for an average team, most punts they would have originally chosen to return would actually result in slightly fewer than the 10 yards they are now awarded for a fair catch.  Yes, they give up the ability to break off a huge return, but in most scenarios, they get a slightly more beneficial end position than they would have by returning it, and they put their players at a lower risk of being injured.  Additionally, for the teams who have Devin Hesters of the return world, they are still able to return punts as they normally would.  In effect, we will push average punt return teams towards relying heavily on the fair catch bonus, while still allowing  teams with explosive returners to utilize those player's skills.\n\nNow, we will go over the last bit of this analysis - the estimation of how much this new rule could decrease punt related concussions in the NFL.  This part is actually quite simple.  \n\n"},{"metadata":{"_uuid":"efec02d3b65f6020e676c6251e3c39702500353f","trusted":true},"cell_type":"code","source":"#The following operation is simple, but looks complicated. Description of the math can be found below\npct_returns_lte_10 <- round(nrow(punt_loc_df_refined[punt_loc_df_refined$qualified_plays == 1 & punt_loc_df_refined$punt_returned == 1 & punt_loc_df_refined$return_yards <= 10, ])/nrow(punt_loc_df_refined[punt_loc_df_refined$qualified_plays == 1 & punt_loc_df_refined$punt_returned == 1,]), 2) * 100\nprint(paste(pct_returns_lte_10, \"% of returns on plays which would qualify for our new fair catch rule end up netting >= 10 yards\", sep = \"\"))\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"6cbc9b13718d8a11dde2e4e3c90a080079c3fe89"},"cell_type":"markdown","source":"Lets go over the math above.  Essentially, we are dividing the number of plays which \n* occurred during a play which would qualify for the new fair catch bonus\n* had an attempted return\n* had a net return gain of less than or equal to 10 yards\n\nby the number of plays which:\n\n* occurred during a play which would qualify for the new fair catch bonus\n* had an attempted return\n\nThe math here shows that in the '16-'17 seasons, for those plays where the fair catch bonus would be active, a whopping 66% of returns went for less than or equal to the distance they would receive by opting to take a fair catch.  \n\nNow, lets circle back to the fact that 30 of 37 (81%) of punt related concussions occurred on these qualified plays.  Now let's assume an unlikely scenario: coaches across the league directed their players to call for a fair catch 100% of the time when the fair catch bonus is active.  In this scenario, the concussion rate from those plays would now approximate the concussion rate of fair catch plays.  However, to be more broad, we will also take into account all non return outcome plays, because we do not have a crystal ball to see into the future to know that those plays would all be fair catches (some kicks may go OOB, end in touchbacks, or fair catches.)\n\nSo, to approximate our concussion rate for this new hypothetical set of plays which would now become non- return plays, we have to go back to the original data with all punts, regardless of whether or not the ball was punted.  \n"},{"metadata":{"trusted":true,"_uuid":"a8fcf4404f54d26c386bf32f5e52501281c68318"},"cell_type":"code","source":"#concussion rate during qualified plays with a return\nqualified_non_return_concussion_rate <- sum(punt_loc_df[punt_loc_df$qualified_plays == 1 & punt_loc_df$punt_returned == 0, \"concussion\"])/nrow(punt_loc_df[punt_loc_df$qualified_plays == 1 & punt_loc_df$punt_returned == 0, ])\n#concussion rate during qualified plays without a return\nqualified_return_concussions_rate <- sum(punt_loc_df[punt_loc_df$qualified_plays == 1 & punt_loc_df$punt_returned == 1, \"concussion\"])/nrow(punt_loc_df[punt_loc_df$qualified_plays == 1 & punt_loc_df$punt_returned == 1, ])\n#so, it looks like qualified plays without a return result in about 1/10th the number of concussions as plays with a return.\n#now, lets assume this new body of qualified plays with a return instead had this non-return concussion profile.  What would our net concussion count be\nplays_effected <- nrow(punt_loc_df[punt_loc_df$qualified_plays == 1 & punt_loc_df$punt_returned == 1, ])\nnew_speculative_concussion_count <- plays_effected * qualified_non_return_concussion_rate\nprint(paste(\"If all qualified punt plays with a return were to now be turned into non-return plays, we could assume that body of plays would have had \", new_speculative_concussion_count, \" concussions instead of the actual 25\"))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"52e7f6e3507c5277c46d17756331575b665c4709"},"cell_type":"markdown","source":"In this hypothetical world, where all qualified returns become fair catches (or some other non-return result), we would theoretically replace 25 concussions with only 2.5, which for the sake of assuming more than one hemisphere can be concussed, we will round up to 3.  This leads us to a net decrease of 22 concussions from the original 37, which equates to a 60% decrease\n\nNow, let's snap out of that hypothetical world and instead assume that players and coaches simply play the odds, and take the fair catch 66%, or 2/3 of the time, which we believe is a safe estimate.  We can do some simple math, similar to the operations above, to come to a more reasonable estimate.\n\nI'm not going to do any random/bootstrap sampling here, just going to approximate the result using our understanding of the relative frequency of concussions during qualified return plays vs non-return plays.  We know that any given qualified play with a return has a 0.981% chance to result in a concussion, and a qualified non return play has a .1% chance of resulting in a concussion.  Let's do the math below.\n"},{"metadata":{"trusted":true,"_uuid":"88036989f2164858452a53e96a60f93e4fde5e53"},"cell_type":"code","source":"#So, lets take 66% of the qualified return plays, and apply the non return concussion probability \nnew_concussion_count_non_return <- nrow(punt_loc_df[punt_loc_df$qualified_plays == 1 & punt_loc_df$punt_returned == 1, ]) * .66 * .001\n#On those 2/3 of previously returned plays, we could expect to see about 1.68 concussions\nnew_concussion_count_return <- nrow(punt_loc_df[punt_loc_df$qualified_plays == 1 & punt_loc_df$punt_returned == 1, ]) * .33 * .00981\n#On that 1/3rd of qualified plays that remain returns, we could expect to see a total of about 8.25 concussions","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"995fa32d4eedb7c6fd7c42693e5836326f0cc818"},"cell_type":"markdown","source":"So, with a 66% adoption rate on qualified plays that previously had a return, we could expect to see 1.68 + 8.25, or about 10 concussions instead of the actual 25.  This leads us to a reasonable speculated net decrease of about 15 out of the 37 concussions, or 40%.  \n"},{"metadata":{"_uuid":"c0a46f2f8e7195fb1f6c75932a4b26c4e034f55c"},"cell_type":"markdown","source":"Additionally, below you can see a function which can be used to see how adjusting the parameters of this rule wold effect approximate concussion rate and the average field position resulting from all punts.  The modifiable parameters are the distance of fair catch incentive, and max LOS position required for the bonus to be active.  Generally, increasing the fair catch incentive would decrease concussion rate and increase average starting position.  Decreasing the max LOS yard line for the fair catch bonus to be active would generally decrease concussion rate and increase the average starting position.   More information can be found in the comments below.\n\nHappy optimizing!"},{"metadata":{"trusted":true,"_uuid":"b41139c05f723c191301aca83ede774096433bb9"},"cell_type":"code","source":"#You can use this function to tweak the rule parameters I suggested: yards awarded for fair catch, and field position (yard line) at which the bonus is active.\n#Decreasing the maximum punting team field position required would, in effect, decrease the number of punts where the fair catch bonus is active.  Therefore, fewer plays would qualify and the bonus would have less of an overall impact on the game, but also less of a overall decrease in concussions as a result.\n#SImilarly, decreasing the yard bonus awarded to a qualifying fair catch would decrease the frequency at which return teams choose to take the fair catch.  If the bonus were 3 yards instead of 10, you can imagine why that incentive would be much less appealing.\n#The input required is that dataframe output from my pre-proccessing above, a value for the fair catch bonus yards (fcy_param), and a value for the field position param (los_param), measured as the maximum distance from kicking teams endzone at which the bonus can still be active.\n#So, changing los_param to 35 and fcy_param to 15 would mean only punts with a LOS < the kicking team's 35 YL would qualify, and the fair catch bonus would be awarded.  In this example, the fair catch bonus would be 15 yards\n#output data includes the following: estimated decrease in the # and % of concussions, the number of punt plays that would have qualified for the bonus,an estimate of the number of plays that would no longer be returns because of the fair catch incentive, an estimate on the net field position change per punt that would occur on all qualified punt plays, and an estimate on the net field position difference per punt across all punt plays.\n#In most cases, you can iamgine the net field position increases by a yard or 2.  However, if you were to jack up the bonus to something extreme, like 25 yards, that difference becomes much more pronounced.\n#I make 2 major assumptions in the calculation of these estimates, and I believe they are safe assumptions.\n#Assumption 1: The decision to make a fair catch instead of chosing to return is related directly to the fair catch bonus provided. I assume coaches and players will react in a way that aproximates rational.  Meaning that if the fair catch bonus is 10 yards, and 66% of punt returns on qualified plays are <=10 yards, then they will choose to fair catch instead on approximately 66% of plays that were previously return plays. This wont be 100% accurate, but will certainly approximate the real outcome.\n#Assumption 2: Concussion rates on plays which are enwly incentivized to be fair catches (or otherwise non-return plays) will approximate the concussion rate on historical non-return punt plays.\n#Have fun!\ntweak_params <- function(df_in = NULL, fcy_param = 10, los_param = 45){\n  \n  df_in <- as.data.frame(df_in)\n  \n  df_in$test_qualified_plays <- ifelse(df_in$within_2m_warning == 0 & df_in$dist_from_own_ez < los_param, 1, 0)\n  \n  \n  qualified_non_return_concussions <- sum(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 0, \"concussion\"])\n  qualified_return_concussions <- sum(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, \"concussion\"])\n  \n  qualified_non_return_concussion_rate <- sum(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 0, \"concussion\"])/nrow(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 0, ])\n  #concussion rate during qualified plays without a return\n  qualified_return_concussions_rate <- sum(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, \"concussion\"])/nrow(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, ])\n  #so, it looks like qualified plays without a return result in about 1/10th the number of concussions as plays with a return.\n  #now, lets assume this new body of qualified plays with a return instead had this non-return concussion profile.  What would our net concussion count be\n  plays_effected <- nrow(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, ])\n  new_speculative_concussion_count <- plays_effected * qualified_non_return_concussion_rate\n  #\n  pct_lte_fc_bonus <- nrow(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1 & df_in$return_yards <= fcy_param, ])/nrow(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, ]) \n  \n  \n  #calc'ing concussion related metrics\n  new_concussion_count_non_return <- nrow(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, ]) * pct_lte_fc_bonus * .001\n  new_concussion_count_return <- nrow(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, ]) * (1 - pct_lte_fc_bonus) * .00981\n  original_cc_count_qual <- sum(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, \"concussion\"])\n  new_cc_count <- new_concussion_count_return + new_concussion_count_non_return\n  qual_cc_decrease <- original_cc_count_qual - new_cc_count\n  cc_decrease_pct <- qual_cc_decrease/sum(df_in$concussion)\n  \n  #calc'ing how net field position may change...\n  #first, going to sample whatever percent decrease in returns from a return yard vector of all qualified return plays.  Going to take the sum of those yards, then subtract it from number of predicted returns that are now fc * yard incentive\n  yard_sample <- sample(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, \"return_yards\"], (nrow(df_in[df_in$test_qualified_plays == 1 & df_in$punt_returned == 1, ]) * pct_lte_fc_bonus))\n  yard_delta <- (length(yard_sample) * fcy_param) - sum(yard_sample)\n  yard_delta_per_play <- yard_delta/length(yard_sample)\n  #lastly, we also want to factor in all those qualified fair catches that would have been made anyway, and the net effect that bonus has on the net yards per punt\n  original_fc <- nrow(df_in[df_in$test_qualified_plays == 1 & df_in$fair_catch == 1, ])\n  original_fc_extra_yards <- original_fc * fcy_param\n  \n  total_yard_delta <- original_fc_extra_yards + yard_delta\n  \n  total_yard_change_per_play <- total_yard_delta/nrow(df_in)\n  \n  total_yard_change_per_qualified_play <- total_yard_delta/nrow(df_in[df_in$test_qualified_plays == 1, ])\n  \n  fin_obj <- list()\n  \n  fin_obj$overall_concussion_decreased <- qual_cc_decrease\n  fin_obj$new_concussion_estimate <- new_cc_count\n  fin_obj$concussion_overall_pct_decrease <- cc_decrease_pct\n  fin_obj$plays_qualified <- sum(df_in$test_qualified_plays)\n  fin_obj$concussions_on_qualified_plays <- sum(df_in[df_in$test_qualified_plays == 1, \"concussion\"])\n  fin_obj$extra_yards_per_converted_return <- yard_delta_per_play\n  fin_obj$extra_yards_per_qualified_play <- total_yard_change_per_qualified_play\n  fin_obj$extra_yards_per_punt_overall <- total_yard_change_per_play\n  \n  \n  \n  return(fin_obj)\n  \n}","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"ad35beb66193e942d30754b968cfb9f59cd41165"},"cell_type":"markdown","source":"**Final Thoughts...**\n\nIf you have stuck with us throughout this analysis, first of all, thank you.  We wanted to make sure every step was spelled out thoroughly so that perhaps down the line, someone else can make use of our analysis and extrapolate it to new data sets or scenarios.  \n\nAt the beginning, we mentioned the importance of proposing a solution that is objective and simple to apply at scale.  When I look at this problem and our resulting analysis, I think of an implementation scale that is far beyond the well oiled business that is the NFL.  The reality is that, while the NFL is the most visible and lucrative segment of American football, professional players only represent a sliver of the people who play organized tackle football on any given year.  As such, the 37 concussions we are trying to reduce also only represents a sliver of the punt related concussions every year in America.  If nothing else comes out of this competition and analysis, I hope at the very least the NFL chooses to promote rules that are easily passed down to all levels of football.   I played football for just under 10 years of my life, and went on to play rugby in college.  I love those games, and wouldn't trade a second of it, but participation wasn't without it's cost.  Between the two sports, I racked up 2 concussions - the second leading to a diagnosis of Post-Concussive-syndrome, and the end of my time playing contact sports.  I can attest to how concussions are more than just an injury.  They can change who you are and how you look at the world.  \n\nFor every concussion averted because of these new, hopefully scalable rules, there is going to be some kid, somewhere in America, that doesn't have to go through that hell.  At risk of sounding melodramatic, this analysis and the time we put into it as much for them as it is for the NFL, if not more.  \n\nThanks again for your time, and GO BEARS!"},{"metadata":{"_uuid":"0c2706684c5c68e4a321196835fe884c9581d23d"},"cell_type":"markdown","source":""},{"metadata":{"_uuid":"099941fc32c1f6e9d555072451c6d5a811be0acb"},"cell_type":"markdown","source":""}],"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}