---
title: "NFL Punt Analytics"
author: "Brianna Taylor"
output:
  html_document:
    toc: true
    toc_depth: 2
    number_sections: false
    fig_width: 7
    fig_height: 4.5
    theme: simplex
    code_folding: hide
---

```{r setup, include=FALSE, echo=FALSE}
knitr::opts_chunk$set(echo=TRUE, error=FALSE)
knitr::opts_chunk$set(out.width="100%", fig.height = 4.5, split=FALSE, fig.align = 'default')
```

<center><img src="https://cdn-images-1.medium.com/max/800/1*HUo3yimO_e9xGMyeKUojjw.png", width="100%"></center>

# Introduction

The NFL has provided a host of data relating to punt plays that happened in the 2016 and 2017 seasons. The league aims to reduce concussions on punt plays through rule changes that with emphasize player safety while not losing the excitemet of the game. The NFL has made plenty of rule changes to accomplish this goal, and have made some changes as of last year regarding kickoff plays. The league has also come up with new rules this year on helmet contact, so we will also analyze how the current season's rules may improve concussion rates as well.

# Before We Start

It's always important to note that no dataset is ever perfect. That being said, while there are many concussions on punt plays in relation to other plays that happen in a game, there are only 37 concussions out of 6000+ punt plays in this two year dataset, so we have an imbalanced class of play that could result in us making the wrong assumptions because we don't have enough incidents of concussions. Not that we want to of course! But please be aware and take caution.

I have decided not to look at post season data for this dataset. [It is unclear whether the league collected data in the post season or if there were actually no concussions in the past two years during playoffs](https://www.usatoday.com/story/sports/nfl/2018/01/26/nfl-concussions-2017-season-study-history/1070344001/). Therefore, we will only be looking at pre and regular season data for certainty's sake. If it comes out later that there were indeed no concussions during post season then it would make for an interesting set to look at.

It is also unfortunate that there is no access to current concussion counts this year to see if the rule changes have had any impact on improving concussions. We shall see!

Let's get started!

```{r message=FALSE, warning=FALSE, include=FALSE}
# Load Libraries
library(dplyr)
library(tibble)
library(stringr)
library(tidyr)
library(datapasta)
library(lubridate)
library(datetime)
library(data.table)
library(ggplot2)
library(ggthemes)
library(gridExtra)
library(ggridges)
library(kableExtra)
library(GGally)
library(gapmap)
library(httpuv)
library(ggExtra)
library(cowplot)
library(ggpubr)
```

```{r include=FALSE}
# Read in Data
### NGS2016
videoReview <- fread(file="../input/video_review.csv", header=TRUE, sep=",")
NGS2016pre <- fread(file="../input/NGS-2016-pre.csv")
NGS2016pre$Season <- "Pre"
NGS2016w1to6 <- fread(file="../input/NGS-2016-reg-wk1-6.csv")
NGS2016w1to6$Season <- "Regular"
NGS2016w7to12 <- fread(file="../input/NGS-2016-reg-wk7-12.csv")
NGS2016w7to12$Season <- "Regular"
NGS2016w13to17 <- fread(file="../input/NGS-2016-reg-wk13-17.csv")
NGS2016w13to17$Season <- "Regular"

NGS2016 <- rbind(NGS2016pre,NGS2016w1to6,NGS2016w7to12,NGS2016w13to17)
rm(NGS2016pre,NGS2016w1to6,NGS2016w7to12,NGS2016w13to17)

NGS2016concussions <- subset(NGS2016, GameKey %in% videoReview$GameKey)
NGS2016concussions <- subset(NGS2016concussions, PlayID %in% videoReview$PlayID)

NGScontrol2016 <- NGS2016[!(NGS2016$GameKey %in% videoReview$GameKey),]

# Sample 5 Games from NGS Data
set.seed(123)
sampleGames <- sample(unique(NGScontrol2016$GameKey), 5)
#narrow your data set
NGScontrol2016 <- NGScontrol2016[NGScontrol2016$GameKey %in% sampleGames, ]

rm(NGS2016)

# 2017 NGS Data
NGS2017pre <- fread(file="../input/NGS-2017-pre.csv")
NGS2017pre$Season <- "Pre"
NGS2017w1to6 <- fread(file="../input/NGS-2017-reg-wk1-6.csv")
NGS2017w1to6$Season <- "Regular"
NGS2017w7to12 <- fread(file="../input/NGS-2017-reg-wk7-12.csv")
NGS2017w7to12$Season <- "Regular"
NGS2017w13to17 <- fread(file="../input/NGS-2017-reg-wk13-17.csv")
NGS2017w13to17$Season <- "Regular"

NGS2017 <- rbind(NGS2017pre,NGS2017w1to6,NGS2017w7to12,NGS2017w13to17)
rm(NGS2017pre,NGS2017w1to6,NGS2017w7to12,NGS2017w13to17)

NGS2017concussions <- subset(NGS2017, GameKey %in% videoReview$GameKey)
NGS2017concussions <- subset(NGS2017concussions, PlayID %in% videoReview$PlayID)

NGScontrol2017 <- NGS2017[!(NGS2017$GameKey %in% videoReview$GameKey),]

# Sample 5 Games from NGS Data
sampleGames <- sample(unique(NGScontrol2017$GameKey), 5)
#narrow your data set
NGScontrol2017 <- NGScontrol2017[NGScontrol2017$GameKey %in% sampleGames, ]

rm(NGS2017)
```

```{r include=FALSE}
#Bind Data
NGScontrol <- rbind(NGScontrol2016,NGScontrol2017)
NGSconcussions <- rbind(NGS2016concussions,NGS2017concussions)
rm(NGScontrol2016,NGScontrol2017,NGS2016concussions,NGS2017concussions)
NGS <- rbind(NGScontrol,NGSconcussions)
```

```{r include=FALSE}
#Read CSVs
gameData <- fread(file="../input/game_data.csv", header=TRUE, sep=",")
playInformation <- fread(file="../input/play_information.csv", header=TRUE, sep=",")
playInformation <- subset(playInformation, select=c(3,6,8,9,11,13))
playerPuntData <- fread(file="../input/player_punt_data.csv", header=TRUE, sep=",")
playPlayerRoleData <- fread(file="../input/play_player_role_data.csv", header=TRUE, sep=",")
playPlayerRoleData <- subset(playPlayerRoleData, select=c(2:5))
allPunts <- fread(file="../input/play_information.csv", header=TRUE, sep=",")
```


```{r message=FALSE, warning=FALSE, include=FALSE, paged.print=FALSE}
# Created Concussion Dataframe
# Join Data
concussions <- left_join(videoReview, playInformation)
concussions <- left_join(concussions, playerPuntData)
concussions <- left_join(concussions, playPlayerRoleData)

# Change data type so that final join can be achieved
concussions$Primary_Partner_GSISID <- as.numeric(as.character(concussions$Primary_Partner_GSISID))
concussions <- left_join(concussions, playerPuntData, by = c("Primary_Partner_GSISID" = "GSISID"))

# Rename columns for readability
colnames(concussions)[colnames(concussions)=="Number.x"] <- "Player_Number"
colnames(concussions)[colnames(concussions)=="Position.x"] <- "Player_Position"
colnames(concussions)[colnames(concussions)=="Number.y"] <- "Primary_Player_Number"
colnames(concussions)[colnames(concussions)=="Position.y"] <- "Primary_Player_Position"

# Remove rows where multiple players are said to be involved in concussion play. Watching each video from the concussion set helped me
# find the right players involved.
concussions <- concussions[-c(2:4,6,7,9:11,13,15,16,18,21,25,27,31,34,36,38,39:41,43:45,47:56,58,59,61,62:65,67,69,71,73,76,79:81,84,86,88,90:93,95),]
```

# Adding Data

I have chosen to add a few features to the dataset after watching the videos. They include player team mode (offence, defence) on concussion plays, whether there was a penalty called related to the concussion, whether the ball was caught by the receiver before injury, side of concussion impact, player head and primary partner head position, and player awareness. 

```{r include=FALSE}
# Add New Columns
# Concussion details - this data was collected by watching the injury footage.
concussionDetails <- data.frame(stringsAsFactors=FALSE,
                          GameKey = c(5L, 21L, 29L, 45L, 54L, 60L, 144L, 149L,
                                      189L, 218L, 231L, 234L, 266L, 274L, 280L,
                                      280L, 281L, 289L, 296L, 357L, 364L, 364L,
                                      384L, 392L, 397L, 399L, 414L, 448L, 473L,
                                      506L, 553L, 567L, 585L, 585L, 601L, 607L,
                                      618L),
                           PlayID = c(3129L, 2587L, 538L, 1212L, 1045L, 905L,
                                      2342L, 3663L, 3509L, 3468L, 1976L, 3278L,
                                      2902L, 3609L, 2918L, 3746L, 1526L, 2341L,
                                      2667L, 3630L, 2489L, 2764L, 183L, 1088L,
                                      1526L, 3312L, 1262L, 2792L, 2072L, 1988L,
                                      1683L, 1407L, 733L, 2208L, 602L, 978L, 2792L),
                 Player_Team_Mode = c("Offence", "Offence", "Offence",
                                      "Defence", "Defence", "Offence",
                                      "Defence", "Defence", "Offence", "Offence",
                                      "Offence", "Defence", "Offence", "Defence",
                                      "Offence", "Offence", "Offence", "Defence",
                                      "Defence", "Offence", "Defence", "Defence",
                                      "Defence", "Defence", "Defence", "Offence",
                                      "Defence", "Offence", "Offence", "Defence",
                                      "Defence", "Defence", "Offence", "Defence",
                                      "Defence", "Offence", "Defence"),
   Illegal_Play_Related_To_Injury = c("Yes", "Yes", "No", "No", "No", "Yes",
                                      "No", "No", "No", "No", "No", "No",
                                      "Yes", "No", "No", "No", "No", "No", "No", "No",
                                      "No", "No", "No", "No", "No", "Yes", "No",
                                      "No", "No", "No", "Yes", "No", "Yes",
                                      "No", "No", "No", "No"),
        Ball_Caught_Before_Injury = c("Yes", "Yes", "No", "Yes", "Yes", "Yes",
                                      "Yes", "Yes", "Yes", "Unclear", "Yes",
                                      "No", "No", "Yes", "No", "Yes", "Yes", "Yes",
                                      "Yes", "Yes", "Yes", "Yes", "Yes", "Yes",
                                      "Yes", "No", "Yes", "Yes", "Yes", "Yes",
                                      "Yes", "Yes", "Yes", "Yes", "Yes", "No",
                                      "Yes"),
                   Side_of_Impact = c("Top", "Side", "Front", "Side", "Side",
                                      "Front", "Front", "Front", "Front",
                                      "Unclear", "Side", "Front", "Front", "Behind",
                                      "Front", "Front", "Behind", "Side", "Front",
                                      "Front", "Front", "Behind", "Behind",
                                      "Side", "Front", "Front", "Front", "Side",
                                      "Front", "Front", "Front", "Behind", "Side",
                                      "Side", "Side", "Front", "Front"),
             Player_Head_Position = c("Down", "Up", "Down", "Down", "Up", "Up",
                                      "Up", "Up", "Down", "Unclear", "Up",
                                      "Down", "Up", "Up", "Down", "Down", "Up", "Up",
                                      "Down", "Down", "Up", "Up", "Down",
                                      "Down", "Down", "Down", "Up", "Up", "Up", "Down",
                                      "Up", "Up", "Up", "Down", "Down", "Up",
                                      "Up"),
    Primary_Partner_Head_Position = c("Up", "Up", "Up", "Up", "Up", "Up", "Up",
                                      "Up", "Up", NA, "Down", "Up", "Down",
                                      "Down", "Down", "Up", "Up", "Up", "Up", "Up",
                                      "Up", "Up", "Down", "Up", "Down", "Up", NA,
                                      "Up", "Up", "Down", "Down", "Up", "Down",
                                      "Down", "Down", "Up", "Up"),
                     Player_Aware = c("Yes", "No", "Yes", "Yes", "No", "Yes",
                                      "Yes", "Yes", "Yes", "Unclear", "No",
                                      "Yes", "No", "No", "Yes", "Yes", "No", "No",
                                      "Yes", "Yes", "Yes", "No", "No", "No",
                                      "Yes", "No", "Yes", "No", "Yes", "Yes", "No",
                                      "Yes", "No", "Yes", "Yes", "Yes", "Yes")
)

concussions <- left_join(concussions, concussionDetails)

# Create Concussion_On_Play column
concussions$Concussion_On_Play <- "Yes"

rm(concussionDetails)
```

I have also categorized player role data ID by whether the players involved in concussion plays are on offence/defence/player/primary partner/ball carrier. This will help us do some plotting later on.  

```{r include=FALSE}
# NGS Data
# Add player position data
NGSconcussions <- left_join(NGSconcussions, playPlayerRoleData)

# Add player plotting position type to NGS data
concussedPlayerID <- subset(concussions, select = c(2:4))
concussedPlayerID <- left_join(concussedPlayerID, playPlayerRoleData)
concussedPlayerID$Role <- "Player"

primaryPartnerID <- subset(concussions, select = c(2,3,8))
primaryPartnerID <- left_join(concussedPlayerID, playPlayerRoleData)
primaryPartnerID$Role <- "Primary Partner"

roles <- rbind(concussedPlayerID,primaryPartnerID)
colnames(roles)[colnames(roles)=="Role"] <- "Plotting_Role"

NGSconcussions <- left_join(NGSconcussions,roles)

NGSconcussions$Plotting_Role[NGSconcussions$Role %in% c("GL","GR","PLW","PLT","PLG","PLS","PRG","PRT","PRW","PC","PPR","PPL", "P")] <- "Offence"

NGSconcussions$Plotting_Role[NGSconcussions$Role %in% c("VR","VRo","VRi", "VLi","PDR1","PDR2","PDR3","PDL3","PDL2","PDL1","PLR","PLM","PLL","PFB")] <- "Defence"

NGSconcussions$Plotting_Role[is.na(NGSconcussions$Plotting_Role)] <- "Other"
         
# Separate Date/Time
NGSconcussions <- NGSconcussions %>%
  separate("Time", c("Date", "Time"), " ")

# Convert to Date Time columns
NGSconcussions$Time <- hms(NGSconcussions$Time)
NGSconcussions$Date <-ymd(NGSconcussions$Date)

# Convert yards to meters
NGSconcussions$dis <- NGSconcussions$dis / 1.0936

# Change ordering of dataframe so that we can see plays happen in correct time sequence for players
NGSconcussions <- NGSconcussions[with(NGSconcussions, order(GameKey, PlayID, GSISID, Time)),]

###

# Now do same for NGS 2016
NGScontrol <- left_join(NGScontrol,roles)

NGScontrol$Plotting_Role[NGScontrol$Role %in% c("GL","GR","PLW","PLT","PLG","PLS","PRG","PRT","PRW","PC","PPR","PPL", "P")] <- "Offence"
NGScontrol$Plotting_Role[NGScontrol$Role %in% c("VR","VRo","VRi", "VLi","PDR1","PDR2","PDR3","PDL3","PDL2","PDL1","PLR","PLM","PLL","PFB")] <- "Defence"
NGScontrol$Plotting_Role[is.na(NGScontrol$Plotting_Role)] <- "Other"
NGScontrol$Plotting_Role[NGScontrol$Role %in% c("PR")] <- "Ball Carrier"

rm(roles, primaryPartnerID, videoReview, concussedPlayerID)

NGScontrol <- left_join(NGScontrol, playPlayerRoleData)

NGScontrol <- NGScontrol %>%
  separate("Time", c("Date", "Time"), " ")

NGScontrol$Time <- hms(NGScontrol$Time)
NGScontrol$Date <-ymd(NGScontrol$Date)

NGScontrol$dis <- NGScontrol$dis / 1.0936

NGScontrol <- NGScontrol[with(NGScontrol, order(GameKey, PlayID, GSISID, Time)),]
```

I've also created data that will tell us: 

* Where punts were received on plays
* The average and max velocity and acceleration of players
* Hang time of(time ball is in air)
* Concussions based on time left in quarter and the game
* Punt yards gained
* Score differential
* Number of punts per game

```{r include=FALSE}
# Where Punt Received
puntReceivedxyControl <- subset(NGScontrol, Event == 'punt_received' | Event == 'fair_catch' | Event == 'out_of_bounds' | Event == 'touchback')
puntReceivedxyControl <- subset(puntReceivedxyControl, Role == "PR")
puntReceivedxyControl$Concussion_On_Play <- "No"
puntReceivedxyInjuries <- subset(NGSconcussions, Event == 'punt_received' | Event == 'fair_catch' | Event == 'out_of_bounds' | Event == 'touchback')
puntReceivedxyInjuries <- subset(puntReceivedxyInjuries, Role == "PR")
puntReceivedxyInjuries$Concussion_On_Play <- "Yes"
puntReceivedxy <- rbind(puntReceivedxyControl,puntReceivedxyInjuries)
rm(puntReceivedxyControl,puntReceivedxyInjuries)

puntReceivedxy <- subset(puntReceivedxy, select=c(1:7,16,8:15))
```

```{r include=FALSE}
# Find start/end position to calculate velocity. Remove date/time otherwise they interfere with code.
startEndCoord <- NGSconcussions

# Remove date/time so we can do group_by
startEndCoord <- remove_rownames(startEndCoord)
startEndCoord <- startEndCoord[ -c(5,6) ]

startingCoord <- startEndCoord %>%
  group_by(GameKey, PlayID, GSISID) %>%
  filter(row_number()==1)

endingCoord <- startEndCoord %>%
  group_by(GameKey, PlayID, GSISID) %>%
  filter(row_number()==n())

# Merge starting and ending positions for players by game/play
startEndCoord <- rbind(startingCoord, endingCoord)
startEndCoord <- startEndCoord[with(startEndCoord, order(GameKey, PlayID, GSISID)),]

startEndCoord <- startEndCoord %>%
  group_by(GameKey, PlayID, GSISID) %>%
  summarize(Change_In_X = abs(diff(x)),
            Change_In_Y = abs(diff(y)),
            Displacement = sqrt(Change_In_X^2+Change_In_Y^2))

# Player Average Time/Speed/Distance/Velocity Data by Play
PlayerPlayData_Injuries <- NGSconcussions %>%
  group_by(GameKey, PlayID, GSISID) %>%
  summarize(Total_Play_Time_In_Seconds = max(Time) - min(Time),
            Total_Distance_In_Meters = sum(dis, na.rm=T), 
            Average_Speed = Total_Distance_In_Meters / Total_Play_Time_In_Seconds)

PlayerPlayData_Injuries <- merge(startEndCoord,PlayerPlayData_Injuries,by=c("GameKey", "PlayID", "GSISID"))

# Add Average Velocity Column.
PlayerPlayData_Injuries$Average_Velocity <- PlayerPlayData_Injuries$Displacement / PlayerPlayData_Injuries$Total_Play_Time_In_Seconds

# Remove change in x, y, and displacement columns. No longer needed.
PlayerPlayData_Injuries <- PlayerPlayData_Injuries[ -c(4:6) ]

PlayerPlayData_Injuries$Concussion_On_Play <- "Yes"

###

# Now do same for NGS control
startEndCoord <- NGScontrol
startEndCoord <- remove_rownames(startEndCoord)
startEndCoord <- startEndCoord[ -c(5,6) ]

startingCoord <- startEndCoord %>%
  group_by(GameKey, PlayID, GSISID) %>%
  filter(row_number()==1)

endingCoord <- startEndCoord %>%
  group_by(GameKey, PlayID, GSISID) %>%
  filter(row_number()==n())

startEndCoord <- rbind(startingCoord, endingCoord)
startEndCoord <- startEndCoord[with(startEndCoord, order(GameKey, PlayID, GSISID)),]

startEndCoord <- startEndCoord %>%
  group_by(GameKey, PlayID, GSISID) %>%
  summarize(Change_In_X = abs(diff(x)),
            Change_In_Y = abs(diff(y)),
            Displacement = sqrt(Change_In_X^2+Change_In_Y^2))

PlayerPlayData_Control <- NGScontrol %>%
  group_by(GameKey, PlayID, GSISID) %>%
  summarize(Total_Play_Time_In_Seconds = max(Time) - min(Time),
            Total_Distance_In_Meters = sum(dis, na.rm=T), 
            Average_Speed = Total_Distance_In_Meters / Total_Play_Time_In_Seconds)

PlayerPlayData_Control <- merge(startEndCoord,PlayerPlayData_Control,by=c("GameKey", "PlayID", "GSISID"))
PlayerPlayData_Control$Average_Velocity <- PlayerPlayData_Control$Displacement / PlayerPlayData_Control$Total_Play_Time_In_Seconds
PlayerPlayData_Control <- PlayerPlayData_Control[ -c(4:6) ]

PlayerPlayData_Control$Concussion_On_Play <- "No"

rm(startEndCoord,startingCoord,endingCoord)
```

```{r include=FALSE}
# Calculate Velocity and Acceleration by each frame
velAcc_injuries <- NGSconcussions

velAcc_injuries$Time_As_Seconds <- period_to_seconds(velAcc_injuries$Time)

velAcc_injuries <- velAcc_injuries %>%
  group_by(GameKey, PlayID, GSISID) %>%
  mutate(Change_In_Time = Time_As_Seconds - lag(Time_As_Seconds),
         Change_In_X = x - lag(x),
         Change_In_Y = y - lag(y),
         Displacement = sqrt(Change_In_X^2+Change_In_Y^2),
         Velocity = Displacement / Change_In_Time,
         Acceleration = (Velocity - lag(Velocity)) / Change_In_Time)

# Find max velocity and acceleration
maxVelAcc_injuries <- velAcc_injuries %>%
  group_by(GameKey, PlayID, GSISID) %>%
  summarize(Max_Velocity = max(Velocity, na.rm = TRUE),
            Max_Acceleration = max(Acceleration, na.rm = TRUE))

# Merge maxes with PlayerPlayData
PlayerPlayData_Injuries <- left_join(PlayerPlayData_Injuries, maxVelAcc_injuries)

### Now do same for NGS Control
velAcc_control <- NGScontrol
velAcc_control$Time_As_Seconds <- period_to_seconds(velAcc_control$Time)

velAcc_control <- velAcc_control %>%
  group_by(GameKey, PlayID, GSISID) %>%
  mutate(Change_In_Time = Time_As_Seconds - lag(Time_As_Seconds),
         Change_In_X = x - lag(x),
         Change_In_Y = y - lag(y),
         Displacement = sqrt(Change_In_X^2+Change_In_Y^2),
         Velocity = Displacement / Change_In_Time,
         Acceleration = (Velocity - lag(Velocity)) / Change_In_Time)

maxVelAcc_control <- velAcc_control %>%
  group_by(GameKey, PlayID, GSISID) %>%
  summarize(Max_Velocity = max(Velocity, na.rm = TRUE),
            Max_Acceleration = max(Acceleration, na.rm = TRUE))


PlayerPlayData_Control <- left_join(PlayerPlayData_Control, maxVelAcc_control)

rm(maxVelAcc_control, maxVelAcc_injuries)
```

```{r include=FALSE}
# Hang time
hangTime_injuries <- NGSconcussions[c(2:3,6,12)]
hangTime_injuries$Time <- period_to_seconds(hangTime_injuries$Time)

# Subset start and end of punt kick time using Event
hangTime_injuries <- subset(hangTime_injuries, Event == 'punt' | Event == 'punt_received' | Event == 'fair_catch' | Event == 'out_of_bounds' | Event == 'touchback')

# Delete duplicate rows
hangTime_injuries <- unique(hangTime_injuries)

hangTime_injuries <- hangTime_injuries %>%
  group_by(GameKey, PlayID) %>%
  slice(1:2) %>% # Remove rows for when punt_received happens before ball goes out of bounds
  filter(n() == 2) %>% # Remove rows where only one Event value
  mutate(Hang_Time_In_Seconds = Time - lag(Time, default = first(Time))) %>% # Find difference in start and end of punt
  slice(2) %>% # Take time spent in air, remove punt start time at 0 seconds
  select(-Time) # Remove time column

hangTime_injuries$Concussion_On_Play <- "Yes"

### Now do same for NGS control
hangTime_control <- NGScontrol[c(2:3,6,12)]
hangTime_control$Time <- period_to_seconds(hangTime_control$Time)

hangTime_control <- subset(hangTime_control, Event == 'punt' | Event == 'punt_received' | Event == 'fair_catch' | Event == 'out_of_bounds' | Event == 'touchback')

hangTime_control <- unique(hangTime_control)

hangTime_control <- hangTime_control %>%
  group_by(GameKey, PlayID) %>%
  slice(1:2) %>% # Remove rows for when punt_received happens before ball goes out of bounds
  filter(n() == 2) %>% # Remove rows where only one Event value
  mutate(Hang_Time_In_Seconds = Time - lag(Time, default = first(Time))) %>% # Find difference in start and end of punt
  slice(2) %>% # Take time spent in air, remove punt start time at 0 seconds
  select(-Time) # Remove time column

hangTime_control$Concussion_On_Play <- "No"
```

```{r include=FALSE}
# Join Concussion Dataframe with All Instances of Punt Plays
#Subset concussiondf to make merge easy
yesconcussion <- subset(concussions, select = c(2,3,27))

# Specify whether there was a concussion on the play
completePlays <- left_join(allPunts, yesconcussion, by = c("GameKey", "PlayID"))
completePlays$Concussion_On_Play[is.na(completePlays$Concussion_On_Play)] <- "No"

rm(yesconcussion)
```

```{r include=FALSE}
# Adding Columns to Combined Dataset
# Split Score_Home_Visiting and make numeric
completePlays <- completePlays %>%
  separate("Score_Home_Visiting", c("Home_Score", "Visitor_Score"), " - ")

completePlays$Home_Score <- as.numeric(completePlays$Home_Score)
completePlays$Visitor_Score <- as.numeric(completePlays$Visitor_Score)

# Score differential
completePlays$Score_Differential <- (abs(completePlays$Home_Score - completePlays$Visitor_Score))

# Split Yardline
completePlays <- completePlays %>%
  separate("YardLine", c("Side_Of_Yardline", "Yardline_Yards"), " ")

completePlays$Yardline_Yards <- as.numeric(completePlays$Yardline_Yards)
```

```{r include=FALSE}
# Punt yards
completePlays <- completePlays %>%
  separate("PlayDescription", c("Yards_Punted", "Yardline_Received"), "yards ") # Separate strings

completePlays <- completePlays %>%
  separate("Yardline_Received", c("Yardline_Received", "Yards_Gained"), "for ") # Separate strings

completePlays$Yards_Punted <- sub('.*punts ', '', completePlays$Yards_Punted) # Remove all words before punt yards
is.na(completePlays$Yards_Punted) <- startsWith(completePlays$Yards_Punted, "(") # Replace all stopped punt plays with NA
completePlays$Yards_Punted <- as.numeric(completePlays$Yards_Punted) # Convert character to numeric

# Yardline caught
completePlays$Yardline_Received <- str_replace(completePlays$Yardline_Received, "to end zone", "0")
completePlays$Yardline_Received <- str_extract(completePlays$Yardline_Received, "[0-9]+")
completePlays$Yardline_Received <- as.numeric(completePlays$Yardline_Received)

# Yards gained
completePlays$Yards_Gained <- str_replace(completePlays$Yards_Gained, "no gain", "0")
completePlays$Yards_Gained <- str_extract(completePlays$Yards_Gained, "[0-9]+")
completePlays$Yards_Gained <- as.numeric(completePlays$Yards_Gained)

# Time Left in seconds
completePlays$Game_Clock_In_Seconds <- as.character(completePlays$Game_Clock)
completePlays$Game_Clock_In_Seconds <- as.numeric(ms(completePlays$Game_Clock_In_Seconds))
completePlays$Seconds_Left_In_Quarter <- 900 - completePlays$Game_Clock_In_Seconds

completePlays <- completePlays %>%
  mutate(Seconds_Left_In_Game = case_when(Quarter == 1 ~ 3600 - Game_Clock_In_Seconds,
                       Quarter == 2 ~ 2700 - Game_Clock_In_Seconds,
                       Quarter == 3 ~ 1800 - Game_Clock_In_Seconds,
                       Quarter == 4 ~ 900 - Game_Clock_In_Seconds, TRUE ~ NA_real_))

# Merge hang time and events to play information. 
hangTime <- rbind(hangTime_control,hangTime_injuries)
completePlays <- left_join(completePlays, hangTime, by=c("GameKey", "PlayID"))
```

```{r include=FALSE}
# Punts per game. Concussions per game on punt plays.
numberOfPunts <- allPunts %>%
  group_by(GameKey) %>%
  count(Play_Type)

names(numberOfPunts)[3]<-"Number_Of_Punts"

concussionsCount <- concussions %>%
  group_by(GameKey, Concussion_On_Play) %>%
  count(Concussion_On_Play)

names(concussionsCount)[3]<-"Number_Of_Concussions_In_Game"

concussionsCount <- merge(x = numberOfPunts, y = concussionsCount[ , c(1,3)], by = "GameKey", all.x=TRUE)
concussionsCount <- subset(concussionsCount, select=c(1,3,4))
concussionsCount$Number_Of_Concussions_In_Game[is.na(concussionsCount$Number_Of_Concussions_In_Game)] <- 0
```

```{r include=FALSE}
# Join Game Data to Complete Plays
gameDataSubset <- subset(gameData, select=c(1,6,7,9:15))
completePlays <- left_join(completePlays, gameDataSubset, by=c("GameKey"))
colnames(completePlays)[colnames(completePlays)=="Concussion_On_Play.x"] <- "Concussion_On_Play"
drops <- c("Concussion_On_Play.y")
completePlays <- completePlays[ , !(names(completePlays) %in% drops)]
```

# Data Exploration

## A Look at Season Data

### Concussions by Season

```{r echo=FALSE}
gameData <- left_join(gameData, concussionsCount, by=c("GameKey"))

table1 <- gameData %>% 
  group_by(Season_Year) %>% 
  summarise(Concussions = sum(Number_Of_Concussions_In_Game, na.rm=TRUE))

kable(table1) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

### Concussion Count and Likelihood by Season Type 

```{r echo=FALSE}
concussionCountBySeasonType <- gameData %>% 
  group_by(Season_Year,Season_Type) %>% 
  summarise(Concussions = sum(Number_Of_Concussions_In_Game, na.rm=TRUE))

gameCount <- gameData %>% 
  group_by(Season_Year, Season_Type) %>%
  summarize(Games = n())  

concussionsBySeasonType <- left_join(gameCount,concussionCountBySeasonType)

concussionsBySeasonType$Pct_of_Games_With__Punt_Concussions <- (concussionsBySeasonType$Concussions / concussionsBySeasonType$Games) * 100

concussionsBySeasonType <- concussionsBySeasonType %>% filter(Season_Type != "Post")
rm(concussionCountBySeasonType,gameCount)

kable(concussionsBySeasonType) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))
```

On average, players are about 85% more likely to have a concussion in a preseason game than a regular season game. This is quite a difference! While there are far more games in the regular season than in the pre season, it should definitely be worth having a look at the difference in metrics between the two to see if anything stands out. We will come back to this later.

---

<center><img src="https://cdn-images-1.medium.com/max/800/1*Itk2bHSHEVIvgZHSJCx5pA.png", width="100%"></center>

## A Look at Game Data

### Concussions by Turf Type

```{r echo=FALSE}
# Consolidate turf types
completePlays$Turf <- as.character(completePlays$Turf)
completePlays$Turf <- gsub("^A-Turf Titan$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^Artifical$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^Field turf$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^FieldTurf 360$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^FieldTurf360$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^Synthetic$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^UBU Speed Series-S5-M$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^UBU Speed Series S5-M$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^UBU Sports Speed S5-M$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^Field Turf$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^FieldTurf$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^Turf$", "Artificial", completePlays$Turf)
completePlays$Turf <- gsub("^DD GrassMaster$", "Hybrid", completePlays$Turf)
completePlays$Turf <- gsub("^grass$", "Natural", completePlays$Turf)
completePlays$Turf <- gsub("^Grass$", "Natural", completePlays$Turf)
completePlays$Turf <- gsub("^Natural Grass$", "Natural", completePlays$Turf)
completePlays$Turf <- gsub("^Natural grass$", "Natural", completePlays$Turf)

table2 <- completePlays %>%
  filter(Turf != "" & Concussion_On_Play == "Yes") %>%
  group_by(Turf,Concussion_On_Play) %>%
  summarise(count =n())

kable(table2) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

Approximately 38% of concussions occured on Artificial Turf. 62% occured on Natural turf (0.64 times more likelihood of concussion). There were over 1000 more games played on natural turf than artificial turf though so it is hard to conclude whether the turf has any impact on whether players are at a higher risk of getting concussed.

### Concussions by Indoor/Outdoor Arenas

```{r echo=FALSE}
# Consolidate stadium types
completePlays$StadiumType <- gsub("^Closed Dome$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Dome$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Dome, closed$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Domed, closed$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Indoor, fixed roof$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Indoor, Fixed Roof$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Indoor, Non-Retractable Dome$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Indoor, non-retractable roof$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Indoor, Roof Closed$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Indoors$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Indoors (Domed)$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Retr. Roof-Closed$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Retr. roof - closed$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Retr. Roof - Closed$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Retr. Roof Closed$", "Indoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Retractable Roof$", "Indoor", completePlays$StadiumType)

completePlays$StadiumType <- gsub("^Indoor, Open Roof$", "Indoor, Open Roof", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Retr. Roof-Open$", "Indoor, Open Roof", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Retr. Roof - Open$", "Indoor, Open Roof", completePlays$StadiumType)

completePlays$StadiumType <- gsub("^Heinz Field$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Open$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Oudoor$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Ourdoor$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Outddors$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^outdoor$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^outdoor$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Outdor$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Outdoors$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Outside$", "Outdoor", completePlays$StadiumType)
completePlays$StadiumType <- gsub("^Outdoor Retr Roof-Open$", "Outdoor", completePlays$StadiumType)

completePlays$StadiumType <- gsub("^Turf$", "Unknown", completePlays$StadiumType)
completePlays$StadiumType <- gsub("\\s*\\([^\\)]+\\)","",as.character(completePlays$StadiumType))
completePlays$StadiumType <- gsub("^Indoors$", "Indoor", completePlays$StadiumType)

concussionByArenaType <- completePlays %>%
  group_by(StadiumType,Concussion_On_Play) %>%
  summarise(count =n()) %>%
  filter(Concussion_On_Play =="Yes")
```

```{r echo=FALSE}
concussionByArenaType %>%
  filter(StadiumType != "") %>%
  ggplot(aes(x = StadiumType, y = count, fill= StadiumType)) + 
  geom_bar(stat = "identity") + 
  geom_text(aes(label = count), vjust = -0.3, size = 3.5) +
  labs(title = "Concussion Punt Plays by Stadium Type", x = "Stadium Type", y = "Concussion Count") +
  scale_fill_fivethirtyeight()+
  theme_fivethirtyeight()
```

About 78% of concussions occured in outdoor arenas, though 76% of games were also played in outdoor arenas, so we can't conclude too much from this.

### Concussions by Arena

```{r echo=FALSE}
# Consolidate stadiums
completePlays$Stadium <- gsub("^Lucas Oil$", "Lucas Oil Stadium", completePlays$Stadium)
completePlays$Stadium <- gsub("^Mercedes-Benz Superdome$", "Mercedes-Benz Stadium", completePlays$Stadium)
completePlays$Stadium <- gsub("^MetLife$", "MetLife Stadium", completePlays$Stadium)

table3 <- completePlays %>%
  group_by(Stadium,Concussion_On_Play) %>%
  filter(Concussion_On_Play == "Yes") %>%
  summarise(count =n()) %>%
  arrange(desc(count))

kable(table3) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

FedExField is our leader on this table but with such a small range of concussions by arena we will move on.

### Concussions by Punt Per Game

```{r echo=FALSE}
completePlays %>%
  left_join(numberOfPunts) %>%
  group_by(Number_Of_Punts,Concussion_On_Play) %>%
  summarise(count =n()) %>%
  ggplot(aes(x = Concussion_On_Play, y = Number_Of_Punts, fill = Concussion_On_Play)) + 
  geom_boxplot() +
  geom_jitter() + 
  labs(title = "Number of Punts by Concussion Plays and Control Plays", x = "Concussion Y/N", y = "Concussion Count") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

As the number of punts in a game increases, so too does the likelihood for concussions. No surprise here!

---

## A Look at Play Data

We haven't gathered much insight from looking at things on a game level, so let's dig deeper into plays.

### Concussions by Play Type (Event)

```{r echo=FALSE}
ce <- completePlays %>%
  group_by(Event,Concussion_On_Play) %>%
  summarise(count=n()) %>%
  na.omit()

kable(ce) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

Looks like plays that don't involve fair catches our touchbacks are the source for most concussions.

```{r}
ggplot(data = ce, aes(x = Event, y = count, fill = Concussion_On_Play)) + 
  geom_bar(stat = "identity") + 
  labs(title = "Event Breakdown by Concussion/Control Plays", x = "Event", y = "Concussion Count") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

### Concussion Play Types by Season Type and Event

```{r}
table4 <- completePlays %>%
  filter(Concussion_On_Play=="Yes") %>%
  group_by(Season_Type,Event,Concussion_On_Play) %>%
  summarise(count=n()) %>%
  na.omit()

kable(table4) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),position = "left")
```

52% of punt received plays ending in concussions were in the pre season. Another reason to look at what makes the pre season so special later on.

### Concussion by Role

```{r}
cr <- concussions %>%
  left_join(playPlayerRoleData) %>%
  group_by(Role) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(cr) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

It is no surprise here that the ball carrier gets the most concussions. The variety in positions that also get concussions is surprising, however. Let's look at offensive/defensive breakdown.

```{r}
ggplot(data = cr, aes(x = reorder(Role, -count), y = count, group = 1)) + 
  geom_step() + 
  labs(title = "Number of Concussions by Player Role", x = "Position", y = "Concussion Count") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

### Concussion by Offence/Defence

```{r}
table5 <- concussions %>%
  group_by(Player_Team_Mode) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(table5) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

This is interesting. There is a pretty even split of players that get concussions depending on what side of the snap you are on. I'd previously assumed that the team punting would be giving out the most concussions so there is definitely more than a new line up or running start rule change needed here to help reduce concussions.

### Punt Received Before/After Concussion Event

```{r}
table6 <- concussions %>%
  group_by(Ball_Caught_Before_Injury) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(table6) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

### Concussions by Player Activity

```{r}
table7 <- concussions %>%
  group_by(Player_Activity_Derived) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(table7) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

It is interesting to note that most of the injuries happen after the ball is caught by the receiver. I would've thought there would be a more even split considering the contact that's made when the ball is kicked, but perhaps because the speed of these players is far lower than the speed they can reach towards the end of the play.

### Concussions by Impact Type

```{r}
table8 <- concussions %>%
  group_by(Primary_Impact_Type) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(table8) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

There is a pretty even split of where the helmet hits the 'primary partner' (person who is involved with the player who ends up concussed). Let's see if player awareness helps players avoid concussion.

### Player Awareness

```{r}
table9 <- concussions %>%
  group_by(Player_Aware) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(table9) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

It looks there is isn't as strong a relationship between awareness and whether a player gets concussed. This comes back to the idea of players lowering their heads to make contact and getting concussed as a result. Perhaps side of impact and player team mode will give us some more clues as to what's going on here.

```{r}
ppc <- concussions %>%
  group_by(Side_of_Impact) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(ppc) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

```{r}
table10 <- concussions %>%
  group_by(Player_Aware, Player_Team_Mode) %>%
  summarise(count = n()) %>%
  arrange(desc(count))

kable(table10) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

The fact that most players are hitting/being hit from the front means these numbers are starting to make the case that the Use of Helmet rule employed this season will have an impact if properly enforced. The players being hit from the front could be in a defenceless position but we will come back to that later.

### Player Point of Contact

```{r}
ppc %>%
  filter(count > 1) %>%
  ggplot(aes(x = Side_of_Impact, y = count, fill = Side_of_Impact)) + 
  geom_bar(stat = "identity") + 
  labs(title = "Number of Punts by Concussion Plays and Control Plays", x = "Concussion Y/N", y = "Concussion Count") +
  theme(legend.position="none") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

### Side of Impact, Heads Up or Down

Approximately 38% of concussion plays happen with players having both of their heads up. The remaining concussion plays where at least one player has their head down is 62%.

```{r}
sp <- concussions %>%
  group_by(Side_of_Impact, Player_Head_Position) %>%
  summarise(count = n()) %>%
  arrange(desc(count))

kable(sp) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left") 
```

```{r}
p1<-ggplot(data = sp, aes(x = Side_of_Impact, y = count, fill = Player_Head_Position)) + 
  geom_bar(stat = "identity", position = position_dodge()) + 
  geom_text(aes(label = Player_Head_Position), vjust = 1.6, color = "white", position = position_dodge(0.9), size = 3.5) + 
  labs(title = "Player Head Up/Down", x = "Side of Impact", y = "Concussion Count") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

```{r echo=FALSE}
p2<- concussions %>%
  group_by(Side_of_Impact, Primary_Partner_Head_Position) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  ggplot(aes(x = Side_of_Impact, y = count, fill = Primary_Partner_Head_Position)) + 
  geom_bar(stat = "identity", position = position_dodge()) + 
  geom_text(aes(label = Primary_Partner_Head_Position), vjust = 1, color = "white", position = position_dodge(0.9), size = 3.5) + 
  labs(title = "Primary Partner Head Up/Down", x = "Side of Impact", y = "Concussion Count") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()

grid.arrange(p1,p2,nrow=2)
```

### Concussions by Penalties on Play Related to Injury

```{r}
ip <- concussions %>%
  group_by(Illegal_Play_Related_To_Injury) %>%
  summarise(count = n()) %>%
  arrange(desc(count)) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)
```

```{r}
ggplot(ip, aes(x = "", y = count, fill = Illegal_Play_Related_To_Injury)) + 
  geom_bar(width = 1, stat = 'identity') + 
  coord_polar("y", start = 0) + 
  labs(title = "# Penalties Related to Injuries", x = "count", y = "count") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

No penalty related to the concussions were called on the majority of punt plays . Whether these were missed called or whether these were considered clean hits we will look into later.

### Concussions by Quarter

```{r}
cq <- concussions %>%
  group_by(Quarter) %>%
  summarise(count = n()) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

ggplot(data = cq, aes(x = Quarter, y = count)) + 
  geom_bar(stat = "identity") + 
  labs(title = "Concussions by Quarter", x = "Quarter", y = "Count") +
  scale_fill_fivethirtyeight(aes(fill=Quarter)) +
  theme_fivethirtyeight()
```

It appears the 3rd quarter contains the most concussion punt plays. I am surprised Q4 drops off the amount it does, but that could be due to score differential and the sense it makes to take risks at this point.

---

<center><img src="https://cdn-images-1.medium.com/max/800/1*MLVIamNb-j4GUK2wXM2l9g.png", width="100%"></center>

## A Look at Desperation

### Percentage of Play Types by Quarter

```{r}
pq <- completePlays %>%
  group_by(Quarter, Event) %>%
  filter(Event !="") %>%
  summarise(count = n()) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(pq) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),position = "left")
```

```{r}
p3 <- ggplot(data =pq, aes(x = Quarter, y = count, fill = Event)) + 
  geom_bar(stat = "identity", position = position_dodge()) + 
  labs(title = "Events by Quarter", x = "Quarter", y = "count") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

### Percentage of Play Types by Quarter in Close Games (Score Differential Average is 9 or less)

```{r}
cp <- completePlays %>%
  group_by(Quarter, Event) %>%
  filter(Event !="") %>%
  filter(Score_Differential <= 9) %>%
  summarise(count = n()) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(cp) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),position = "left")
```

```{r}
p4<- ggplot(data =cp, aes(x = Quarter, y = count, fill = Event)) + 
  geom_bar(stat = "identity", position = position_dodge()) + 
  labs(title = "Events by Quarter in Close Games", x = "Quarter", y = "count") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()

grid.arrange(p3,p4,nrow=2)
```

We do see a shift away from out of bounds kicks. Close games will have kickers try to kick inbounds to for turnovers and chances for extra points. Perhaps desperation in the third quarter is when mistakes are made and concussions happen.

### Concussions by Time Left in Quarter

```{r}
c1 <- completePlays %>%
  filter(Concussion_On_Play == "Yes") %>%
  group_by(Quarter, Seconds_Left_In_Quarter) %>%
  summarise(count = n()) %>%
  mutate(Minutes_Left = Seconds_Left_In_Quarter / 60,
         Pct_Of_Total = count / sum(count) * 100)

c1$Time_Range <- ifelse(c1$Minutes_Left <= 5, '0 - 5 minutes', 
                        ifelse(c1$Minutes_Left >= 5.01 & c1$Minutes_Left <= 10, '5-10 minutes', 
                               ifelse(c1$Minutes_Left >= 10.01, '10-15 minutes', 'NA')))

c1 <- c1 %>%
  group_by(Time_Range) %>%
  summarise(count = n())

c1 <- c1[c(1,3,2),]

kable(c1) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

It's interesting that these numbers are pretty even. I would've thought more would happen with less time on the clock.

### Concussions by Time Left in Game

```{r}
tl <- completePlays %>%
  filter(Concussion_On_Play== "Yes") %>%
  group_by(Seconds_Left_In_Game) %>%
  summarise(count = n()) %>%
  mutate(Minutes_Left = Seconds_Left_In_Game / 60,
         Pct_Of_Total = count / sum(count) * 100)

tl$Minutes_Range <- ifelse(tl$Minutes_Left <= 5, '0 - 5 minutes', 
                        ifelse(tl$Minutes_Left >= 5.01 & tl$Minutes_Left <= 10, '5 - 10 minutes', 
                               ifelse(tl$Minutes_Left >= 10.01 & tl$Minutes_Left <= 20, '10 - 20 minutes',
                                      ifelse(tl$Minutes_Left >= 20.01 & tl$Minutes_Left <= 30, '20 - 30 minutes',
                                             ifelse(tl$Minutes_Left >= 30.01 & tl$Minutes_Left <= 40, '30 - 40 minutes',
                                                    ifelse(tl$Minutes_Left >= 40.01 & tl$Minutes_Left <= 50, '40 - 50 minutes',
                                                           ifelse(tl$Minutes_Left >= 50.01, '50+ minutes','NA')))))))

tl <- tl %>%
  group_by(Minutes_Range) %>%
  summarise(count = n()) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

t1 <- tl[c(1,6,2:5,7),]

kable(t1) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

It seems that the majority of concussions happen when there are 20-30 minutes left in the game. In fact you are twice as likely to get concussed in this time range than at any other time in the game. This is the time in the second quarter were we also see the most instances of punt received plays in close quarter games. 

### Concussions by Score Differential

```{r}
sd <- completePlays %>%
  filter(Concussion_On_Play == "Yes") %>%
  group_by(Score_Differential) %>%
  summarise(count = n()) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

sd$Score_Differential_Range <- ifelse(sd$Score_Differential <= 5, '0 - 5 points', 
                        ifelse(sd$Score_Differential >= 6 & sd$Score_Differential <= 10, '6-10 points', 
                               ifelse(sd$Score_Differential >= 11 & sd$Score_Differential <= 15, '11-15 points',
                                      ifelse(sd$Score_Differential >= 16 & sd$Score_Differential <= 30, '16-30 points',
                                             ifelse(sd$Score_Differential > 30, '30+ points','NA')))))

kable(sd) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))
```

It is no surprise that closer games will result in more concussions at this point! 56% of concussions happen when a game is 8 points or less by the time the clock strikes 0.

### Concussions by Yards Gained

```{r}
yg <- completePlays %>%
  filter(Concussion_On_Play == "Yes") %>%
  group_by(Yards_Gained) %>%
  summarise(count = n()) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

yg$Yard_Range <- ifelse(yg$Yards_Gained <= 5, '0 - 5 yards', 
                        ifelse(yg$Yards_Gained >= 5.01 & yg$Yards_Gained <= 10, '5 - 10 yards', 
                               ifelse(yg$Yards_Gained >= 10.01 & yg$Yards_Gained <= 15, '10-15 yards', 
                                      ifelse(yg$Yards_Gained > 15, '15+ yards','NA'))))

yg <- yg %>%
  group_by(Yard_Range) %>%
  summarise(count = n()) %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

yg <- yg[c(1,4,2,3),]

kable(yg) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

I am surprised there is not more of a range here.

### Concussions by Average Yards Punted

```{r}
yp <- completePlays %>%
  group_by(Concussion_On_Play,Yards_Punted) %>%
  summarise(count = n())

yp$Yards_Punted_Range <- ifelse(yp$Yards_Punted <= 10, '0 - 10 yards', 
                                ifelse(yp$Yards_Punted >= 10.01 & yp$Yards_Punted <= 20, '10 - 20 yards', 
                                       ifelse(yp$Yards_Punted >= 20.01 & yp$Yards_Punted <= 30, '20 - 30 yards',
                                              ifelse(yp$Yards_Punted >= 30.01 & yp$Yards_Punted <= 40, '30 - 40 yards',
                                                     ifelse(yp$Yards_Punted >= 40.01 & yp$Yards_Punted <= 50, '40 - 50 yards',
                                                            ifelse(yp$Yards_Punted >= 50.01 & yp$Yards_Punted <= 60, '50 - 60 yards',
                                                                   ifelse(yp$Yards_Punted >= 60.01, '60+ yards','NA')))))))

table11 <- yp %>%
  filter(Concussion_On_Play=="Yes") %>%
  group_by(Concussion_On_Play,Yards_Punted_Range) %>%
  summarise(count = n()) %>%
  na.omit() %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(table11) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

Punt between 40-60 yards result in the most concussions. This could be a reaction time issue where the player receiving has more time to react to the play since players are further away from him, resulting in more running plays because the ball carrier has room to move.

### Concussions by Yardline Range Where Ball Received

```{r}
cb <- completePlays %>%
  group_by(Concussion_On_Play,Yardline_Received) %>%
  summarise(count = n())

cb$Yardline_Received_Range <- ifelse(cb$Yardline_Received <= 10, '0 - 10 yards', 
                                ifelse(cb$Yardline_Received >= 10.01 & cb$Yardline_Received <= 20, '10 - 20 yards', 
                                       ifelse(cb$Yardline_Received >= 20.01 & cb$Yardline_Received <= 30, '20 - 30 yards',
                                              ifelse(cb$Yardline_Received >= 30.01 & cb$Yardline_Received <= 40, '30 - 40 yards',
                                                     ifelse(cb$Yardline_Received >= 40.01, '40+ yards','NA')))))

table12 <- cb %>%
  filter(Concussion_On_Play=="Yes") %>%
  group_by(Concussion_On_Play,Yardline_Received_Range) %>%
  summarise(count = n()) %>%
  na.omit() %>%
  mutate(Pct_Of_Total = count / sum(count) * 100)

kable(table12) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

We can see here that balls received at the 10-30 yard mark will result in more concussions. There are less yards to the endzone from this range so there is more incentive to stop the ball carrie at all cost. It is interesting how kicks at 30+ yards generates far less concussions, but if I had to guess it's because the players don't have much speed on the play when the ball wasn't kicked very far.

---

<center><img src="https://cdn-images-1.medium.com/max/800/1*zI0d67szKMgHb3h-ROUJUw.png", width="100%"></center>

## A Look at Reaction Time

### Speed, Velocity and Acceleration

```{r}
PlayerPlayData_Control$Concussion_On_Play <- "No"
PlayerPlayData_Injuries$Concussion_On_Play <- "Yes"
PlayerPlayData <- rbind(PlayerPlayData_Control,PlayerPlayData_Injuries)

table13 <- PlayerPlayData %>%
  filter(Average_Speed != Inf & Max_Acceleration != -Inf) %>%
  group_by(Concussion_On_Play) %>%
  summarize(mean_player_speed = mean(Average_Speed),
            mean_player_velocity = mean(Average_Velocity),
            mean_max_player_velocity = mean(Max_Velocity),
            mean_max_player_acceleration = mean(Max_Acceleration))

kable(table13) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

I decided to look at mean speed, velocity and acceleration instead of frame by frame to see whether there was a discernable difference in whether players are faster on concussion plays than not. Concussion plays have players going at a slightly higher max velocity and acceleration, but nothing dramatic. Let's perhaps look at velocity more closely.

### Plotting Velocity of Primary Partner Vs Player

```{r include=FALSE}
cID <- concussions %>% select(GameKey,PlayID,GSISID)
cID$InjuryRole <- "Player"
cID2 <- concussions %>% select(GameKey,PlayID,Primary_Partner_GSISID)
cID2$InjuryRole <- "Primary Partner"
colnames(cID2)[colnames(cID2)=="Primary_Partner_GSISID"] <- "GSISID"
cID <- rbind(cID,cID2)
cID <- cID %>% na.omit()

#Subset velocity data so that change in time is 0.1 and velocity is greater than 0
v <- velAcc_injuries %>% 
  select(-Date,-Time)
v <- v[ which(v$Change_In_Time < 0.2 & v$Change_In_Time > 0), ]
#v <- v[ which(v$Velocity > 0), ]

v <- v %>%
  right_join(cID, by="GSISID")

# Remove NaNs
v[] <- lapply(v, function(x){ 
     x[is.nan(x)] <- NA 
     x 
}) 

# Remove plays with odd velocity graphs in relation to others.
v <- v[v$PlayID.x != 3278,]
v <- v[v$PlayID.x != 2792,]
v <- v[v$PlayID.x != 1526,]
v <- v[v$PlayID.x != 1988,]
v <- v[v$PlayID.x != 3129,]
```

```{r}
v %>%
  ggplot(aes(x = Time_As_Seconds, y= Velocity, group = InjuryRole)) + 
  geom_smooth(aes(linetype = InjuryRole, color = InjuryRole),se = FALSE) +
  facet_wrap(~PlayID.x, scales = "free") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

We can see that the peaks are where the contact is likely to happen. [What is interesting to note is how STEEP the deceleration occurs after a number of these plays](https://www.ncbi.nlm.nih.gov/pmc/articles/PMC155415/). Acceleration-deceleration of these kinds of plays has been studied and have found that hits to the helmet or shoulder will result in a quick deceleration and result in greater force applied. We can see when the hits occur by the drops after sizeable increases in velocity.

### Concussions by Hang Time

```{r echo=FALSE}
hangTime <- rbind(hangTime_control,hangTime_injuries)

hangTime %>%
  group_by(Concussion_On_Play) %>%
  summarize(mean_hang_time = mean(Hang_Time_In_Seconds))

ggplot(hangTime, aes(x = Hang_Time_In_Seconds, y = Concussion_On_Play, fill = Concussion_On_Play)) + stat_density_ridges(quantile_lines = TRUE, quantiles = c(0.025, 0.5, 0.975), alpha = 0.7) +
  labs(title = "Concussions by Hang Time", x = "Hang Time in Seconds", y = "Concussion Y/N") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

### Concussions by Play Time in Seconds

```{r}
PlayerPlayData <- rbind(PlayerPlayData_Control,PlayerPlayData_Injuries)

table14 <- PlayerPlayData %>%
  filter(Total_Play_Time_In_Seconds != 0) %>%
  group_by(Concussion_On_Play) %>%
  summarize(mean_play_time = mean(Total_Play_Time_In_Seconds))

kable(table14) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

There does seem to be a different of about 3 seconds for plays that have concussions versus those that don't.

```{r include=FALSE}
ggplot(PlayerPlayData, aes(x = Total_Play_Time_In_Seconds, y = Concussion_On_Play, fill=Concussion_On_Play)) + 
  stat_density_ridges(quantile_lines = TRUE, quantiles = c(0.025, 0.5, 0.975), alpha = 0.7) +
  labs(title = "Concussion Events By Play Time in Seconds", x = "Seconds", y = "Concussion Y/N") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

### Concussions by Total Distance in Meters

```{r}
table15 <- PlayerPlayData %>%
  filter(Total_Play_Time_In_Seconds != 0) %>%
  group_by(Concussion_On_Play) %>%
  summarize(mean_distance_travelled = mean(Total_Distance_In_Meters))

kable(table15) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

```{r echo=FALSE}
ggplot(PlayerPlayData, aes(x = Total_Distance_In_Meters, y = Concussion_On_Play, fill=Concussion_On_Play)) + 
  stat_density_ridges(quantile_lines = TRUE, quantiles = c(0.025, 0.5, 0.975), alpha = 0.7) +
  labs(title = "Concussion Events by Distance in Meters", x = "Total Distance in Meters", y = "Concussion on Play Y/N") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()
```

It doesn't look like much different when graphed but an increase on average of about 7 meter travelled by player could possibly coincide in where the ball is run by the carrier. It's ltime to look at positioning!

---

## A Look at Positioning

### Plotting Where Ball Was Received - Injuries Vs. Control Plays

```{r}
prxy <- ggplot(puntReceivedxy, aes(x=x, y=y, shape=Concussion_On_Play)) +
  geom_point(aes(color = Concussion_On_Play, size = Concussion_On_Play)) +
  scale_size_manual(values = c(2,3)) + 
  labs(title = "Concussion Events Where Ball Received", x = "x", y = "y") +
  scale_fill_fivethirtyeight() +
  theme_fivethirtyeight()

# Scatter plot colored by groups ("Species")
prxy <- ggscatter(puntReceivedxy, x = "x", y = "y", color = "Concussion_On_Play",size = 3, alpha = 0.6) + 
  border() + theme(legend.position="bottom") +
  labs(title = "Concussion Events Where Ball Received", x = "x", y = "y") +
  scale_fill_fivethirtyeight()

# Marginal density plot of x (top panel) and y (right panel)
xplot <- ggdensity(puntReceivedxy, "x", fill = "Concussion_On_Play") +
  labs(title = "Marginal Density by x", x = "x", y = "density") +
  scale_fill_fivethirtyeight()
yplot <- ggdensity(puntReceivedxy, "y", fill = "Concussion_On_Play") +
  labs(title = "by y", x = "y", y = "density") +
  rotate() +
  scale_fill_fivethirtyeight()
# Cleaning the plots
yplot <- yplot + clean_theme() + rremove("legend") 
xplot <- xplot + clean_theme() + rremove("legend")
plot_grid(xplot, NULL, prxy, yplot, ncol = 2, align = "hv", 
      rel_widths = c(2, 1), rel_heights = c(1, 2))
```

Looks like there's some difference in density on the field where the ball is received. We can sort of see where some balls are more likely to land on concussion plays, but nothing pops out as significant.

### Plotting Ball Carrier Route in Control Instances 

```{r}
bcr <- NGScontrol
bcr$Time_As_Seconds <- period_to_seconds(NGScontrol$Time)
bcr <- bcr[ -c(5,6) ]

bcr <- bcr  %>%
  filter(Role=="PR")

ggplot(data = bcr, aes(x = x, y = y)) + geom_point() + stat_density_2d(aes(fill = stat(level)), geom = "polygon") +
  labs(title = "Ball Carrier Route - Control", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

I've plotted running paths as well as point density to get a better idea of what these squiggles are telling us. In punt plays where the ball carrier receives the ball, we can see that there is an increase in fair catches (as we noted before) since there is a higher density of where balls tend to be kicked. So how about concussion punt plays? 

```{r}
bcri <- NGSconcussions
bcri$Time_As_Seconds <- period_to_seconds(bcri$Time)
bcri <- bcri[ -c(5,6) ]

bcri <- bcri  %>%
  filter(Role=="PR")

ggplot(data = bcri, aes(x = x, y = y)) + geom_point() + stat_density_2d(aes(fill = stat(level)), geom = "polygon") +
  labs(title = "Ball Carrier Route - Concussion Plays", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

We can see again here that the ball carriers make more running plays.

### Player Density at Punt

```{r}
puntPosition <- NGS %>%
  select(-Time) %>%
  filter(Event =="punt") 

concussionsub <- concussions %>%
   select(GameKey,PlayID,Concussion_On_Play) 

puntPosition <- puntPosition %>%
  left_join(concussionsub)

ggplot(puntPosition, aes(x=x, y=y)) +
  stat_density_2d(aes(fill = ..level..), geom = "polygon", colour="white") + facet_wrap(~Concussion_On_Play) +
  labs(title = "Player Density at Punt", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

Player positioning when the ball is punted looks very interesting when you compare concussion plays to control ones. Thi graph leads one to suspect that wedge blocks are occuring on concussion plays. We wee a higher density of players at either end on concussion plays here. 

### Player Density When Punt Received

```{r}
puntReceived <- NGS %>%
  select(-Time) %>%
  filter(Event =="punt_received") 

puntReceived <- puntReceived %>%
  left_join(concussionsub)

ggplot(puntReceived, aes(x=x, y=y)) +
  stat_density_2d(aes(fill = ..level..), geom = "polygon", colour="white") + facet_wrap(~Concussion_On_Play) +
  labs(title = "Player Density When Punt Received", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

Players seem slightly more spread out on concussion plays at the point where the punt is received.

### Player Density at First Contact

```{r}
firstContact <- NGS %>%
  select(-Time) %>%
  filter(Event =="first_contact") 

firstContact <- firstContact %>%
  left_join(concussionsub)

ggplot(firstContact, aes(x=x, y=y)) +
  stat_density_2d(aes(fill = ..level..), geom = "polygon", colour="white") + facet_wrap(~Concussion_On_Play)+
  labs(title = "Player Density at First Contact", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

These are some very interesting pattern differences in density. Players on concussion plays tend to consolidate along the same line, possibly where blocks are being made and where the ball carrier is.

### Player Density by Risk Level in Last 3 Seconds of Play

- Positions that have gotten 1 or fewer concussions are: GR, P, PDL2, PDR1, PFB, PLL, PPR and VR. - Low Risk
- Positions with two concussions: PRW, PRT, PLT, PLS - Medium Risk
- Positions that get 4 or more concussions: PRG, PLW, PLG, GL, PR - High Risk

```{r}
playerRisk <- NGS %>%
  select(-Time) %>%
  group_by(GameKey, PlayID, GSISID) %>%
  top_n(-30,x)

concussionsub <- concussionsub %>%
  left_join(playPlayerRoleData)

playerRisk <- playerRisk %>%
  left_join(concussionsub)

playerRisk$Risk_Level <- ifelse(playerRisk$Role=='GR', 'Low',ifelse(playerRisk$Role=='P', 'Low',ifelse(playerRisk$Role=='PLD2', 'Low', ifelse(playerRisk$Role=='PDR1', 'Low',ifelse(playerRisk$Role=='PFB', 'Low',ifelse(playerRisk$Role=='PLL', 'Low',ifelse(playerRisk$Role=='PPR', 'Low',ifelse(playerRisk$Role=='VR', 'Low',ifelse(playerRisk$Role=='PRW', 'Medium',ifelse(playerRisk$Role=='PRT', 'Medium',ifelse(playerRisk$Role=='PLT', 'Medium',ifelse(playerRisk$Role=='PLS', 'Medium',ifelse(playerRisk$Role=='PRG', 'High',ifelse(playerRisk$Role=='PLW', 'High', ifelse(playerRisk$Role=='PLG', 'High',ifelse(playerRisk$Role=='GL','High',ifelse(playerRisk$Role=='PR', 'High',NA)))))))))))))))))

playerRisk <- playerRisk %>%
  drop_na((Risk_Level))

ggplot(playerRisk, aes(x=x, y=y)) +
  stat_density_2d(aes(fill = ..level..), geom = "polygon", colour="white") + facet_wrap(~Concussion_On_Play) +
  labs(title = "Positions Who Received Concussions - Density on Field", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

### High Risk Player Density on Field in last 3 Seconds of Play

```{r}
playerRisk %>%
  filter(Risk_Level == "High") %>%
  ggplot(aes(x=x, y=y)) +
  stat_density_2d(aes(fill = ..level..), geom = "polygon", colour="white") + facet_wrap(~Concussion_On_Play) +
  labs(title = "High Risk Positions Density on Concussion Plays", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

### Ball Carrier Location Density on Field in last 3 Seconds of Play

```{r}
playerRisk %>%
  filter(Role == "PR") %>%
  ggplot(aes(x=x, y=y)) +
  stat_density_2d(aes(fill = ..level..), geom = "polygon", colour="white") + facet_wrap(~Concussion_On_Play) +
  labs(title = "Ball Carrier Location in Last 3 Seconds of Play - Concussion", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

We can see that the higher risk players live in the higher density areas on the field and tend to be close to the ball carrier. This is no surprise since this is the player everyone is either trying to hit/protect.

---

## A Closer Look at Pre Season Differences

### Number of Punts

```{r}
preSeasonpunts <- gameData %>%
  group_by(Season_Type,GameKey) %>%
  summarise(ppg = sum(Number_Of_Punts)) %>%
  select(-GameKey) %>% 
  filter(Season_Type=="Pre")

mean(preSeasonpunts$ppg, na.rm=T)
```

```{r}
regSeasonpunts <- gameData %>%
  group_by(Season_Type,GameKey) %>%
  summarise(ppg = sum(Number_Of_Punts)) %>%
  select(-GameKey) %>% 
  filter(Season_Type=="Reg")

mean(regSeasonpunts$ppg, na.rm=T)
```

More punts on average in a pre season game means a greater likelihood of concussions.

### Event Breakdown

```{r}
eventBreakdown <- NGS %>%
  select(-Time) %>%
  filter(Event == "punt_received" | Event == "out_of_bounds" | Event == "fair_catch" | Event == "touchback") %>%
  left_join(gameData) %>%
  group_by(Season_Type,Event) %>%
  summarise(count = n())

table16 <- eventBreakdown %>%
  group_by(Season_Type) %>%
  mutate(Pct_Of_Total = count / sum(count)*100)

kable(table16) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

There are about 15% more running plays in the pre season than there are in the regular season.

### Speed, Velocity and Acceleration

```{r}
table17 <- PlayerPlayData %>%
  left_join(gameData) %>%
  filter(Average_Speed != Inf & Max_Acceleration != -Inf) %>%
  group_by(Season_Type) %>%
  summarize(mean_player_speed = mean(Average_Speed),
            mean_player_velocity = mean(Average_Velocity),
            mean_max_player_velocity = mean(Max_Velocity),
            mean_max_player_acceleration = mean(Max_Acceleration))

kable(table17) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

Nothing really standing out here in terms of speed on the field.

### Player Density at First Contact

```{r}
preRegFirstContact <- NGS %>%
  select(-Time) %>%
  filter(Event =="first_contact") 

preRegFirstContact <- preRegFirstContact %>%
  left_join(gameData)

ggplot(preRegFirstContact, aes(x=x, y=y)) +
  stat_density_2d(aes(fill = ..level..), geom = "polygon", colour="white") + facet_wrap(~Season_Type) +
  labs(title = "Player Density at First Contact by Season Type", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

Players seem to congregate in a much smaller area.

### Player Density with 3 Seconds Left in Play - Season Type

```{r}
playerRiskpreReg <- playerRisk %>%
  left_join(gameData)

ggplot(playerRiskpreReg, aes(x=x, y=y)) +
  stat_density_2d(aes(fill = ..level..), geom = "polygon", colour="white") + facet_wrap(~Season_Type) +
  labs(title = "Player Density with 3 Seconds Left in Play by Season Type", x = "x", y = "y") +
  scale_fill_distiller(palette= "Spectral", direction=-1) +
  theme_fivethirtyeight()
```

Again, a lot less variance in positioning on pre season games.

<center><img src="https://cdn-images-1.medium.com/max/800/1*0_qnGt6Jtn5ManbYsHgbig.png", width="100%"></center>

## A Closer Look at Missed Calls

### Average Penalties in Concussion Games Vs. Control

```{r echo=FALSE}
allPunts$Penalty_On_Play <- ifelse(grepl("PENALTY", allPunts$PlayDescription, ignore.case = T), "Yes","No")

penaltiesPuntPlaysConcussion <- allPunts %>%
  left_join(completePlays) %>%
  group_by(GameKey,Penalty_On_Play) %>%
  filter(Penalty_On_Play=="Yes") %>%
  summarise(penalty_count_on_punt_plays = n()) %>%
  select(-Penalty_On_Play) %>%
  left_join(concussionsCount) %>%
  select(-Number_Of_Punts) %>%
  filter(Number_Of_Concussions_In_Game > 0)

kable(penaltiesPuntPlaysConcussion) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F,position = "left")
```

```{r}
mean(penaltiesPuntPlaysConcussion$penalty_count_on_punt_plays, na.rm=T)
```

```{r echo=FALSE}
penaltiesPuntPlaysControl <- allPunts %>%
  left_join(completePlays) %>%
  group_by(GameKey,Penalty_On_Play) %>%
  filter(Penalty_On_Play=="Yes") %>%
  summarise(penalty_count_on_punt_plays = n()) %>%
  select(-Penalty_On_Play) %>%
  left_join(concussionsCount) %>%
  select(-Number_Of_Punts) %>%
  filter(Number_Of_Concussions_In_Game == 0)

mean(penaltiesPuntPlaysControl$penalty_count_on_punt_plays, na.rm=T)
```

Again, not much difference in penalty count per game. 

---

# What We Learned

There seem to be several factors that contribute to increased likelihood of concussions:

**Player Desperation:** Concussions are more likely to happen in close games where punts create opportunities for the receiving team to take advantage of. This was discovered by looking at score differential and time left in the game.

**Use of Helmet:** Lots of helmets are down on concussion plays, whether they are bracing or aware or not. This is a rule that I think should stick around.

**Deceleration:** We noted that player and partner velocities were fairly even on most plays, but the impact causing sudden decelerations seems to be an important factor in causing severe concussions.

**Time:** Longer plays thanks to yards punted and yards gained increase the likelihood of concussion plays. This could be a player confusion impact as well, as the longer the play runs the more uncertainty there is in the outcome and what a player believes they should be doing on the field. Fatigue could also play a role as a result. Longer plays will wear players out!

**Missed calls:** As of this year the Use of Helmets should've made at least half of the plays where someone was concussed illegal. The remaining number of concussions where players both have their heads up might be calls that went unnoticed (defenceless player, illegal blocks above the waist etc.)

**Pre Season anomaly:** My guess is that less experienced players trying out for the team will be overly aggresive on plays. It could also be that time off has rusted player abilities a bit, and more mistakes are made with players being less aware of their surroundings.

---

# Proposed Rule Changes

We can't do much about player desperation, and use of helmet is currently a rule, so!

**Make Wedge Blocks Illegal:** There will be critics who say that the ball carrier is more open to getting hit when he is not allowed coverage, but this will also incentivize more ball carriers to end plays as fair catch. We are also not talking about removing blocks entirely! It could be decided that tackles on a ball carrier and his support system can only be tackled by using the hands to push back or wrap around the waist.

**The Third Eye:** I noticed on the videos that there were numerous instances where I thought there should've been a penalty on the play. When concussion plays also have a higher player density in certain areas it is not surprising that calls are missed. Having an extra ref (or removing one of the ref from the field if you think 7 refs is enough), and having them on the sideline looking at the game at the elevation viewers at home get to see provides a much better picture of what's going on. More calls on illegal blocks, use of helmet etc. would be made in my opinion, and players would change their hitting habits after cals started becoming better enforced. 

**Mandatory Pre Season Concussion Clinics:** Proper hitting techniques and practicing without equipment could be a good way to get players into the habit of proper hitting habits.

**Kickoff Rules:** Changes in where a player(s) can be blocked/tackled may be necessary. I believe this will slow the punt plays down and help reduce severe concussions when you give players a safety net.

---

# Thanks for Reading!

<center><img src="https://cdn-images-1.medium.com/max/800/1*HOuuVFF3qM105kL_rn6Ozw.png", width="100%"></center>