{"cells":[{"metadata":{"_uuid":"7168c57c0794eec3f5e4eb1130ddc1d5b095509a"},"cell_type":"markdown","source":"**Greg Ackerman**\n**GregALytics@u.northwestern.edu**\n**Phoenix, AZ**\n\nUpon first viewing the concussions data set, I expected that most concussions occurred from impactful hits on a tackle from helmet-to-helmet contact. To my surprise, there were nearly as many concussions on blocks as tackles. Therefore, this kernel focuses on development of an NFL rule that will suppress concussions on blocks. "},{"metadata":{"_uuid":"051a6a05a7014328d99246c84595c3c4f3318ab9","_execution_state":"idle","trusted":true,"_kg_hide-output":true},"cell_type":"code","source":"## Importing packages\nlibrary(readr)\nlibrary(dplyr)\nlibrary(ggplot2)\nlibrary(lubridate)\nlibrary(tidyr)\nlibrary(scales)\nlibrary(gganimate)\nlibrary(tidyverse)\nlibrary(cowplot)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"78b722ace478a0a0b0b5771f39c7460391a5c9c2"},"cell_type":"markdown","source":"First, I import data on games, play info, player roles, and video review of concussion plays. For ease of filtering, I added a column for the kicking and return team in the player role data. \n"},{"metadata":{"trusted":true,"_uuid":"a219e53e3236814097f744dd58a80ba08ce06f50","_kg_hide-output":true},"cell_type":"code","source":"#Load Non NGS Data \ngame_data <- read_csv(\"../input/game_data.csv\", col_types = cols(Start_Time = col_time(format = \"%H:%M\"))) %>% \n                    mutate(Game_Date = ymd(Game_Date))\n                    \nplay_info <- read_csv(\"../input/play_information.csv\", \n                      col_types = cols(Game_Clock = col_time(format = \"%H:%M\"))) %>% mutate(Game_Date = mdy(Game_Date)) \n                      \nplayer_role_data <- read_csv(\"../input/play_player_role_data.csv\") %>% \n  dplyr::mutate(Team = ifelse(Role %in% c('VR','VRo','VRi', \n                                          'VL','VLi','VLo',\n                                          'PDM',\n                                          'PDR1','PDR2','PDR3','PDR4','PDR5','PDR6',\n                                          'PDL1','PDL2','PDL3','PDL4','PDL5','PDL6',\n                                          'PLR','PLR1','PLR2','PLR3',\n                                          'PLM','PLM1',\n                                          'PLL','PLL1','PLL2','PLL3',\n                                          'PFB','PR'), \n                              \"Return Team\", \"Kicking Team\"))\n                      \nvideo_review <- read_csv(\"../input/video_review.csv\")\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"4ebac204b52812788e987a8610a58ec98c730d41"},"cell_type":"markdown","source":"First, I looked at the action of players who were injured on punts. 18 concussions occurred on a block, while 19 occurred on a tackle."},{"metadata":{"trusted":true,"_uuid":"10f5e9cd10a8b917e10d7c50fb1c5c1f45fd56ab"},"cell_type":"code","source":"video_review %>% ggplot(aes(x = Player_Activity_Derived, fill = Player_Activity_Derived)) + \n      geom_bar() +\n      geom_text(stat='count', aes(label=..count..), vjust=-0.7) +\n      scale_fill_discrete(guide=FALSE) +\n      ggtitle(\"Count of Concussion Plays by Play Type\") +\n      theme(plot.title = element_text(hjust = 0.5))","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":false,"_uuid":"87317449e4557c6bd31f1bd6228dda7e50c93a6f"},"cell_type":"markdown","source":"gganimate is a very useful tool in visualizing a play. I wrote a function that inputs Next-Gen Stats raw data and shows all motions on the field, using the help of the NFL's tutorial in the Big Data Bowl. This isn't working in this kernel, but was very influential in my research process, so I will keep the code here and maybe I will get it working in this kernel or another."},{"metadata":{"trusted":true,"_uuid":"0be0b8984ea3c377a55ee1c44ab1a52bb832994e","_kg_hide-output":true},"cell_type":"code","source":"#Example usage \nNGS_temp <- read_csv(\"../input/NGS-2016-reg-wk1-6.csv\", \n                           col_types = cols(Event = col_character(), \n                                            Time = col_character())) %>%\n                        filter(GameKey == 144, PlayID == 2342) %>%\n                        inner_join(player_role_data) \nxmin <- 0\nxmax <- 160/3\nhash.right <- 38.35\nhash.left <- 12\nhash.width <- 3.3\n\n\n## Specific boundaries for a given play\nymin <- 0\nymax <- 120\ndf.hash <- expand.grid(x = c(0, 23.36667, 29.96667, xmax), y = (10:110))\ndf.hash <- df.hash %>% filter(!(floor(y %% 5) == 0))\ndf.hash <- df.hash %>% filter(y < ymax, y > ymin)\n\n#Function to graph a play \ngraph_play <- function(play_NGS) {\n  play_NGS %>% \n    ggplot(aes(x = xmax - y, y = x, fill = Team, label = Role)) + \n    geom_point(size = 10, aes(color = Team)) +  ylab(\"Yardline\") +\n    xlab(\"Distance from Sideline\") +\n    annotate(\"text\", x = df.hash$x[df.hash$x < 55/2], \n             y = df.hash$y[df.hash$x < 55/2], label = \"_\", hjust = 0, vjust = -0.2) + \n    annotate(\"text\", x = df.hash$x[df.hash$x > 55/2], \n             y = df.hash$y[df.hash$x > 55/2], label = \"_\", hjust = 1, vjust = -0.2) + \n    annotate(\"segment\", x = xmin, \n             y = seq(max(10, ymin), min(ymax, 110), by = 5), \n             xend =  xmax, \n             yend = seq(max(10, ymin), min(ymax, 110), by = 5)) + \n    annotate(\"text\", x = rep(hash.left, 11), y = seq(10, 110, by = 10), \n             label = c(\"G   \", seq(10, 50, by = 10), rev(seq(10, 40, by = 10)), \"   G\"), \n             angle = 270, size = 4) + \n    annotate(\"text\", x = rep((xmax - hash.left), 11), y = seq(10, 110, by = 10), \n             label = c(\"   G\", seq(10, 50, by = 10), rev(seq(10, 40, by = 10)), \"G   \"), \n             angle = 90, size = 4) + \n    annotate(\"segment\", x = c(xmin, xmin, xmax, xmax), \n             y = c(ymin, ymax, ymax, ymin), \n             xend = c(xmin, xmax, xmax, xmin), \n             yend = c(ymax, ymax, ymin, ymin), colour = \"black\") +\n    transition_time(ymd_hms(Time))}\n\n\ngraph_play(NGS_temp)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"607699b09be594a6827c3eafa36e4d5257a01d73"},"cell_type":"markdown","source":"It is important to understand the formations of the kicking and return team. The kicking team generally speaking has a very similar formation on every play featuring 8 men in the box including 5 on the line. The most notable feature of the kicking team is two gunners (GL, GR) who try to get to the returner as quickly as possible. The punt return team is where things get interesting. Return teams usually have 2-4 jammers (VL, VR) protecting against the gunners. The more jammers the return team has, the slower the speed of the gunners. In the play below, the return team has two jammers focused on slowing down the right gunner (GR) for a hopeful punt return. "},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"d8ab7dd87b0b78b852ee3de40ecd204872ebebbc"},"cell_type":"code","source":"NGS_temp %>% filter(Event == \"line_set\") %>% ggplot(aes(x = xmax - y, y = x, fill = Team, label = Role)) + \n    geom_label(size = 2) +\n    ylab(\"Yardline\") + \n    xlab(\"L-R position\") + \n    annotate(\"text\", x = df.hash$x[df.hash$x < 55/2], \n             y = df.hash$y[df.hash$x < 55/2], label = \"_\", hjust = 0, vjust = -0.2) + \n    annotate(\"text\", x = df.hash$x[df.hash$x > 55/2], \n             y = df.hash$y[df.hash$x > 55/2], label = \"_\", hjust = 1, vjust = -0.2) + \n    annotate(\"segment\", x = xmin, \n             y = seq(max(10, ymin), min(ymax, 110), by = 5), \n             xend =  xmax, \n             yend = seq(max(10, ymin), min(ymax, 110), by = 5)) + \n    annotate(\"text\", x = rep(hash.left, 11), y = seq(10, 110, by = 10), \n             label = c(\"G   \", seq(10, 50, by = 10), rev(seq(10, 40, by = 10)), \"   G\"), \n             angle = 270, size = 4) + \n    annotate(\"text\", x = rep((xmax - hash.left), 11), y = seq(10, 110, by = 10), \n             label = c(\"   G\", seq(10, 50, by = 10), rev(seq(10, 40, by = 10)), \"G   \"), \n             angle = 90, size = 4) + \n    annotate(\"segment\", x = c(xmin, xmin, xmax, xmax), \n             y = c(ymin, ymax, ymax, ymin), \n             xend = c(xmin, xmax, xmax, xmin), \n             yend = c(ymax, ymax, ymin, ymin), colour = \"black\") \n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"8aa8a6ac98d5467205a17d86e9577fdcd3f2b05f"},"cell_type":"markdown","source":"Player role data allows us to see how many jammers the return team has on a play, as well as other positions. Isolating the jammers, about 46% of plays have two jammers, being one on each side. About 30% have 3 jammers, which forces a less symmetric field, and 23% have 4 jammers. "},{"metadata":{"trusted":true,"_uuid":"10ac76ab4bbfbf00d9e237c2d83fdd4598f0d8d6"},"cell_type":"code","source":"player_role_data %>% filter(Team == \"Return Team\") %>%\n  mutate(Role_Name = ifelse(substr(Role, 1, 2) %in% c(\"VL\",\"VR\"), \"Vs\",\n  ifelse(substr(Role, 1, 3) %in% c(\"PDR\",\"PDL\"), \"PDs\",\n  ifelse(substr(Role, 1, 3) %in% c(\"PLL\",\"PLR\",\"PLM\",\"PFB\"), \"PLs\",\"PFB\")))) %>%\n  group_by(Season_Year, GameKey, PlayID, Role_Name) %>%\n  summarise(Players = n_distinct(Role)) %>%\n  spread(Role_Name, Players) %>%\n  group_by(Vs) %>% \n  summarise(plays = n_distinct(PlayID))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"6588152db44700a6a3cf27f1d73f5ae835cc4f28"},"cell_type":"markdown","source":"Among the concussion plays in the data set, there is a similar number of jammers amongst all plays. However, we must consider that there are significantly more plays with 2 Jammers. 0.6% of plays with 2 jammers had concussions, .8% with 3, and 1% with 4 had concussions. While these numbers are super small, you would expect to see more concussions on plays with 2 jammers because the speeds of gunners should be greater. This is likely because a rule already exists to protect a punter if there is too much pressure - a fair catch. "},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":false,"trusted":true,"_uuid":"92fa1c594f34f45950a2a853b2af8a85104c93b3"},"cell_type":"code","source":"concussion_plays <- video_review %>% select(Season_Year, GameKey, PlayID)\n\nplayer_role_data %>% inner_join(concussion_plays) %>% filter(Team == \"Return Team\") %>%\n  mutate(Role_Name = ifelse(substr(Role, 1, 2) %in% c(\"VL\",\"VR\"), \"Vs\",\n                            ifelse(substr(Role, 1, 3) %in% c(\"PDR\",\"PDL\"), \"PDs\",\n                                   ifelse(substr(Role, 1, 3) %in% c(\"PLL\",\"PLR\",\"PLM\",\"PFB\"), \"PLs\",\"PFB\")))) %>%\n  group_by(Season_Year, GameKey, PlayID, Role_Name) %>%\n  summarise(Players = n_distinct(Role)) %>%\n  spread(Role_Name, Players) %>%\n  group_by(Vs) %>% \n  summarise(plays = n_distinct(Season_Year, GameKey, PlayID)) %>% \n  ggplot(aes(x = Vs, y = plays, fill = Vs)) + geom_bar(stat = \"identity\") + \n  geom_text(aes(label=plays), position=position_dodge(width=0.9), vjust=-0.25)+\n  scale_fill_continuous(guide=FALSE) +\n  xlab(\"Jammers\") +\n  ggtitle(\"Jammer Counts of 37 Concussion Plays - 2016 & 2017\")+\n  theme(plot.title = element_text(hjust = 0.5))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"66b27250850650b545066c338147b189634b5b92"},"cell_type":"markdown","source":"If we filter the concussion plays when the player's derived activity is blocking or blocked, only 4/18 come with 2 jammers, no change to the total sample from earlier. It at least appears there could be some relationship between the number of jammers and concussions on a block. "},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"bc4227f8868a5a66e90d4ecdb1e5a48cec16b825"},"cell_type":"code","source":"concussion_plays <- video_review %>% select(Season_Year, GameKey, PlayID, Player_Activity_Derived)\n\n\nplayer_role_data %>% inner_join(concussion_plays) %>% \n  filter(Team == \"Return Team\", Player_Activity_Derived %in% c(\"Blocking\", \"Blocked\")) %>%\n  mutate(Role_Name = ifelse(substr(Role, 1, 2) %in% c(\"VL\",\"VR\"), \"Vs\",\n                            ifelse(substr(Role, 1, 3) %in% c(\"PDR\",\"PDL\"), \"PDs\",\n                                   ifelse(substr(Role, 1, 3) %in% c(\"PLL\",\"PLR\",\"PLM\",\"PFB\"), \"PLs\",\"PFB\")))) %>%\n  group_by(Season_Year, GameKey, PlayID, Role_Name) %>%\n  summarise(Players = n_distinct(Role)) %>%\n  spread(Role_Name, Players) %>% \n  group_by(Vs) %>% \n  summarise(plays = n_distinct(Season_Year, GameKey, PlayID)) %>% \n  ggplot(aes(x = Vs, y = plays, fill = Vs)) + geom_bar(stat = \"identity\") + \n  geom_text(aes(label=plays), position=position_dodge(width=0.9), vjust=-0.25)+\n  scale_fill_continuous(guide=FALSE) +\n  xlab(\"Jammers\")\n  ggtitle(\"Jammer Counts of 18 Blocking Concussion Plays - 2016 & 2017\")+\n  theme(plot.title = element_text(hjust = 0.5))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"d53a25732f01fda67ea6f6a10dd66cfdd4666baf"},"cell_type":"markdown","source":"So, is this due to random variation, or is there actually some substance here? This is where Next-Gen Stats data comes in handy. There are two simple approaches to take to evaluate randomness - evaluating the speed of the injured or injuring player, as well as seeing the roles of the players who are actually involved on the injury to determine if they are flukey or not. So, I set out to get the NGS data for all concussion plays, but I also filter the data set so that it only includes motions between the snap and the end of the play (tackle, fair catch, etc). Ultimately, I end up with a NGS data frame, as well as a summary table with the player roles, injured player and primary partner speeds, and snap distances between players at the time of the snap. Speed is a conversion to mph, while I calculated distance between the players at the time of the snap using euclidean distance between the x and y coordinates of the primary player and partner. "},{"metadata":{"_kg_hide-output":true,"trusted":true,"_uuid":"2fd6b984e58ee407dc275e5f46200c480554395a"},"cell_type":"code","source":"rm(NGS_temp)\n\n#Find all plays with concussions\nplay_finder <- video_review %>%\n                select(Season_Year,GameKey,PlayID)\n\n#Get all the NGS data for concussion plays\nplay_ngs <- read_csv(\"../input/NGS-2016-reg-wk13-17.csv\", \n         col_types = cols(Event = col_character(), \n                          Time = col_character())) %>% inner_join(play_finder) %>%\n  rbind(read_csv(\"../input/NGS-2016-reg-wk1-6.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder)) %>%\n  rbind(read_csv(\"../input/NGS-2016-reg-wk7-12.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder)) %>%\n  rbind(read_csv(\"../input/NGS-2017-reg-wk1-6.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder)) %>%\n  rbind(read_csv(\"../input/NGS-2017-reg-wk7-12.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder)) %>%\n  rbind(read_csv(\"../input/NGS-2017-reg-wk13-17.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder)) %>%\n  rbind(read_csv(\"../input/NGS-2017-post.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder)) %>%\n  rbind(read_csv(\"../input/NGS-2017-pre.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder)) %>%\n  rbind(read_csv(\"../input/NGS-2016-post.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder)) %>%\n  rbind(read_csv(\"../input/NGS-2016-pre.csv\", \n                 col_types = cols(Event = col_character(), \n                                  Time = col_character())) %>% inner_join(play_finder))\n\n#Get times of snap\nball_snap <- play_ngs %>% filter(Event == \"ball_snap\") %>% \n  mutate(ball_snap_time = Time) %>%\n  select(Season_Year, GameKey, PlayID, ball_snap_time) %>% \n  unique()\n\n#get times of end of play (tackle, fair catch, etc.)\nplay_ends <- play_ngs %>% \n  filter(Event %in% c(\"tackle\", \"out_of_bounds\", \"punt_downed\", \"fair_catch\", \"touchdown\",\"touchback\")) %>%\n  mutate(play_end = Time) %>%\n  select(Season_Year, GameKey, PlayID, play_end) %>%\n  unique()\n\n#NGS data now clean of pre-snap shenanigans\nplay_ngs <-\n  play_ngs %>% \n  inner_join(ball_snap) %>%\n  left_join(play_ends) %>% \n  filter(Time >= ball_snap_time, Time <= play_end) %>% \n  arrange(Season_Year, GameKey, PlayID, Time, GSISID) %>%\n  select(-ball_snap_time) %>%\n  group_by(Season_Year, GameKey, PlayID, GSISID) %>%\n  mutate(frame_id = 1:n()) %>%\n  inner_join(player_role_data) %>%\n  mutate(speed = 10 * dis * 2.04545)\n\n\n#Injuring Player Roles \nip <- video_review %>% \n  mutate(GSISID = as.numeric(Primary_Partner_GSISID)) %>% \n  inner_join(player_role_data) %>%\n  mutate(injuring_player_role = Role) %>%\n  select(Season_Year, GameKey, PlayID, injuring_player_role)\n\n#Speed of injured player\ngsisid_speed <- video_review %>%\n  select(Season_Year, GameKey, PlayID, GSISID, Player_Activity_Derived) %>%\n  inner_join(play_ngs) %>%\n  group_by(Season_Year, GameKey, PlayID, Player_Activity_Derived, Role) %>%\n  summarise(gsisid_median_speed = median(speed),\n            gsisid_mean_speed = mean(speed)) \n\n#speed of primary partner\npartner_speed <- video_review %>%\n  mutate(GSISID = as.integer(Primary_Partner_GSISID)) %>%\n  select(Season_Year, GameKey, PlayID, GSISID) %>% \n  inner_join(play_ngs) %>%\n  group_by(Season_Year, GameKey, PlayID, Role) %>%\n  summarise(partner_median_speed = median(speed),\n            partner_mean_speed = mean(speed)) %>%\n  select(-Role)\n\n# Number of Jammers and linemen on punts\nreturn_groups <- video_review %>% \n  select(Season_Year, GameKey, PlayID, Player_Activity_Derived) %>% \n  inner_join(player_role_data) %>%\n  inner_join(play_ngs) %>%\n  filter(Team == \"Return Team\", Role != \"PR\") %>%\n  mutate(Role_Name = ifelse(substr(Role, 1, 2) %in% c(\"VL\",\"VR\"), \"Vs\",\n                            ifelse(substr(Role, 1, 3) %in% c(\"PDR\",\"PDL\"), \"PDs\",\n                                   ifelse(substr(Role, 1, 3) %in% c(\"PLL\",\"PLR\",\"PLM\",\"PFB\"), \"PLs\",\n                                          \"PFB\")))) %>%\n  group_by(Season_Year, GameKey, PlayID, Role_Name) %>%\n  summarise(Players = n_distinct(Role)) %>%\n  spread(Role_Name, Players) \n\n\n#Distance between players at the snap \ndistances <- video_review %>% \n  select(Season_Year, GameKey, PlayID, GSISID, Player_Activity_Derived, Primary_Impact_Type) %>% \n  rbind(video_review %>%\n          mutate(GSISID = Primary_Partner_GSISID, Player_Activity_Derived = Primary_Partner_Activity_Derived) %>%\n          select(Season_Year, GameKey, PlayID, GSISID, Player_Activity_Derived, Primary_Impact_Type)) %>%\n  mutate(GSISID = as.numeric(GSISID)) %>%\n  inner_join(play_ngs) %>%\n  inner_join(player_role_data) %>%\n  filter(Event == \"ball_snap\") %>%\n  group_by(Season_Year, GameKey, PlayID) %>%\n  summarise(x1 = max(x), x2 = min(x), y1 = max(y), y2 = min(y)) %>%\n  mutate(snap_distance = sqrt((x1 - x2)**2 + (y1 - y2)**2)) %>%\n  select(Season_Year, GameKey, PlayID, snap_distance)\n\n#Create a centralized data set with all joins performed\nvid_data <- video_review %>% inner_join(player_role_data) %>%\n  select(-Turnover_Related, -Friendly_Fire, -GSISID, - Primary_Partner_GSISID) %>%\n  left_join(ip) %>%\n  left_join(gsisid_speed) %>%\n  left_join(partner_speed) %>%\n  left_join(return_groups) %>%\n  left_join(distances)\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"0fac012c5c8c5eb041afdee5f0028847cd96d999"},"cell_type":"markdown","source":"I am ready to analyze the NGS data. I am no physics expert, but I'll make an assumption that high-impact collisions are more dangerous than low-impact collisions. Therefore, I first want to take a look at the median speeds of the primary partner, to get an idea of how fast they are going when injuring the primary player. I look at this by the number of jammers.  \n\nMy first look shows tackling plays, including tackling concussions. This suggests that plays with 2 and 4 jammers saw injuring players going at lower speeds, while the 3 jammer plays (not as symmetrical) had the impacting players going fast. However, tackling concussions should almost always be on a high impact collision, while that may not be the case for a block.\n"},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"38badafda41b1820d8295f0d9db443125abc11bc"},"cell_type":"code","source":"vid_data %>% filter(Player_Activity_Derived %in% c(\"Tackled\",\"Tackling\")) %>%\n                      ggplot(aes(x = as.factor(Vs), y = partner_median_speed)) + \n                      geom_boxplot() + \n                      xlab(\"Jammers\") + \n                      ylab(\"Median Speed of Partner on a Given Play\") + \n                      ggtitle(\"BoxPlots of Median Partner Speed - Tackles\") +\n                      theme(plot.title = element_text(hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"93915f83f013208344d5ad0781123dc1d0e2f1e8"},"cell_type":"markdown","source":"Next, I view the median partner speeds on blocks. The 2 jammer formations had much lower median speeds than the 3 and 4 jammer formations. A lower impact collision may mean  incidental contact or foul play related than a pure \"hit\". This supports my notion that limiting the number of jammers to two would help minimize danger on punt blocks. "},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"62dda633cae6ff4efe95b02ff931a79b2cca4bdb"},"cell_type":"code","source":"vid_data %>% filter(Player_Activity_Derived %in% c(\"Blocked\",\"Blocking\")) %>%\n  ggplot(aes(x = as.factor(Vs), y = partner_median_speed, fill = as.factor(Vs))) + \n  geom_boxplot() + \n  xlab(\"Jammers\") + \n  ylab(\"Median Speed of Partner on a Given Play\") + \n  ggtitle(\"BoxPlots of Median Partner Speed - Blocks\") +\n  theme(plot.title = element_text(hjust = 0.5),legend.position=\"none\")\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"2fc5ef01fae80f865fa5595347fb7b90ef941705"},"cell_type":"markdown","source":"![](http://a.video.nfl.com//films/vodzilla/153234/Punt_by_Kasey_Redfern-w6Cpit4D-20181119_152918853_5000k.mp4\n![image.png](attachment:image.png))","attachments":{}},{"metadata":{"_uuid":"61b7b96361d6ac5c8c308684d41bf4c63dfac607"},"cell_type":"markdown","source":"So, my suggested rule change is to restrict  the punt return team to either 0 or 2 total jammers (player outside hashmarks on line of scrimmage). If chosen to use 2 jammers, there must be one close to each sideline on the line of scrimmage. \n\nMy first concern with this rule change was with the fact that the punt returner is more susceptible to heavy hits by the gunners. This is mitigated by the ability to call a fair catch, which not only prevents the returner from being hit, but also limits the number of blocks on a particular play. \n\nIntegrity of the game is not a major concern here, as 46% of 2016 and 2017 punts already feature just two jammers from the return team, so I certainly feel this is a feasible rule change. That said, the NFL must consider the influence on touchdowns, fair catches, penalties, and long returns.\n\nTo evaluate this, I look at the player role data and play information table to obtain frequencies of touchdowns, fair catches, and penalties. "},{"metadata":{"trusted":true,"_uuid":"9c64f59bf944b2e6c46ae7344cf060e990d222ac"},"cell_type":"code","source":"#import play information\nplay_information <- read_csv(\"../input/play_information.csv\") \n\n#Search string for touchdowns, fair catches, fake punts, and penalties. This can be done with NGS, but this way is cheaper computationally\nplay_info <- play_information %>% select(Season_Year, GameKey, PlayID, PlayDescription) %>%\n                        mutate(fair_catch = str_detect(PlayDescription, \"fair catch\"),\n                               touchdown = str_detect(PlayDescription, \"TOUCHDOWN\"),\n                               fake_punt = str_detect(str_to_lower(PlayDescription), \"fake punt\"),\n                               penalties = str_detect(str_to_lower(PlayDescription), \"penalty\")) \n\n#Get number of Jammers on each play, and merge with play info\nresults <- player_role_data %>% \n  mutate(Role_Name = ifelse(substr(Role, 1, 2) %in% c(\"VL\",\"VR\"), \"Vs\",\n                            ifelse(substr(Role, 1, 3) %in% c(\"PDR\",\"PDL\"), \"PDs\",\n                                   ifelse(substr(Role, 1, 3) %in% c(\"PLL\",\"PLR\",\"PLM\",\"PFB\"), \"PLs\",\n                                          \"--\")))) %>%\n  filter(Role_Name == \"Vs\") %>%\n  group_by(Season_Year, GameKey, PlayID, Role_Name) %>%\n  summarise(Jammers = n_distinct(Role)) %>%\n  inner_join(play_info)\n\nresults %>% group_by(Jammers) %>% summarise(count = n_distinct(PlayID),\n                                            touchdowns = sum(touchdown),\n                                            touchdown_freq = percent(sum(touchdown)/n_distinct(PlayID)),\n                                            fair_catches = sum(fair_catch),\n                                            fair_catch_pct = percent(sum(fair_catch)/n_distinct(PlayID)),\n                                            penalties = sum(penalties),\n                                            penalty_frequency = percent(sum(penalties)/n_distinct(PlayID))) %>%\n                                  filter(Jammers %in% c(2,3,4))\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"01e231d0b8a2f986f05dc4e0d234acd4131b04aa"},"cell_type":"markdown","source":"Touchdowns are more common than concussions on punts, but not by much, so once again these are very small numbers. The touchdown percentage of punts with 2 jammers is lower than plays with greater than 2. So if we naively assume the true touchdown frequency of a 2 jammer formation is 0.793% on 4,869 punts, we'd expect approximately 39 touchdowns, which would be a 13 touchdown drop from the actual 52 touchdowns on punts in 2016 and 2017. \n\nFair catch percentage, on the other hand, changes drastically. 48.4% of plays with 2 jammers resulted in a fair catch, while it decreases to 23.7% for 3 jammers and 17% for 4. I tend to think that if there were only plays with 2 jammers, fair catch percentage on plays with 2 jammers may decrease because punt returners may take every opportunity they get when they think they have space, and hence some danger is gained back.  That said, the amount of fair catches overall would seem to drastically increase with the change. \n\nOn the plus side, with more fair catches, fewer returns mean fewer opportunities for penalties. The penalty frequency on 2 jammer plays is 20%, while 3 and 4 jammer plays have frequencies of 23% and 27%, respectively. Using a similarly naive approach as I did earlier, using a rate of 20.1% on 4,869 punts would have resulted in 976 penalties, which is 127 fewer than the actual 1,106. So while you may cut down on the excitement of 13 touchdowns, you at least prevent 127 penalties."}],"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}