Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
library(tidyverse)
library(gganimate)
library(cowplot)
library(repr)
library(grid)
library(gridExtra)
library(rpart)
library(rpart.plot)
library(caret)
library(e1071)
library(randomForest)
library(gt)
library(ggridges)
options(warn=-1)
options(repr.plot.width=15, repr.plot.height = 10)
#Reading in all the data
df_games <- read.csv("~/Desktop/Football/Big Data Bowl/nfl-big-data-bowl-2021/games.csv")
df_players <- read.csv("~/Desktop/Football/Big Data Bowl/nfl-big-data-bowl-2021/players.csv")
df_plays <- read.csv("~/Desktop/Football/Big Data Bowl/nfl-big-data-bowl-2021/plays.csv")
weeks <- seq(1, 17)
df_tracking <- data.frame()
for(w in weeks){
df_tracking_temp <- read_csv(paste0("~/Desktop/Football/Big Data Bowl/nfl-big-data-bowl-2021/week",w,".csv"),
col_types = cols())
df_tracking <- bind_rows(df_tracking_temp, df_tracking)}
#Standardizing tracking data so its always in direction of offense vs raw on-field coordinates.
df_tracking <- df_tracking %>%
mutate(x = ifelse(playDirection == "left", 120-x, x),
y = ifelse(playDirection == "left", 160/3 - y, y))
###############################################################################
df_tracking <- df_tracking %>%
mutate(x = ifelse(playDirection == "left", 120-x, x),
y = ifelse(playDirection == "left", 160/3 - y, y))
df_merged <- inner_join(df_games,
df_plays,
by = c("gameId" = "gameId"))
df_merged <- inner_join(df_merged,
df_tracking,
by = c("gameId" = "gameId",
"playId" = "playId"))
passArivalEvents <- c('pass_outcome_caught',
'pass_arrived',
'pass_outcome_incomplete',
'pass_outcome_interception',
'pass_outcome_touchdown')
df_distanceToFootball <- df_merged %>%
#determining side of ball
mutate(sideOfBall = ifelse(#if tracked player is home and home has ball
((team == "home") &
(possessionTeam == homeTeamAbbr)) |
#if tracked player is away and away has ball
((team == "away") &
(possessionTeam == visitorTeamAbbr)),
#if either condition is true, offense
"offense",
#if neither condition is true, defense
"defense"),
#defining defensive team
defensiveTeam = ifelse(possessionTeam == homeTeamAbbr,
visitorTeamAbbr,
homeTeamAbbr)) %>%
#using DET on defense only
filter(defensiveTeam == "DET", sideOfBall == "defense") %>%
#grouping by game, play and frame
group_by(gameId, playId, frameId) %>%
#checking if football reading is in frame
mutate(footballInPlay = sum(displayName == "Football") > 0) %>%
#using only frames with football marked; some plays its missing
filter(footballInPlay) %>%
#adding x and y location of football as columns
mutate(xFootball = x[displayName == "Football"],
yFootball = y[displayName == "Football"]) %>%
#ungrouping
ungroup() %>%
#grouping by game and play
group_by(gameId, playId) %>%
#selecting frames that contain pass arrival events
filter(event %in% passArivalEvents) %>%
#selecting first frame with in case there are multiple
#filter(frameId == min(frameId)) %>%
#calculating distance to football
mutate(
distToFootballAtBallArrival = sqrt((x - xFootball) ^ 2 +
(y - yFootball) ^ 2)
)
#Getting the line of scrimmage and distance
line_of_scrim <- df_tracking %>%
filter(displayName == "Football", frameId == 1) %>%
select(gameId, playId, x)
names(line_of_scrim)[names(line_of_scrim) == "x"] <- "los"
df_tracking <- df_tracking %>%
left_join(line_of_scrim, by = c("gameId", "playId"))
df_tracking <- df_tracking %>%
mutate(dist_from_los = x - los,
dist_from_mid = y - 26.65)
line_of_scrim_1 <- week1 %>%
filter(displayName == "Football", frameId == 1) %>%
select(gameId, playId, x)
names(line_of_scrim_1)[names(line_of_scrim_1) == "x"] <- "los"
week1 <- week1 %>%
left_join(line_of_scrim, by = c("gameId", "playId"))
week1 <- week1 %>%
mutate(dist_from_los = x - los,
dist_from_mid = y - 26.65)
#Getting the personnel groupings
df_plays <- df_plays %>%
mutate(num_dl = substring(df_plays$personnelD, 1, 1),
num_lb = substring(df_plays$personnelD, 7, 7),
num_cb = substring(df_plays$personnelD, 13, 13))
df_plays$num_dl <- as.numeric(df_plays$num_dl)
df_plays$num_lb <- as.numeric(df_plays$num_lb)
df_plays$num_cb <- as.numeric(df_plays$num_cb)
df_plays_imp_stuff <- df_plays %>%
select(gameId, playId, down, yardsToGo, defendersInTheBox, numberOfPassRushers,
num_dl, num_lb, num_cb, epa)
################################################################################
df_coverages <- read.csv("~/Desktop/Football/Big Data Bowl/nfl-big-data-bowl-2021/coverages_week1.csv")
week1 <- read.csv("~/Desktop/Football/Big Data Bowl/nfl-big-data-bowl-2021/week1.csv")
week1 <- week1 %>%
left_join(df_coverages, by.x = c("gameId", "playId"), by.y = c("gameId", "playId"))
week1 <- week1 %>%
left_join(df_plays_imp_stuff, by.x = c("gameId", "playId"), by.y = c("gameId", "playId"))
playStartEvent <- 'ball_snap'
passArivalEvents <- c('pass_arrived')
week1_throw_events <- week1 %>%
filter(event %in% passArivalEvents)
week1_football <- week1_throw_events %>%
filter(team == "football") %>%
mutate(ball_x = x, ball_y = y) %>%
select(gameId, playId, frameId, ball_x, ball_y)
week1_throw_events <- week1_throw_events %>%
left_join(week1_football, by = c("gameId", "playId", "frameId"))
week1_throw_events <- week1_throw_events %>%
mutate(dist_from_ball = sqrt((x-ball_x)^2 + (y-ball_y)^2))
###############################################################################
week1_throw_events_d <- week1_throw_events %>%
filter(position == "SS" | position == "FS" | position == "CB" | position == "LB" |
position == "OLB" | position == "ILB" | position == "DB")
wide_week1_d <- week1_throw_events_d %>%
pivot_wider(names_from = position, values_from = c(s, a, dis,
o, dir, dist_from_los, dist_from_mid, dist_from_ball), values_fill = 0)
wide_week1_d$coverage <- as.factor(wide_week1_d$coverage)
#Data Partition
smp_size <- floor(0.75 * nrow(wide_week1_d))
set.seed(123)
week1_ind_d <- sample(seq_len(nrow(wide_week1_d)), size = smp_size)
week1_train_d <- wide_week1_d[week1_ind_d, ]
week1_test_d <- wide_week1_d[-week1_ind_d, ]
#Random Forest
set.seed(222)
rf_d <- randomForest(coverage ~ los + down + yardsToGo + defendersInTheBox + numberOfPassRushers + num_dl + num_lb + num_cb + epa + ball_x + ball_y + s_SS + s_FS + s_CB + s_LB + s_OLB + s_ILB + s_DB + a_SS + a_FS + a_CB + a_LB + a_OLB + a_ILB + a_DB + dis_SS + dis_FS + dis_CB + dis_LB + dis_OLB + dis_ILB + dis_DB + o_SS + o_FS + o_CB + o_LB + o_OLB + o_ILB + o_DB + dir_SS + dir_FS + dir_CB + dir_LB + dir_OLB + dir_ILB + dir_DB + dist_from_los_SS + dist_from_los_FS + dist_from_los_CB + dist_from_los_LB + dist_from_los_OLB + dist_from_los_ILB + dist_from_los_DB + dist_from_mid_SS + dist_from_mid_FS + dist_from_mid_CB + dist_from_mid_LB + dist_from_mid_OLB + dist_from_mid_ILB + dist_from_mid_DB + dist_from_ball_SS + dist_from_ball_FS + dist_from_ball_CB + dist_from_ball_LB + dist_from_ball_OLB + dist_from_ball_ILB + dist_from_ball_DB,
data = week1_train_d, na.action = na.omit)
rf_d
#Prediction & Confusion Matrix - train data
p1_d <- predict(rf_d, week1_train_d)
confusionMatrix(p1_d, week1_train_d$coverage)
#Prediction & Confusion Matrix - test data
p2 <- predict(rf_d, week1_test_d)
confusionMatrix(p2, week1_test_d$coverage)
#Error rate of Random Forest
plot(rf)
#Number of nodes for the tree
hist(treesize(rf), main = "Number of Nodes For the Trees", col = "dark green")
#Variable Importance
varImpPlot(rf_d,
sort = T,
main = "Variable Importance")
varUsed(rf)
#Extract a single tree
tree <- getTree(rf, 1, labelVar = TRUE)
tree
line_of_scrim <- df_tracking %>%
filter(displayName == "Football", frameId == 1) %>%
select(gameId, playId, x)
names(line_of_scrim)[names(line_of_scrim) == "x"] <- "los"
df_tracking <- df_tracking %>%
left_join(line_of_scrim, by = c("gameId", "playId"))
df_tracking <- df_tracking %>%
mutate(dist_from_los = x - los,
dist_from_mid = y - 26.65)
df_plays <- df_plays %>%
mutate(num_dl = substring(df_plays$personnelD, 1, 1),
num_lb = substring(df_plays$personnelD, 7, 7),
num_cb = substring(df_plays$personnelD, 13, 13))
df_plays$num_dl <- as.numeric(df_plays$num_dl)
df_plays$num_lb <- as.numeric(df_plays$num_lb)
df_plays$num_cb <- as.numeric(df_plays$num_cb)
df_plays_imp_stuff <- df_plays %>%
select(gameId, playId, down, yardsToGo, defendersInTheBox, numberOfPassRushers,
num_dl, num_lb, num_cb, epa)
df_tracking <- df_tracking %>%
left_join(df_plays_imp_stuff, by.x = c("gameId", "playId"), by.y = c("gameId", "playId"))
playStartEvent <- 'ball_snap'
passArivalEvents <- c('pass_arrived')
df_throw_events <- df_tracking %>%
filter(event %in% passArivalEvents)
df_football <- df_throw_events %>%
filter(team == "football") %>%
mutate(ball_x = x, ball_y = y) %>%
select(gameId, playId, frameId, ball_x, ball_y)
df_throw_events <- df_throw_events %>%
left_join(df_football, by = c("gameId", "playId", "frameId"))
df_throw_events <- df_throw_events %>%
mutate(dist_from_ball = sqrt((x-ball_x)^2 + (y-ball_y)^2))
df_throw_events_d <- df_throw_events %>%
filter(position == "SS" | position == "FS" | position == "CB" | position == "LB" |
position == "OLB" | position == "ILB" | position == "DB")
df_throw_events_d <- df_throw_events_d %>%
filter(!is.na(ball_x)) %>%
filter(!is.na(ball_y))
df_throw_events_d <- df_throw_events_d %>%
select(c(-los.x, los.y))
wide_df_d <- df_throw_events_d %>%
group_by(gameId, playId, frameId) %>%
mutate(row = row_number()) %>%
tidyr::pivot_wider(names_from = position,
values_from = c(s, a, dis, o, dir, dist_from_los, dist_from_mid, dist_from_ball),
values_fill = 0) %>%
select(-row)
p3 <- predict(rf_d, wide_df_d)
p3 <- as_tibble(p3)
p3_df <- data.frame(matrix(unlist(p3), nrow=length(p3), byrow=T))
wide_df_d <- wide_df_d %>%
ungroup() %>%
mutate(row_num = row_number())
p3 <- p3 %>%
mutate(row_num = row_number())
merged_coverages <- merge(wide_df_d, p3, by = "row_num")
names(merged_coverages)[names(merged_coverages) == "value"] <- "coverage"
merged_coverages2 <- merged_coverages %>%
select(displayName, frameId, gameId, playId, epa, los, coverage)
merged_coverages3 <- merged_coverages2 %>%
group_by(gameId, playId, frameId) %>%
summarize(most_freq_cov = tail(names(sort(table(coverage))), 1))
df_plays_cov <- merge(df_plays, merged_coverages3, by = c("gameId", "playId"))
cov_stats <- df_plays_cov %>%
group_by(most_freq_cov) %>%
summarize(plays = n(),
def_epa = mean(epa, na.rm = T)) %>%
arrange(desc(plays))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment