{"cells":[{"metadata":{"_uuid":"051d70d956493feee0c6d64651c6a088724dca2a","_execution_state":"idle","trusted":true},"cell_type":"code","source":"library(tidyverse) # metapackage with lots of helpful functions\nlibrary(data.table) # for fread\n\nPlayList <- data.table::fread(\"../input/nfl-playing-surface-analytics/PlayList.csv\")\nPlayerData <- data.table::fread(\"../input/nfl-playing-surface-analytics/PlayerTrackData.csv\")\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Let's identify the maximum speed for each player on each play:"},{"metadata":{"trusted":true},"cell_type":"code","source":"PD2 <- PlayerData %>% group_by(PlayKey) %>% summarize(Max.Speed = max(s))\nPD2 <- PD2 %>% left_join(PlayList, by = \"PlayKey\") %>% select(PlayKey, GameID, PlayerKey, PlayerDay, PlayerGamePlay, Position = RosterPosition, Max.Speed) %>% arrange(PlayerKey, GameID, PlayerGamePlay)\nhead(arrange(PD2, desc(Max.Speed)))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Clearly a few of these players could not have the stated maximum speed - 42.74 yds/s is about 87 mph. Since the maximum speed of a human is about 27 mph (13.2 yds/s), let's get rid those top few plays."},{"metadata":{"trusted":true},"cell_type":"code","source":"PD2 <- PD2 %>% filter(Max.Speed < 13)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Now let's look at the maximum speed distribution for, say, one player:"},{"metadata":{"trusted":true},"cell_type":"code","source":"PD2 %>% filter(PlayerKey == 26624) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  labs(title = \"Player 26624\", x = \"Maximum Speed (Play)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Can we identify differences in the maximum speed between plays on which players were injured and plays on which they were not? Let's try to merge the data to get things in a more usable format:"},{"metadata":{"trusted":true},"cell_type":"code","source":"injury <- data.table::fread(\"../input/nfl-playing-surface-analytics/InjuryRecord.csv\")\ninjury.match <- merge(PD2, injury, all.x = TRUE, all.y = FALSE) %>% mutate(Injured = !is.na(BodyPart))  # left join with injury record, then create Boolean yes/no about if player was injured on play\nhead(injury.match)\ninjury.match %>% filter(PlayerKey == 39873, Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + # first player injured in InjuryRecord\n  geom_density() + \n  geom_vline(data = injury.match %>% filter(PlayerKey == 39873, Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") +\n  labs(title = \"Player 39873\", x = \"Maximum Speed (Play)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":""},{"metadata":{},"cell_type":"markdown","source":"We should be able to do this for all players, injured and not, to see if there is a difference in distribution of maximum speed between injured and non-injured players. There are 250 players, which is too much to facet, but we can make multiple graphs. It makes sense to group by position."},{"metadata":{"trusted":true},"cell_type":"code","source":"injury.match %>% group_by(Position) %>% summarize(Players = length(unique(PlayerKey))) %>% arrange(desc(Players))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We can group tight ends/quarterbacks/kickers into an \"other\" category and produce 8 graphs."},{"metadata":{"trusted":true},"cell_type":"code","source":"player.plays <- PlayList %>% group_by(PlayerKey, RosterPosition) %>% count() %>% mutate(PlayerPlays = paste(paste(PlayerKey, n, sep = \": \"), \"Plays\", sep = \" \"))  # header for facets\nLB.all <- injury.match %>% filter(Position == \"Linebacker\") %>% left_join(player.plays, by = \"PlayerKey\")\nLB.all %>% filter(Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  geom_vline(data = LB.all %>% filter(Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") + \n  facet_wrap(~PlayerPlays) + \n  xlim(0,13) +\n  labs(title = \"Linebackers\", x = \"Maximum Speed (yds/s)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We can do it for the other positions as well; I should really turn this into a function but whatever..."},{"metadata":{"trusted":true},"cell_type":"code","source":"DL.all <- injury.match %>% filter(Position == \"Defensive Lineman\") %>% left_join(player.plays, by = \"PlayerKey\")\nDL.all %>% filter(Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  geom_vline(data = DL.all %>% filter(Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") + \n  facet_wrap(~PlayerPlays) + \n  xlim(0,13) +\n  labs(title = \"Defensive Linemen\", x = \"Maximum Speed (yds/s)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"The density curves for the defensive linemen look awfully similar...perhaps something similar with the offensive line?"},{"metadata":{"trusted":true},"cell_type":"code","source":"OL.all <- injury.match %>% filter(Position == \"Offensive Lineman\") %>% left_join(player.plays, by = \"PlayerKey\")\nOL.all %>% filter(Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  geom_vline(data = OL.all %>% filter(Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") + \n  facet_wrap(~PlayerPlays) + \n  xlim(0,13) +\n  labs(title = \"Offensive Linemen\", x = \"Maximum Speed (yds/s)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"These density curves look *really* similar. Will we see something similar if we look at a faster position?"},{"metadata":{"trusted":true},"cell_type":"code","source":"WR.all <- injury.match %>% filter(Position == \"Wide Receiver\") %>% left_join(player.plays, by = \"PlayerKey\")\nWR.all %>% filter(Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  geom_vline(data = WR.all %>% filter(Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") + \n  facet_wrap(~PlayerPlays) + \n  xlim(0,13) +\n  labs(title = \"Wide Receivers\", x = \"Maximum Speed (yds/s)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We see a lot of bimodal density curves, one lower (around 5 yds/s) and one higher(anywhere from 7-10), suggesting that wide receivers have two different responsibilities over the course of the game. Perhaps some of those unimodal curves are really from the same two distinct processes but the maximum  distributions from those processes overlap more for those players."},{"metadata":{"trusted":true},"cell_type":"code","source":"CB.all <- injury.match %>% filter(Position == \"Cornerback\") %>% left_join(player.plays, by = \"PlayerKey\")\nCB.all %>% filter(Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  geom_vline(data = CB.all %>% filter(Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") + \n  facet_wrap(~PlayerPlays) + \n  xlim(0,13) +\n  labs(title = \"Cornerbacks\", x = \"Maximum Speed (yds/s)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We see a similar pattern for cornerbacks, which makes sense as they are the players tasked with defending wide receivers."},{"metadata":{"trusted":true},"cell_type":"code","source":"S.all <- injury.match %>% filter(Position == \"Safety\") %>% left_join(player.plays, by = \"PlayerKey\")\nS.all %>% filter(Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  geom_vline(data = S.all %>% filter(Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") + \n  facet_wrap(~PlayerPlays) + \n  xlim(0,13) +\n  labs(title = \"Safeties\", x = \"Maximum Speed (yds/s)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We see a similarly bimodal distribution for most safeties, but there are a few that don't quite fit the pattern."},{"metadata":{"trusted":true},"cell_type":"code","source":"RB.all <- injury.match %>% filter(Position == \"Running Back\") %>% left_join(player.plays, by = \"PlayerKey\")\nRB.all %>% filter(Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  geom_vline(data = RB.all %>% filter(Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") + \n  facet_wrap(~PlayerPlays) + \n  xlim(0,13) +\n  labs(title = \"Running Backs\", x = \"Maximum Speed (yds/s)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Running backs are usually supposed to be fast, but we see either unimodal distributions with peaks around 5 yds/s or bimodal distributions with the main peak around 5 yds/s. 5 yds/s is only 10.2 mph, so this suggests that running backs rarely get up to what we would consider \"full speed\"."},{"metadata":{"trusted":true},"cell_type":"code","source":"OTHER.all <- injury.match %>% filter(Position %in% c(\"Quarterback\", \"Tight End\", \"Kicker\")) %>% left_join(player.plays, by = \"PlayerKey\")\nOTHER.all %>% filter(Injured == FALSE) %>% ggplot(aes(x = Max.Speed)) + \n  geom_density() + \n  geom_vline(data = OTHER.all %>% filter(Injured == TRUE), mapping= aes(xintercept = Max.Speed), color = \"red\") + \n  facet_wrap(~PlayerPlays) + \n  xlim(0,13) +\n  labs(title = \"Quarterbacks, Tight Ends, Kickers/Punters\", x = \"Maximum Speed (yds/s)\", y = \"Play Density\") + theme(plot.title = element_text(size = 16, hjust = 0.5))\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"As we might expect from a hodgepodge of positions, we have a hodgepodge of graphs. Players 26624, 27363, 39731, 42404, and 45927 are quarterbacks and rarely get above 5 yds/s. Players 42288, 43066, and 47331 are kickers (or punters? It's not clear)...perhaps each different type of play contributes differently to the maximum speed."},{"metadata":{},"cell_type":"markdown","source":"Based on what we know about football, it makes sense that the plays where players are most likely to reach their maximum speed are those in which they have a decent amount of room to run in a straight line. This would include punts, some kickoffs, and few offensive/defensive plays (essentially, only go routes or when an offensive player breaks away and sprints toward the end zone). With additional time, we should investigate to see if this hypothesis is borne out in the data."}],"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}