{"cells":[{"metadata":{"_uuid":"ef10ac2a4e4afce0c503b50c410535ad1b40e615","_execution_state":"idle","trusted":true},"cell_type":"markdown","source":"# NFL Punt Analytics Competition"},{"metadata":{"_uuid":"2926e225e20769d76ab0f85f7e2ab565fd9c98ba"},"cell_type":"markdown","source":"## Objective: Propose a rule change on punt plays that can be shown to decrease the likelihood of an injury occurring. The rule must maintain the integrity of the game and be supported with data.\n\n## First, let’s look at what kind of collisions are causing concussions."},{"metadata":{"trusted":true,"_uuid":"fd15ff825586c126f64049628f055e6662c7df22"},"cell_type":"code","source":"concussion_play_info <- read.csv(\"../input/video_review.csv\",stringsAsFactors = FALSE)\nhead(concussion_play_info)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"74f5b74890a3fcbe1f6dfc8c53352787f2a5f857"},"cell_type":"code","source":"library(ggplot2)\nggplot(concussion_play_info,aes(Player_Activity_Derived))+geom_bar()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"ea9a7c2d57aead628e20d34b19d8ee972cf66383"},"cell_type":"code","source":"print(paste(\"Percentage of concussions from blocks:\",round(nrow(concussion_play_info[which(concussion_play_info$Player_Activity_Derived %in% c('Blocked','Blocking')),])/nrow(concussion_play_info),2)))\nprint(paste(\"Percentage of concussions from tackling:\",round(nrow(concussion_play_info[which(concussion_play_info$Player_Activity_Derived %in% c('Tackled','Tackling')),])/nrow(concussion_play_info),2)))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"f33e341be42b9555203f50bc597764ee37e78f71"},"cell_type":"markdown","source":"## It appears that 51% of concussions are caused from a tackling collision, and 49% of concussions are caused from a blocking collision. Let's dive deeper into these plays by pulling in the next gen stats."},{"metadata":{"trusted":true,"_uuid":"1fbf42f893ef5a972712b20f872c49928a494cb1"},"cell_type":"code","source":"# Get plays\nconcussion_plays <- concussion_play_info[,c('Season_Year','GameKey','PlayID')]\n# Get paths of next gen stats\nng_paths <- c(\"NGS-2016-pre.csv\",\"NGS-2016-post.csv\",\n              \"NGS-2016-reg-wk1-6.csv\",\"NGS-2016-reg-wk7-12.csv\",\n              \"NGS-2016-reg-wk13-17.csv\",\"NGS-2017-pre.csv\",\n              \"NGS-2017-post.csv\",\"NGS-2017-reg-wk1-6.csv\",\n              \"NGS-2017-reg-wk7-12.csv\",\"NGS-2017-reg-wk13-17.csv\")\n\n# Iterate through next gen stats files to only get relevant plays\nng_all_plays <- c()\nfor (path in ng_paths) {\n  print(paste(\"Running For\",path))\n  temp <- read.csv(paste0(\"../input/\",path),stringsAsFactors = FALSE)\n  filt <- merge(temp,concussion_plays)\n  ng_all_plays <- rbind(ng_all_plays,filt)\n}\nremove(temp)\nremove(filt)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"e210c4e0c0caf984d9fe54a7fe1e7d3b6a4d17de"},"cell_type":"markdown","source":"## Let’s map out the path of the tackler and the path of the player being tackled on concussion-causing plays to see if we can gain any insight on what could be causing the high rate of concussions on punt return tackles."},{"metadata":{"trusted":true,"_uuid":"86139385db1b6241655b54a22b16da3c041dc8fa"},"cell_type":"code","source":"# Separate out tackling related plays\ntackling_df <- concussion_play_info[which(concussion_play_info$Player_Activity_Derived %in% c('Tackling','Tackled') & concussion_play_info$Primary_Partner_Activity_Derived %in% c('Tackling','Tackled')),]\n# Get ID of tackler and person being tackled\ntackling_df$Tackler <- ifelse(tackling_df$Player_Activity_Derived == \"Tackling\",tackling_df$GSISID,tackling_df$Primary_Partner_GSISID)\ntackling_df$Tackled <- ifelse(tackling_df$Player_Activity_Derived == \"Tackling\",tackling_df$Primary_Partner_GSISID,tackling_df$GSISID)\ntackling_df <- tackling_df[which(tackling_df$Tackler != '' & tackling_df$Tackled != ''),]\n# Initiate empty df\none_play_tackle_agg <- c()\n\n# For each play\nfor (play in 1:nrow(tackling_df)) {\n    # Get next gen stat data\n    one_play <- ng_all_plays[which(ng_all_plays$PlayID == tackling_df$PlayID[play] & ng_all_plays$GameKey == tackling_df$GameKey[play] & ng_all_plays$Season_Year == tackling_df$Season_Year[play]),]\n    # Get data at the time of ball_snap to get line of scrimmage\n    formation <- one_play[which(one_play$Event == 'ball_snap'),]\n    # Line of scrimmage should be median of all x values\n    los <- median(formation$x)\n    # Separate out defense and offense by the side of the line of scrimmage they are on\n    formation$role <- ifelse(formation$x < los,\"def\",\"off\")\n    # Get distance away from the line of scrimmage at snap, the farthest person away should be the returner\n    formation$dist_away_los <- abs(los - formation$x)\n    # Define role as punt returner for person farthest away\n    formation$role <- ifelse(formation$GSISID == formation[which(formation$dist_away_los == max(formation$dist_away_los)),\"GSISID\"][1],\"Punt Returner\",formation$role)\n    # Define role as tackler for specific ID\n    formation$role <- ifelse(formation$GSISID == tackling_df$Tackler[play],\"Tackler\",formation$role)\n    # Join play info on high level roles to give it more context\n    off_def_df <- formation[,c('GSISID','role')]\n    one_play <- merge(one_play,off_def_df)\n    # Just looking at those roles for now\n    one_play <- one_play[which(one_play$role %in% c('Tackler','Punt Returner')),]\n    # Get time of tackle by using minimum time between tackler and punt returner\n    op <- data.frame(\"Time\"=unique(one_play$Time),stringsAsFactors = FALSE)\n    tkld <- one_play[which(one_play$role == 'Punt Returner'),c('Time','x','y')]\n    colnames(tkld) <- c('Time','tkld_x','tkld_y')\n    op <- merge(op,tkld)\n    tklr <- one_play[which(one_play$role == 'Tackler'),c('Time','x','y')]\n    colnames(tklr) <- c('Time','tklr_x','tklr_y')\n    op <- merge(op,tklr)\n    op$dist <- ((op$tkld_x-op$tklr_x)^2 + (op$tkld_y-op$tklr_y)^2)^.5\n    tackle_time <- op[which.min(op$dist),'Time']\n    # Change format of times so can use comparisons\n    tackle_time_format <- strptime(tackle_time, \"%Y-%m-%d %H:%M:%OS\")\n    one_play$time_format <- strptime(one_play$Time, \"%Y-%m-%d %H:%M:%OS\") \n    snap_time_format <- strptime(min(one_play[which(one_play$Event == 'ball_snap'),'time_format']), \"%Y-%m-%d %H:%M:%OS\")\n    \n    # We are going to normalize the data to have plays move in one direction and start at the 30 yardline\n    direction_of_los <- ifelse(formation[which(formation$role == 'Punt Returner'),'x']-los > 0,'to_left','to_right')\n    best_los <- 40\n    # Adjustment factor\n    adj <- best_los - los\n    # If the direction of line of scrimmage is to the right, we must flip the x values\n    if (direction_of_los == \"to_right\") {\n        one_play$x_adj <- one_play$x*-1\n        adj_los <- los*-1\n        adj <- best_los - adj_los\n        one_play$x_adj <- one_play$x_adj + adj\n    } else {\n        one_play$x_adj <- one_play$x + adj\n    }\n    # Include game and play id for reference\n    one_play$game <- paste0(one_play$GameKey[1],\"-\",one_play$PlayID[1])\n    # Add data for play specified from ball snap until tackle\n    one_play_tackle_agg <- rbind(one_play_tackle_agg,one_play[which(one_play$time_format <= tackle_time_format & one_play$time_format >= snap_time_format),])\n\n  #tackle_point <- one_play[which(one_play$role == \"Tackler\" & one_play$time_format <= tackle_time_format & one_play$time_format >= tackle_time_format - 2),c('dis','dir')]\n}\nhead(one_play_tackle_agg)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"6b7bb78cdd5948f351f9fd29dd2c72f6e0f8980b"},"cell_type":"markdown","source":"## Let's look at the first play to see the paths"},{"metadata":{"trusted":true,"_uuid":"29bcac527845c7cf5fd258ebba72e2a0184b1784"},"cell_type":"code","source":"# Constrain to field limits\nx_min <- 0\ny_min <- 0\nx_max <- 120\ny_max <- 53.3\nggplot(one_play_tackle_agg[which(one_play_tackle_agg$GameKey == unique(one_play_tackle_agg$GameKey)[1]),]) +\n  annotate(\"rect\", xmin=0, xmax=10, ymin=0, ymax=53.3, alpha=0.8) + annotate(\"rect\", xmin=110, xmax=120, ymin=0, ymax=53.3, alpha=0.8) +\n  annotate(\"rect\", xmin=10, xmax=110, ymin=0, ymax=53.3, alpha=0.2, fill = \"darkgreen\") +\n  geom_vline(xintercept=best_los) + xlim(c(x_min,x_max)) + ylim(c(y_min,y_max)) + \n  geom_point(aes(x_adj,y,color=role)) + theme_void() + facet_wrap(~game)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"d409cb7a6a1598e2af07ccc349234ed065b45a55"},"cell_type":"markdown","source":"### It looks like the tackler released and had a fairly unimpeded path at the returner. Let's look at the rest of the plays."},{"metadata":{"trusted":true,"_uuid":"18439d2b4b3931aec5b844411a8103b81db18320"},"cell_type":"code","source":"# Facet wrap on game\nggplot(one_play_tackle_agg) +\n  annotate(\"rect\", xmin=0, xmax=10, ymin=0, ymax=53.3, alpha=0.8) + annotate(\"rect\", xmin=110, xmax=120, ymin=0, ymax=53.3, alpha=0.8) +\n  annotate(\"rect\", xmin=10, xmax=110, ymin=0, ymax=53.3, alpha=0.2, fill = \"darkgreen\") +\n  geom_vline(xintercept=best_los) + xlim(c(x_min,x_max)) + ylim(c(y_min,y_max)) + \n  geom_point(aes(x_adj,y,color=role)) + theme_void() + facet_wrap(~game)\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"5552a317e7887a2e7dc8d9386f59a2703e87e95a"},"cell_type":"markdown","source":"### We can observe that in almost every case, the player tackling is able to take a pretty direct path to the ball carrier.  We theorize that a straight path would allow a player to reach high speeds, so let’s track the average top speed of the players making the tackle."},{"metadata":{"trusted":true,"_uuid":"c64a0f1ab4b67071be0f085f9384cae4aa3164d0"},"cell_type":"code","source":"tackling_df$Tackler_Top_Speed <- apply(tackling_df,1,function(x){\n    data <- ng_all_plays[which(ng_all_plays$Season_Year == as.numeric(x['Season_Year']) & ng_all_plays$GameKey == as.numeric(x['GameKey']) & ng_all_plays$PlayID == as.numeric(x['PlayID']) & ng_all_plays$GSISID == as.numeric(x['Tackler'])),]\n    # Find max distance covered per timestamp and convert to mph\n    return(round(max(data$dis) * 20.455,2))\n})\ntackling_df$Tackler_Top_Speed","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"66f209f43a6a85753fb53b6cb87db039d603eb79"},"cell_type":"code","source":"hist(tackling_df$Tackler_Top_Speed,\n     main=\"Distribution of Tackler Top Speed on Concussion Causing Tackles\",\n     xlab=\"Top Speed (mph)\",ylab=\"Count\")","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"8d0e0e45cd79d7a4a3a922fd268ea144aa771170"},"cell_type":"markdown","source":"### Wow, players making concussion-causing tackles are generally able to reach very high top speeds.  That is very likely a major factor in the high rates of concussions. Why are these players able to run in a straight line for so long?  Wouldn’t the punt return team be obstructing their path to the punt returner?\n### Let's look at where the punt team and return team are in relation to each other for a specific play. This play shows the punt team releasing after a quick block."},{"metadata":{"trusted":true,"_uuid":"669199805119af0597e9a8b4589eaed6ceb3812e"},"cell_type":"code","source":"# Filter on a play\nplay <- 18\none_play <- ng_all_plays[which(ng_all_plays$PlayID == concussion_plays$PlayID[play] & ng_all_plays$GameKey == concussion_plays$GameKey[play] & ng_all_plays$Season_Year == concussion_plays$Season_Year[play]),]\nformation <- one_play[which(one_play$Event == 'ball_snap'),]\nlos <- median(formation$x)\nformation$off_def <- ifelse(formation$x < los,\"punt_team\",\"return_team\")\noff_def_df <- formation[which(formation$off_def %in% c('punt_team','return_team')),c('GSISID','off_def')]\none_play <- merge(one_play,off_def_df)\n# Get snap time\nsnap_time <- formation$Time[1]\none_play <- one_play[order(one_play$Time),]\ntimes <- unique(one_play$Time)\nnew_time <- snap_time\n\n# Plot at ball_snap\nggplot(one_play[which(one_play$Time == new_time),],aes(x,y,color=off_def))+\n  geom_point() + \n  geom_vline(xintercept=median(formation$x)) + \n  geom_vline(xintercept=median(one_play[which(one_play$Time == new_time & one_play$off_def == \"punt_team\"),'x']) ,color=\"red\") +\n  geom_vline(xintercept=median(one_play[which(one_play$Time == new_time & one_play$off_def == \"return_team\"),'x']) ,color=\"blue\") +\n  xlim(c(x_min,x_max)) + ylim(c(y_min,y_max)) + theme_void() + annotate(\"rect\", xmin=10, xmax=110, ymin=0, ymax=53.3, alpha=0.1, fill = \"gray\") + \n  annotate(\"rect\", xmin=0, xmax=10, ymin=0, ymax=53.3, alpha=0.8) + annotate(\"rect\", xmin=110, xmax=120, ymin=0, ymax=53.3, alpha=0.8)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"d82538caf50483aebd9a4eb2020bc8a6cc5d63df"},"cell_type":"markdown","source":"### This shows the median lines for each team.\n### Now let's look 4 seconds in to see how those lines change."},{"metadata":{"trusted":true,"_uuid":"ddc04b16b94846a6f58d096107a7c2e2edf60616"},"cell_type":"code","source":"snap_time_index <- which(times == new_time)\nsec_after <- 4\nnew_time <- times[snap_time_index+sec_after*10]\n\nggplot(one_play[which(one_play$Time == new_time),],aes(x,y,color=off_def))+\n  geom_point() + \n  geom_vline(xintercept=median(formation$x)) + \n  geom_vline(xintercept=median(one_play[which(one_play$Time == new_time & one_play$off_def == \"punt_team\"),'x']) ,color=\"red\") +\n  geom_vline(xintercept=median(one_play[which(one_play$Time == new_time & one_play$off_def == \"return_team\"),'x']) ,color=\"blue\") +\n  xlim(c(x_min,x_max)) + ylim(c(y_min,y_max)) + theme_void() + annotate(\"rect\", xmin=10, xmax=110, ymin=0, ymax=53.3, alpha=0.1, fill = \"gray\") +\n  annotate(\"rect\", xmin=0, xmax=10, ymin=0, ymax=53.3, alpha=0.8) + annotate(\"rect\", xmin=110, xmax=120, ymin=0, ymax=53.3, alpha=0.8)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"7105b3d6d46fc244b953f3387f86933aff481891"},"cell_type":"markdown","source":"<video width=\"600\" height=\"400\" controls> <source src=\"http://a.video.nfl.com//films/vodzilla/153247/Punt_by_Tress_Way-QsI21aYF-20181119_160141260_5000k.mp4\" type=\"video/mp4\"></video>\n\n### As you can see, the players on the punting team generally make it downfield before the players on the punt return team.  This leads to a dangerous situation where multiple plays have unimpeded paths to the punt returner.\n\n### It looks like while players on the punt return team rush the punter, the punting team releases to go make a tackle on the punt returner, with nobody in their path.\n"},{"metadata":{"_uuid":"e6fcc8de5ca972e9a50c20b7fbbc5b4810fa0a7f"},"cell_type":"markdown","source":"## Let’s summarize what we learned so far about concussions and tackling:  \n1. 51% of concussions on punt returns are the result of the tackle.  \n2. Concussion-causing tacklers are generally able to take a straight path to the punt returner. \n3. Running in a straight line allows them to reach high top speeds before making the tackle.  \n4. Tacklers are able to run in a straight line because they have unimpeded paths to the punt returner.\n5. Tacklers have unimpeded paths because the players on the punt team release and get downfield before the players on the punt return team."},{"metadata":{"_uuid":"e2d03d51cf9cd52b0c76b04785d411657cf486eb"},"cell_type":"markdown","source":"### Now, let’s look at what kind of blocks result in concussions.  First, let’s map out the path of the blocker and the path of the player being blocked on concussion-causing blocks (similar to what we did for the tackles), to see if we can understand what could be causing the high rate of concussions on punt return blocks."},{"metadata":{"trusted":true,"_uuid":"15350d23a318714456d9ee42f5b39a20b49a6c52"},"cell_type":"code","source":"# Separate out blocking related plays\nblocking_df <- concussion_play_info[which(concussion_play_info$Player_Activity_Derived %in% c('Blocked','Blocking') & concussion_play_info$Primary_Partner_Activity_Derived %in% c('Blocked','Blocking')),]\n# Get ID of tackler and person being tackled\nblocking_df$Blocker <- ifelse(blocking_df$Player_Activity_Derived == \"Blocking\",blocking_df$GSISID,blocking_df$Primary_Partner_GSISID)\nblocking_df$Blocked <- ifelse(blocking_df$Player_Activity_Derived == \"Blocking\",blocking_df$Primary_Partner_GSISID,blocking_df$GSISID)\n# Initiate empty dataframes\none_play_blocking_agg <- c()\ndirection_plot_agg <- c()\n\n# For each play\nfor (play in 1:nrow(blocking_df)) {\n    # Get next gen stat data\n    one_play <- ng_all_plays[which(ng_all_plays$PlayID == blocking_df$PlayID[play] & ng_all_plays$GameKey == blocking_df$GameKey[play] & ng_all_plays$Season_Year == blocking_df$Season_Year[play]),]\n    # Get data at the time of ball_snap to get line of scrimmage\n    formation <- one_play[which(one_play$Event == 'ball_snap'),]\n    # Line of scrimmage should be median of all x values\n    los <- median(formation$x)\n    # Separate out defense and offense by the side of the line of scrimmage they are on\n    formation$role <- ifelse(formation$x < los,\"def\",\"off\")\n    # Get distance away from the line of scrimmage at snap, the farthest person away should be the returner\n    formation$dist_away_los <- abs(los - formation$x)\n    # Define role as punt returner for person farthest away\n    formation$role <- ifelse(formation$GSISID == formation[which(formation$dist_away_los == max(formation$dist_away_los)),\"GSISID\"][1],\"Punt Returner\",formation$role)\n    # Define role as Blocker or Blocked for specific ID\n    formation$role <- ifelse(formation$GSISID == blocking_df$Blocker[play],\"Blocker\",formation$role)\n    formation$role <- ifelse(formation$GSISID == blocking_df$Blocked[play],\"Blocked\",formation$role)\n    # Join play info on high level roles to give it more context\n    off_def_df <- formation[,c('GSISID','role')]\n    one_play <- merge(one_play,off_def_df)\n    # Just looking at those roles for now\n    one_play <- one_play[which(one_play$role %in% c('Blocker','Blocked','Punt Returner')),]\n    \n    # Get time of block by using minimum time between blocker and blocked\n    op <- data.frame(\"Time\"=unique(one_play$Time),stringsAsFactors = FALSE)\n    blkd <- one_play[which(one_play$role == 'Blocked'),c('Time','x','y')]\n    colnames(blkd) <- c('Time','blkd_x','blkd_y')\n    op <- merge(op,blkd)\n    blkr <- one_play[which(one_play$role == 'Blocker'),c('Time','x','y')]\n    colnames(blkr) <- c('Time','blkr_x','blkr_y')\n    op <- merge(op,blkr)\n    op$dist <- ((op$blkd_x-op$blkr_x)^2 + (op$blkd_y-op$blkr_y)^2)^.5\n    block_time <- op[which.min(op$dist),'Time']\n      \n    # Change format of times so can use comparisons\n    block_time_format <- strptime(block_time, \"%Y-%m-%d %H:%M:%OS\")  \n    one_play$time_format <- strptime(one_play$Time, \"%Y-%m-%d %H:%M:%OS\")\n    snap_time_format <- strptime(min(one_play[which(one_play$Event == 'ball_snap'),'time_format']), \"%Y-%m-%d %H:%M:%OS\")\n    \n    # We are going to normalize the data to have plays move in one direction and start at the 30 yardline\n    direction_of_los <- ifelse(formation[which(formation$role == 'Punt Returner'),'x']-los > 0,'to_left','to_right')\n    best_los <- 40\n    # Adjustment factor\n    adj <- best_los - los\n    # If the direction of line of scrimmage is to the right, we must flip the x values\n    if (direction_of_los == \"to_right\") {\n        one_play$x_adj <- one_play$x*-1\n        adj_los <- los*-1\n        adj <- best_los - adj_los\n        one_play$x_adj <- one_play$x_adj + adj\n    } else {\n        one_play$x_adj <- one_play$x + adj\n    }\n    # Include game and play id for reference\n    one_play$game <- paste0(one_play$GameKey[1],\"-\",one_play$PlayID[1])\n    # Add data for play specified from ball snap until tackle\n    one_play_blocking_agg <- rbind(one_play_blocking_agg,one_play[which(one_play$time_format < block_time_format & one_play$time_format >= snap_time_format),])\n\n    # Now get info at the time of block (2 seconds before)\n    block_point <- one_play[which(one_play$role == \"Blocker\" & one_play$time_format <= block_time_format & one_play$time_format >= block_time_format - 2),c('dis','dir')]\n\n    # Create line parallel to line of scrimmage\n    arrow1 <- data.frame(\"dir\"=c(0,180),\"dis\"=c(10,10))\n    # Create line for direction and magnitude of block\n    arrow2 <- data.frame(\"dir\"=mean(block_point$dir),\"dis\"=mean(block_point$dis))\n    # Normalize so everything is facing one direction\n    if (direction_of_los == \"to_left\") {\n     arrow2$dir <- arrow2$dir*(-1)+360\n    }\n    # Convert to mph\n    arrow2$dis <- arrow2$dis*20.455\n    arrow <- rbind(arrow1,arrow2)\n    colnames(arrow) <- c('dir','speed')\n    # Include reference line\n    arrow$type <- c('parallel to line of scrimmage','parallel to line of scrimmage','angle of block')\n    # Include game and play id for reference\n    arrow$game <- rep(paste0(one_play$GameKey[1],\"-\",one_play$PlayID[1]),nrow(arrow))\n    # Add data for play specified for block angle\n    direction_plot_agg <- rbind(direction_plot_agg,arrow)\n}","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"ffc4b47180e2068f08b18e07f1a2d4b87a25c4f4"},"cell_type":"code","source":"# Let's look at one game and the relative positions of people in the block and the punt returner\nGameKey <- 553\nggplot(one_play_blocking_agg[which(one_play_blocking_agg$GameKey == GameKey),]) +\n  annotate(\"rect\", xmin=0, xmax=10, ymin=0, ymax=53.3, alpha=0.8) + annotate(\"rect\", xmin=110, xmax=120, ymin=0, ymax=53.3, alpha=0.8) +\n  annotate(\"rect\", xmin=10, xmax=110, ymin=0, ymax=53.3, alpha=0.2, fill = \"darkgreen\") +\n  geom_vline(xintercept=best_los) + xlim(c(x_min,x_max)) + ylim(c(y_min,y_max)) + \n  geom_point(aes(x_adj,y,color=role)) + theme_void() + facet_wrap(~game)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"efe4e192504b71043805cf9901525e51ba70d879"},"cell_type":"markdown","source":"## In this plot, the field direction has been normalized to the 30 yard line and everything is moving in the same direction (it appears flipped compared to the video below)."},{"metadata":{"_uuid":"cc925b6c833a0017cddc54e9c819521759a35e47"},"cell_type":"markdown","source":"<video width=\"600\" height=\"400\" controls> <source src=\"http://a.video.nfl.com//films/vodzilla/153280/Wing_37_yard_punt-cPHvctKg-20181119_165941654_5000k.mp4\" type=\"video/mp4\"></video>\n\n## Now let's look at all the games."},{"metadata":{"trusted":true,"_uuid":"3cfaaecfcb0f455cb4589509e7b55319fb708a47"},"cell_type":"code","source":"ggplot(one_play_blocking_agg) +\n  annotate(\"rect\", xmin=0, xmax=10, ymin=0, ymax=53.3, alpha=0.8) + annotate(\"rect\", xmin=110, xmax=120, ymin=0, ymax=53.3, alpha=0.8) +\n  annotate(\"rect\", xmin=10, xmax=110, ymin=0, ymax=53.3, alpha=0.2, fill = \"darkgreen\") +\n  geom_vline(xintercept=best_los) + xlim(c(x_min,x_max)) + ylim(c(y_min,y_max)) + \n  geom_point(aes(x_adj,y,color=role)) + theme_void() + facet_wrap(~game)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"52c06abae20721a3f741a8749de309d208ce3a0d"},"cell_type":"markdown","source":"## It appears that most of the concussion-causing blocks are going backwards and are generally pretty direct paths. Let's see if we can validate that assumption.\n\n## Let's look at one game and the direction and magnitude of the block.\n## In this case, the direction has been normalized and anything to the right means backwards (away from the intended endzone or line of scrimmage)."},{"metadata":{"trusted":true,"_uuid":"d0f80ac33b37835470da24a3992c5cb6888f70a9"},"cell_type":"code","source":"game <- '392-1088'\nbase <- ggplot(direction_plot_agg[which(direction_plot_agg$game == game),], aes(x=dir, y=speed))\np <- base + coord_polar()\nawid <- 40\np + geom_segment(aes(y=0, xend=dir, yend=speed,linetype=type))+\n  geom_segment(aes(y=ifelse(speed == 10,speed,speed-1),yend=speed,x=ifelse(speed == 10,dir,dir-awid/speed),xend=dir))+\n  geom_segment(aes(y=ifelse(speed == 10,speed,speed-1),yend=speed,x=ifelse(speed == 10,dir,dir+awid/speed),xend=dir))+xlim(c(360,0))+\n  theme(axis.title.x=element_blank(),axis.text.x=element_blank()) + facet_wrap(~game)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"44fcce5f839900a428ecc34d5d11e27badd22ad2"},"cell_type":"markdown","source":"<video width=\"600\" height=\"400\" controls> <source src=\"http://a.video.nfl.com//films/vodzilla/153258/61_yard_Punt_by_Brett_Kern-g8sqyGTz-20181119_162413664_5000k.mp4\"\" type=\"video/mp4\"></video>\n\n## Now let's look at all the games."},{"metadata":{"trusted":true,"_uuid":"1eb1ccab64891f2f1c41247c837fdb53799527dc"},"cell_type":"code","source":"base <- ggplot(direction_plot_agg, aes(x=dir, y=speed))\np <- base + coord_polar()\nawid <- 40\np + geom_segment(aes(y=0, xend=dir, yend=speed,linetype=type))+\n  geom_segment(aes(y=ifelse(speed == 10,speed,speed-1),yend=speed,x=ifelse(speed == 10,dir,dir-awid/speed),xend=dir))+\n  geom_segment(aes(y=ifelse(speed == 10,speed,speed-1),yend=speed,x=ifelse(speed == 10,dir,dir+awid/speed),xend=dir))+xlim(c(360,0))+\n  theme(axis.title.x=element_blank(),axis.text.x=element_blank()) + facet_wrap(~game)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"de3057a8fa676a62da866b436365d31946f5722c"},"cell_type":"markdown","source":"## Plotting all the games together makes sense.\n## Again, they are normalized for simplicity.\n## Here let's label them as a forward block or a backward block."},{"metadata":{"trusted":true,"_uuid":"db6f5bab913b052bcc248591d71e730a6d116f90"},"cell_type":"code","source":"base <- ggplot(direction_plot_agg, aes(x=dir, y=speed))\np <- base + coord_polar()\nawid <- 40\np + geom_segment(aes(y=0, xend=dir, yend=speed,linetype=type))+\n  geom_segment(aes(y=ifelse(speed == 10,speed,speed-1),yend=speed,x=ifelse(speed == 10,dir,dir-awid/speed),xend=dir))+\n  geom_segment(aes(y=ifelse(speed == 10,speed,speed-1),yend=speed,x=ifelse(speed == 10,dir,dir+awid/speed),xend=dir))+xlim(c(360,0))+\n  ggtitle(\"Block Forwards         Block Backwards\")+\n  theme(axis.title.x=element_blank(),axis.text.x=element_blank(),plot.title = element_text(hjust = 0.5))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"c698a0894c04cb8fa43d6c2727c9b7751dac3979"},"cell_type":"code","source":"print(paste(\"Backwards blocks represent:\",nrow(direction_plot_agg[which(direction_plot_agg$type == 'angle of block' & direction_plot_agg$dir > 180),])))\nprint(paste(\"Out of the total:\",nrow(direction_plot_agg[which(direction_plot_agg$type == 'angle of block'),])))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"b5cc36196bf3d8dd53d0a2ff514065d0db99a02d"},"cell_type":"markdown","source":"### This is very interesting.  11/15 concussion-causing blocks are going backwards toward the ball at high speeds.  This is likely because these blocks are out of the line of sight of the player being blocked, who has their attention focused on the punt returner.  When a player doesn’t know a block is coming, they are not able to avoid the block, nor are they able to brace for impact, resulting in a higher rate of concussions.  Also, similar to what we saw in the tackling analysis, when the player is able to run in a straight line down the field, they are able to achieve high speeds.  The combination of both the high speeds and the lack of awareness of the incoming block results in one of the most dangerous situations in all of football."},{"metadata":{"_uuid":"5ff2deec4bf5a4f9e10dc356e2dd90e6c5d4bf05"},"cell_type":"markdown","source":"### Why are these types of (peel back) blocks so common?  Let’s analyze mean player position for each team (excluding returner and punter).  Let’s look at the time at which the kicking team passes the return team in terms of position."},{"metadata":{"trusted":true,"_uuid":"27f52ac80e4091ec4561b41376246d3cfb74b723"},"cell_type":"code","source":"# Initiate empty dataframe\nlos_pass_mean <- c()\n# For each play\nfor (play in 1:nrow(concussion_plays)) {\n    # Get next gen stat data\n    one_play <- ng_all_plays[which(ng_all_plays$PlayID == concussion_plays$PlayID[play] & ng_all_plays$GameKey == concussion_plays$GameKey[play] & ng_all_plays$Season_Year == concussion_plays$Season_Year[play]),]\n    # Get data at the time of ball_snap to get line of scrimmage\n    formation <- one_play[which(one_play$Event == 'ball_snap'),]\n    # Line of scrimmage should be median of all x values    \n    los <- median(formation$x)\n    # Separate out defense and offense by the side of the line of scrimmage they are on\n    formation$off_def <- ifelse(formation$x < los,\"def\",\"off\")\n    # Get distance away from the line of scrimmage at snap, the farthest person on either side of scrimmage should be the returner and punter\n    formation$off_def <- ifelse(formation$GSISID == formation[which(formation$x == min(formation$x)),\"GSISID\"][1],\"Punt Returner\",formation$off_def)\n    formation$off_def <- ifelse(formation$GSISID == formation[which(formation$x == max(formation$x)),\"GSISID\"][1],\"Kicker\",formation$off_def)\n    # We want to exclude the kicker and returner for this analysis\n    off_def_df <- formation[which(formation$off_def %in% c('off','def')),c('GSISID','off_def')]\n    one_play <- merge(one_play,off_def_df)\n    \n    # Get snap time and convert format\n    snap_time <- formation$Time[1]\n    snap_time_format <- strptime(snap_time, \"%Y-%m-%d %H:%M:%OS\")  \n    one_play$time_format <- strptime(one_play$Time, \"%Y-%m-%d %H:%M:%OS\") \n    # Get play info after snap\n    one_play <- one_play[which(one_play$time_format >= snap_time_format),]\n    one_play <- one_play[order(one_play$time_format),]\n\n    # Get all times in play\n    times <- data.frame(\"Time\"=unique(one_play$Time),stringsAsFactors = FALSE)\n    # Get offense mean x position by time\n    times$off_med <- apply(times,1,function(x){\n        return(mean(one_play[which(one_play$Time == x['Time'] & one_play$off_def == \"off\"),'x']))\n    })\n    # Get defense mean x position by time\n    times$def_med <- apply(times,1,function(x){\n        return(mean(one_play[which(one_play$Time == x['Time'] & one_play$off_def == \"def\"),'x']))\n    })\n    # Get difference between the mean position of the kicking team and the return team\n    times$dif <- times$off_med - times$def_med\n    # Determine time in which the kicking team passes the return team\n    ifelse(times$dif[1] > 0,\n         pos <- times[which(times$dif < 0),],\n         pos <- times[which(times$dif > 0),])\n    # If the kicking team does pass, get the actual time after the snap\n    if(nrow(pos)>0) {\n        pass <- data.frame(\"game\"=paste0(one_play$GameKey[1],\"-\",one_play$PlayID[1]),\n                           \"time_til\"=strptime(pos$Time[1], \"%Y-%m-%d %H:%M:%OS\")  - strptime(times$Time[1], \"%Y-%m-%d %H:%M:%OS\"),\n                           stringsAsFactors = FALSE)\n        # Return info back\n        los_pass_mean <- rbind(los_pass_mean,pass)\n    }\n}","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"2a377ecb97b72bbb05ea4f21a4febe171456ec2b"},"cell_type":"markdown","source":"## Let's see if there are any plays where the kicking team passes return team in 5 seconds or less."},{"metadata":{"trusted":true,"_uuid":"1483900b2d9e90dd257ba27a1dab356601eb6a34"},"cell_type":"code","source":"los_pass_mean$time_til_num <- as.numeric(los_pass_mean$time_til)\nhist(los_pass_mean[los_pass_mean$time_til_num <= 5,'time_til_num'],xlim = c(0,5),ylim = c(0,5),\n     main = \"Time until punt team passes return team by mean position\", xlab= \"seconds from snap\", ylab=\"count of plays\")","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"1afb5eba1d8f670e3d0d85de3f13108a606812dc"},"cell_type":"markdown","source":"### There are definitely plays where the punting team passes the returm team in under 5 seconds. It almost seems like punt return teams intentionally allow players on the punt team past them, with the intention of creating a “wall” of players that come peeling back to block.  While it may be an effective strategy for punt returns, it is very dangerous and definitely contributes to the high concussion rates on punt returns.\n\n## Let's see if it is any different for nonconcussion plays. We haven't analyzed that data yet so let's read it in."},{"metadata":{"trusted":true,"_uuid":"1d600ba34b5e3301d7962430c2cd31c5269dcbea"},"cell_type":"code","source":"# Read in nonconcussion plays\nnonconcussion_play_info <-read.csv(\"../input/video_footage-control.csv\",stringsAsFactors = FALSE)\nnonconcussion_plays <- nonconcussion_play_info[,c('gamekey','playid','season')]\ncolnames(nonconcussion_plays) <- c('GameKey','PlayID','Season_Year')\n\n# Get paths of next gen stats\nng_paths <- c(\"NGS-2016-pre.csv\",\"NGS-2016-post.csv\",\n              \"NGS-2016-reg-wk1-6.csv\",\"NGS-2016-reg-wk7-12.csv\",\n              \"NGS-2016-reg-wk13-17.csv\",\"NGS-2017-pre.csv\",\n              \"NGS-2017-post.csv\",\"NGS-2017-reg-wk1-6.csv\",\n              \"NGS-2017-reg-wk7-12.csv\",\"NGS-2017-reg-wk13-17.csv\")\n\n# Iterate through next gen stats files to only get relevant plays\nng_all_plays_safe <- c()\nfor (path in ng_paths) {\n  print(paste(\"Running For\",path))\n  temp <- read.csv(paste0(\"../input/\",path),stringsAsFactors = FALSE)\n  filt <- merge(temp,nonconcussion_plays)\n  ng_all_plays_safe <- rbind(ng_all_plays_safe,filt)\n}\nremove(temp)\nremove(filt)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"eff7322362d718dc281a34288f53b5175c48383a"},"cell_type":"markdown","source":"## Let's perform a similar analysis."},{"metadata":{"trusted":true,"_uuid":"5a138af64ab0a9c6255e95c95c3c114c59e6e3eb"},"cell_type":"code","source":"# Let's take a look at the nonconcussion plays to see when the punt team passes the return team\nlos_pass_mean_safe <- c()\nfor (play in 1:nrow(nonconcussion_plays)) {\n  one_play <- ng_all_plays_safe[which(ng_all_plays_safe$PlayID == nonconcussion_plays$PlayID[play] & ng_all_plays_safe$GameKey == nonconcussion_plays$GameKey[play] & ng_all_plays_safe$Season_Year == nonconcussion_plays$Season_Year[play]),]\n  \n  formation <- one_play[which(one_play$Event == 'ball_snap'),]\n  los <- median(formation$x)\n  formation$off_def <- ifelse(formation$x < los,\"def\",\"off\")\n  formation$off_def <- ifelse(formation$GSISID == formation[which(formation$x == min(formation$x)),\"GSISID\"][1],\"Punt Returner\",formation$off_def)\n  formation$off_def <- ifelse(formation$GSISID == formation[which(formation$x == max(formation$x)),\"GSISID\"][1],\"Kicker\",formation$off_def)\n  ggplot(formation,aes(x,y,color=off_def))+geom_point() + geom_vline(xintercept=los)\n  off_def_df <- formation[which(formation$off_def %in% c('off','def')),c('GSISID','off_def')]\n  one_play <- merge(one_play,off_def_df)\n  \n  head(one_play)\n  \n  snap_time <- formation$Time[1]\n  snap_time_format <- strptime(snap_time, \"%Y-%m-%d %H:%M:%OS\")  \n  one_play$time_format <- strptime(one_play$Time, \"%Y-%m-%d %H:%M:%OS\") \n  one_play <- one_play[which(one_play$time_format >= snap_time_format),]\n  one_play <- one_play[order(one_play$time_format),]\n  head(one_play)\n  #agg_med <- aggregate(one_play$x, by=list(one_play$off_def,one_play$Time),FUN=median)\n  #head(agg_med)\n  \n  times <- data.frame(\"Time\"=unique(one_play$Time),stringsAsFactors = FALSE)\n  #times <- times[order(times$Time),'Time']\n  head(times)\n  times$off_med <- apply(times,1,function(x){\n    return(mean(one_play[which(one_play$Time == x['Time'] & one_play$off_def == \"off\"),'x']))\n  })\n  times$def_med <- apply(times,1,function(x){\n    return(mean(one_play[which(one_play$Time == x['Time'] & one_play$off_def == \"def\"),'x']))\n  })\n  times$dif <- times$off_med - times$def_med\n  ifelse(times$dif[1] > 0,\n         pos <- times[which(times$dif < 0),],\n         pos <- times[which(times$dif > 0),])\n  head(pos)\n  strptime(pos$Time[1], \"%Y-%m-%d %H:%M:%OS\")  - strptime(times$Time[1], \"%Y-%m-%d %H:%M:%OS\")\n  if(nrow(pos)>0) {\n    pass <- data.frame(\"game\"=paste0(one_play$GameKey[1],\"-\",one_play$PlayID[1]),\n                       \"time_til\"=strptime(pos$Time[1], \"%Y-%m-%d %H:%M:%OS\")  - strptime(times$Time[1], \"%Y-%m-%d %H:%M:%OS\"),\n                       stringsAsFactors = FALSE)\n\n    los_pass_mean_safe <- rbind(los_pass_mean_safe,pass)\n  }\n}","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"18003cd615ccceae97b1342b15b5f4716e3720b9"},"cell_type":"code","source":"# Look to see if there are any plays where the kicking team passes return team in 5 seconds or less\nlos_pass_mean_safe$time_til_num <- as.numeric(los_pass_mean_safe$time_til)\nhist(los_pass_mean_safe[los_pass_mean_safe$time_til_num <= 5,'time_til_num'],xlim = c(0,5),ylim = c(0,5),\n     main = \"Time until punt team passes return team by mean position\",xlab= \"seconds from snap\", ylab=\"count of plays\")\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"0aa214a650e602bd1f3cf1e21ad15afabdd41eda"},"cell_type":"markdown","source":"## Comparing this plot to the one of concussions, you can see that there are some plays causing injuries where the punt team passes the return team in less time.\n## Overall they both look to be troublesome."},{"metadata":{"_uuid":"0b895758e2226315854194acba5344ceefc7b062"},"cell_type":"markdown","source":"## Let’s summarize what we learned about concussions and blocking, adding to our list:  \n6. 49% of concussions on punt returns are the result of a block.  \n7. The majority of concussion-causing blocks are backwards\n8. These blockers achieve high speeds because they are sprinting backwards towards the ball.\n9. The players being blocked generally have their eyes on the punt returner, so they are not prepared for, or able to avoid, the collision.\n10. Punt return teams often employ a strategy where they let players on the punt team release past them, with the intention of peeling back to block.\n"},{"metadata":{"_uuid":"764a44f647f76c134196af4ae788b5e4008254c0"},"cell_type":"markdown","source":"## Before we finish, let's conduct some video review to highlight these learnings:"},{"metadata":{"_uuid":"c25d723e974ef533303939dc9447a7cd1d21a890"},"cell_type":"markdown","source":"+ https://drive.google.com/file/d/1TImtdvol4gC_AA2_17jo0GsmODF3JpJe/view"},{"metadata":{"_uuid":"6e27360e3a87c5265005662186f9d316ce12a090"},"cell_type":"markdown","source":"+ https://drive.google.com/file/d/1C_ISfht8-LaMLWSVnLUbnaoh4FrsBkHE/view"},{"metadata":{"_uuid":"cd612465325efe1a82881d4512c12524080e9052"},"cell_type":"markdown","source":"+ https://drive.google.com/file/d/166fAAwiYuBXMD8HR_AP8Q9XRC5N7dOW4/view"},{"metadata":{"_uuid":"1b0d28da708cab78ba68cb9d8a43cd6e771306db"},"cell_type":"markdown","source":"+ https://drive.google.com/file/d/1-nCXimc5QujYADDzePbwAzCRs0nZSil8/view"},{"metadata":{"_uuid":"42511a2545153495732f1475e4b4664e6d065c9e"},"cell_type":"markdown","source":"+ https://drive.google.com/file/d/1EVMGTCsyU3PwaGLMl93FqndA4pE-J-_x/view"},{"metadata":{"_uuid":"4b2a6db378152397a68bcae83c5924f704c9c8b7"},"cell_type":"markdown","source":"+ https://drive.google.com/file/d/1oZ4VgQ802m3YiSCYHrce7hlo6b6CTrap/view"},{"metadata":{"_uuid":"e3ef757789fd2dca96099c7de441f89154708c8c"},"cell_type":"markdown","source":"# Overall summary:\n\nWe have found that there are two main causes resulting in the high concussion rates on punt returns:\nThe punting team often has an unimpeded path to the punt returner allowing the tackler to reach high speeds before making contact.\nBlocks from the receiving team are usually peel back blocks where the blocker is coming backwards towards the ball at high speeds.\n\nIn order for a rule to be most effective in reducing concussions, it needs to address both of these causes.\n\n\n## Our proposed rule:\n\n### Eliminate Peel Back Blocks on Punt Returns\n\nAt no point during the punt return may a receiving team player initiate a block on an opponent if the blocking player is moving towards and facing their own end line.  Thus, for a block on the punt return to be legal, the receiving team players can only block players that are downfield from them.\n\n#### Penalty: Loss of 15 yards\n\n\n## Expected Outcomes:\n\n+ Concussions that occur when a receiving team player comes from behind an opponent and makes a peel back block will be eliminated (30% of all punt return concussions in 2016-2017 were the direct result of a peel back block).\n+ Optimal punt return formations and strategies will shift.  Instead of sending numerous guys to rush the punter and letting the punting team release behind them with the intention of peeling back to block, teams will most often take a layered approach to their return formations so they are able to block forward on the return.\n+ With multiple layers of blockers, the punting team will no longer have a direct path to the punt returner.  This will reduce the speed of the punting team players when they make contact with the ball carrier, decreasing the rate of tackling concussions.\n\n### Benefits Over Other Possible Rule Changes:\n+ It maintains the integrity of punting and punt returning.\n+ It organically promotes punt return formations that will reduce the speed of players before they make contact.  Inorganically forcing teams into certain punt formations will negatively affect situations where the best call is an attempted punt block or fake punt.\n+ It is easy to officiate.  All officials need to look for is if a player is moving downfield when they initiate a block.  If the player is not going forward when they initiate the block, there will be a 15 yard penalty.\n"},{"metadata":{"trusted":true,"_uuid":"a9dd0dc70d2024b8c63e305e5c5dafffe57a77eb"},"cell_type":"code","source":"","execution_count":null,"outputs":[]}],"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}