--- title: "Player Movement Effects" df_print: paged output: html_document: df_print: paged theme: journal code_folding: hide toc: yes toc_depth: 3 numbered_sections: yes --- ``` {r import libraries, include = FALSE} library(dplyr) library(ggplot2) ``` # Other Notebooks My complete analysis is split between four notebooks. The remaining three are listed below: [Exploratory Analysis of NFL Non-Contact Injuries](https://www.kaggle.com/erinpsajdl/exploratory-analysis-of-nfl-non-contact-injuries) \ This notebook takes an in-depth look at the variables provided in the given datasets and how they intereact with the others. [Injury Risk Model for NFL Non-Contact Injuries](https://www.kaggle.com/erinpsajdl/injury-risk-model-for-nfl-non-contact-injuries) \ The notebook builds out the injury risk model for non-contact lower limb injuries. [Player Movement Patterns](https://www.kaggle.com/erinpsajdl/player-movement-patterns) \ This notebook looks at the player movement patterns for injured players in various scenarios. In this notebook, I will look at the effect that various scenarios have on player movement. ``` {r import data, include = FALSE} PlayerTrackData <- data.table::fread("../input/playereffects/PlayerEffects.csv",stringsAsFactors = F) ``` ``` {r clean stadium type, inlcude = FALSE} # Set Categories for Stadium Type outdoor <- c('Bowl','Cloudy','Heinz Field','Oudoor','Ourdoor','Outddors','Outdoors','Outdor','Outside','Outdoor') indoor_closed <- c('Indoor','Indoor, Roof Closed', 'Indoors','Retr. Rood - Closed','Retr. Roof Closed', 'Retr. Roof-Closed', 'Retractable Roof', 'Closed Dome','Dome','Dome, closed','Domed','Domed, closed') indoor_open <- c('Indoor, Open Roof','Retr. Roof - Open', 'Retr. Roof-Open', 'Open','Domed, open', 'Domed, Open','Outdoor Retr Roof-Open') # Transform Data clean_stadiums <- function(x) { if (x %in% outdoor) { "Outdoor" } else if(x %in% indoor_closed) { "Indoor Closed" } else if(x %in% indoor_open){ "Indoor Open" } else { "Unknown" } } PlayerTrackData <- PlayerTrackData %>% mutate(StadiumType = mapply(clean_stadiums, StadiumType)) ``` ## Average and Maximum Speed by Game Scenario While still looking at the average and maximum speeds, let us take a look at these metrics vary by game scenario. ``` {r average and maximum speed by weather} PlayerTrackData %>% group_by(PlayKey) %>% filter(Weather != "unknown") %>% ggplot(aes(x=Average_Speed)) + geom_density(aes(fill=Weather,color=Weather),alpha=0.4) + ggtitle("Average Speed Per Play By Weather Condition") + theme(plot.title = element_text(face="bold")) + labs(x="Speed (Yards/Second)",y="Distribution",fill="Weather") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("cadetblue2","aquamarine2","goldenrod2","mediumpurple2","salmon2","thistle1")) + scale_color_manual(values=c("cadetblue4","aquamarine4","goldenrod4","mediumpurple4","salmon4","thistle2")) + guides(color=FALSE) PlayerTrackData %>% group_by(PlayKey) %>% filter(Weather != "unknown") %>% ggplot(aes(x=Max_Speed)) + geom_density(aes(fill=Weather,color=Weather),alpha=0.4) + ggtitle("Maximum Speed Per Play By Weather Condition") + theme(plot.title = element_text(face="bold")) + labs(x="Speed (Yards/Second)",y="Distribution",fill="Weather") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("cadetblue2","aquamarine2","goldenrod2","mediumpurple2","salmon2","thistle1")) + scale_color_manual(values=c("cadetblue4","aquamarine4","goldenrod4","mediumpurple4","salmon4","thistle2")) + guides(color=FALSE) ``` ``` {r average and maximum speed by stadium type} PlayerTrackData %>% group_by(PlayKey) %>% filter(StadiumType != "Unknown") %>% ggplot(aes(x=Average_Speed)) + geom_density(aes(fill=StadiumType,color=StadiumType),alpha=0.4) + ggtitle("Average Speed Per Play By Stadium Type") + theme(plot.title = element_text(face="bold")) + labs(x="Speed (Yards/Second)",y="Distribution",fill="Stadium Type") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("cadetblue2","aquamarine2","salmon2")) + scale_color_manual(values=c("cadetblue4","aquamarine4","salmon4")) + guides(color=FALSE) PlayerTrackData %>% group_by(PlayKey) %>% filter(StadiumType != "Unknown") %>% ggplot(aes(x=Max_Speed)) + geom_density(aes(fill=StadiumType,color=StadiumType),alpha=0.4) + ggtitle("Maximum Speed Per Play By Stadium Type") + theme(plot.title = element_text(face="bold")) + labs(x="Speed (Yards/Second)",y="Distribution",fill="Stadium Type") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("cadetblue2","aquamarine2","salmon2")) + scale_color_manual(values=c("cadetblue4","aquamarine4","salmon4")) + guides(color=FALSE) ``` There is not a noticeable difference in speed by weather or by stadium type. ## Total Distance ``` {r total distance create, include = FALSE} # Distance Summary Statistic PlayerTrackData <- PlayerTrackData %>% group_by(PlayKey) %>% mutate(Total_Dis = sum(dis, na.rm = T)) %>% ungroup() ``` ``` {r create injury column, include = FALSE} InjuryRecord <- data.table::fread("../input/nfl-playing-surface-analytics/InjuryRecord.csv",stringsAsFactors = F) PlayerTrackData <- PlayerTrackData %>% mutate(Injury = ifelse(PlayerTrackData$PlayKey %in% InjuryRecord$PlayKey, "TRUE", "FALSE")) ``` ``` {r total distance graphs} # Distance By Injury ggplot(data=PlayerTrackData,aes(x=Total_Dis)) + geom_density(aes(fill=Injury,color=Injury),alpha=0.6) + ggtitle("Total Distance By Injury") + theme(plot.title = element_text(face="bold")) + labs(x="Distance (Yards)",y="Distribution",fill="Injury") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("paleturquoise2","darkseagreen2")) + scale_color_manual(values=c("paleturquoise4","darkseagreen4")) # Distance By Field Type ggplot(data=PlayerTrackData,aes(x=Total_Dis)) + geom_density(aes(fill=FieldType,color=FieldType),alpha=0.6) + ggtitle("Total Distance By Field Type") + theme(plot.title = element_text(face="bold")) + labs(x="Distance (Yards)",y="Distribution",fill="Injury") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("paleturquoise2","darkseagreen2")) + scale_color_manual(values=c("paleturquoise4","darkseagreen4")) + guides(color=FALSE) ``` A further total distance is ran on plays that result in injury, however we do not see a difference between total distnace per play on synthetic and natural turf. ``` {r create ending acc and dc, include = FALSE} # Create variable for Acceleration PlayerTrackData$Acceleration <- NA PlayerTrackData$Acceleration[-1] <- with(PlayerTrackData, (s[-1]-s[-length(s)])/(time[-1]-time[-length(time)])) PlayerTrackData$Acceleration[which(PlayerTrackData$time == 0)] <- NA # Create variable for Change of Direction PlayerTrackData$DirChange <- NA PlayerTrackData$DirChange[-1] <- with(PlayerTrackData, dir[-1]-dir[-length(dir)]) PlayerTrackData$DirChange[which(PlayerTrackData$time == 0)] <- NA # Adjusting for change in direction that would be greater or less than 180 degress ... PlayerTrackData$DirChange[which(PlayerTrackData$DirChange <(-180))] <- PlayerTrackData$DirChange[which(PlayerTrackData$DirChange <(-180))]+360 PlayerTrackData$DirChange[which(PlayerTrackData$DirChange >(+180))] <- PlayerTrackData$DirChange[which(PlayerTrackData$DirChange >(+180))]-360 PlayerTrackData <- PlayerTrackData %>% group_by(PlayKey) %>% mutate(End_Acc = last(Acceleration)) %>% mutate(End_DC = last(DirChange)) %>% ungroup() ``` ## Direction and Orienation ``` {r orientaton and direction, warning = FALSE, message = FALSE} ggplot(data=PlayerTrackData,aes(x=dir)) + geom_density(aes(fill=Injury,color=Injury),alpha=0.6) + ggtitle("Direction of Run By Injury") + theme(plot.title = element_text(face="bold")) + labs(x="Direction of Run (Degrees)",y="Distribution",fill="Injury") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("paleturquoise2","darkseagreen2")) + scale_color_manual(values=c("paleturquoise4","darkseagreen4")) ggplot(data=PlayerTrackData,aes(x=o)) + geom_density(aes(fill=Injury,color=Injury),alpha=0.6) + ggtitle("Orientation of Run By Injury") + theme(plot.title = element_text(face="bold")) + labs(x="Orientation of Run (Degrees)",y="Distribution",fill="Injury") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("paleturquoise2","darkseagreen2")) + scale_color_manual(values=c("paleturquoise4","darkseagreen4")) ``` Now I am going to look at the ending acceleration and directional change. My thinking in this is it might give some insight to the time an injury occurred (if the play ended when the injury occurred), however that is still not known. It would still be more beneficial to know the exact time of the play the injury occurred, if possible. ``` {r end acc and dc graphs, warning = FALSE} ## Ending Acceleration By Injury ggplot(data=PlayerTrackData,aes(x=End_Acc)) + geom_density(aes(fill=Injury,color=Injury),alpha=0.6) + ggtitle("Endng Acceleration By Injury") + theme(plot.title = element_text(face="bold")) + labs(x="Acceleration (Yards Per Second Per Second)",y="Distribution",fill="Injury") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("paleturquoise2","darkseagreen2")) + scale_color_manual(values=c("paleturquoise4","darkseagreen4")) ## Ending Directional Change By Injury ggplot(data=PlayerTrackData,aes(x=End_DC)) + geom_density(aes(fill=Injury,color=Injury),alpha=0.6) + ggtitle("Endng Directional Change By Injury") + theme(plot.title = element_text(face="bold")) + labs(x="Directional Change (Degrees)",y="Distribution",fill="Injury") + theme(legend.background = element_rect(color="#666666", fill = 'white', linetype = "solid")) + scale_fill_manual(values=c("paleturquoise2","darkseagreen2")) + scale_color_manual(values=c("paleturquoise4","darkseagreen4")) ``` The acceleration graph still is not showing much, but the ending directional change is a bit more interesting. Plays resulting in an injury tend to have an ending directional change cutting to the right. ``` {r import injury coordinates, include = FALSE} InjuryCoords <- data.table::fread("../input/injurycoordinates3/InjuryCoordinates.csv", stringsAsFactors = F) table(InjuryCoords$PlayType) ``` ## Player Movement By Play Type The following graphs will show the paths taken by players that resulted in injury. ### Kickoff ``` {r kickoff injuries} InjuryCoords %>% filter(PlayType == 'Kickoff') %>% filter(FieldType == "Natural") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Kickoff Plays Resulting in Injury on Natural Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") InjuryCoords %>% filter(PlayType == 'Kickoff') %>% filter(FieldType == "Synthetic") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Kickoff Plays Resulting in Injury on Synthetic Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") ``` On kickoffs on natural turf, there are sharp changes of direction that result in injury. On kickoffs on synthetic turf, there are not as sharp of directional changes. ### Kickoff Not Returned ``` {r kickoff not returned injuries} InjuryCoords %>% filter(PlayType == 'Kickoff Not Returned') %>% filter(FieldType == "Synthetic") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Kickoff Not Returned Plays Resulting in Injury on Synthetic Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") ``` Again, this injury on synthetic turf does not have a sharp change of direction. ### Kickoff Returned ``` {r kickoff returned injuries} InjuryCoords %>% filter(PlayType == 'Kickoff Returned') %>% filter(FieldType == "Synthetic") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Kickoff Returned Plays Resulting in Injury on Synthetic Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") ``` This play did have a couple sharp changes of directon - however, we do not know exactly where the injury occurred. ### Pass ``` {r pass injuries} InjuryCoords %>% filter(PlayType == 'Pass') %>% filter(FieldType == "Natural") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Pass Plays Resulting in Injury on Natural Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") InjuryCoords %>% filter(PlayType == 'Pass') %>% filter(FieldType == "Synthetic") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Pass Plays Resulting in Injury on Synthetic Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") ``` Again, on natural turf, we see more sharp cuts than we do on synthetic turf. ### Punt ``` {r punt injuries} InjuryCoords %>% filter(PlayType == 'Punt') %>% filter(FieldType == "Natural") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Punt Plays Resulting in Injury on Natural Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") InjuryCoords %>% filter(PlayType == 'Punt') %>% filter(FieldType == "Synthetic") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Punt Plays Resulting in Injury on Synthetic Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") ``` Punting places are again the anomaly. The sharper cuts are occurring on synthetic turf, rather than natural turf. ### Punt Not Returned ``` {r punt not returned injuries} InjuryCoords %>% filter(PlayType == 'Punt Not Returned') %>% filter(FieldType == "Synthetic") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Punt Not Returned Plays Resulting in Injury on Synthetic Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") ``` Here there are a couple sharp cuts at the end of the run. ### Punt Returned ``` {r punt returned injuries} InjuryCoords %>% filter(PlayType == 'Punt Returned') %>% filter(FieldType == "Natural") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Punt Returned Plays Resulting in Injury on Natural Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") InjuryCoords %>% filter(PlayType == 'Punt Returned') %>% filter(FieldType == "Synthetic") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Punt Returned Plays Resulting in Injury on Synthetic Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") ``` Again, sharp directional changes at the end of the run. ### Rush ``` {r rush injuries} InjuryCoords %>% filter(PlayType == 'Rush') %>% filter(FieldType == "Natural") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Rush Plays Resulting in Injury on Natural Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") InjuryCoords %>% filter(PlayType == 'Rush') %>% filter(FieldType == "Synthetic") %>% ggplot(aes(x=x, y=y, size=s, col=PlayKey)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = "none") + ggtitle("Tracking Rush Plays Resulting in Injury on Synthetic Turf") + xlab("Sideline (X Coordinates)") + ylab("Endzone (Y Coordinates)") ``` With rushing plays, we see more directional changes on both playing surfaces - in part due to the nature of rushing plays.