Walking Through Assignment 3
Brendan Wisniewski
11/8/2022
R Markdown
In this file I will be walking through my changes to the provided code in assignment 3. Below is the code provided for setting up the data.
#Buffalo (home) vs Miami Dolphins (away)
opts_knit$set(root.dir = "~/Desktop/IS470/NFL2022")
#read in the necessary files for tracking and plays
player_tracking_df <- fread("tracking2020.csv")
plays_df <- fread("plays.csv")
# I am interested, for demo purposes, in play 1586 in game 2021010300
game_ID <- c("2021010300")
play_ID <- c("1586", "395", "1232", "3930")
df <- player_tracking_df %>%
filter(gameId %in% game_ID & playId %in% play_ID) %>%
left_join(plays_df, by = c("gameId" = "gameId", "playId" = "playId")) %>%
select(gameId, playId, time, x, y, dis, nflId, jerseyNumber, team,
frameId, playDescription,s) %>%
data.frame()
rm(player_tracking_df)
rm(plays_df)
df19 <- df %>%
select(gameId, playId, time, jerseyNumber, x, y, frameId, dis, s) %>%
filter(jerseyNumber == 19) %>%
data.frame()
df2 <- left_join(df, df19, by = c("gameId" = "gameId",
"playId" = "playId",
"time" = "time",
"frameId" = "frameId")) %>%
select(gameId, playId, time, x.x, y.x, nflId, jerseyNumber.x,
frameId, x.y, y.y,team, playDescription, dis.y, s.y) %>%
# compute the distance from player 19 to all opposing players, otherwise NA
mutate(dist = ifelse(team == "away", sqrt((x.x - x.y)^2 + (y.x - y.y)^2), NA )) %>%
# clean up or rename variables
select(-c("x.y","y.y")) %>%
rename(x = x.x,
y = y.x,
s = s.y,
jerseyNumber = jerseyNumber.x) %>%
# find the average distance from player 19 to opposing players
#113.33 = dist on field from lower left corner to upper right corner
#100 yards long and 53.3333 wide or 120 feet wide
group_by(gameId, playId, frameId) %>%
mutate(mean_dist_to_19 = mean(dist, na.rm = TRUE),
alpha = 1 - (mean_dist_to_19/113.33) ) %>%
ungroup() %>%
# compute the total distance traveled by player 19
arrange(jerseyNumber, time, frameId) %>%
group_by(gameId, playId, jerseyNumber) %>%
mutate(dist_running_total = cumsum(dis.y)) %>%
# create a width for a moving bar
mutate(width = round( 20*(1-(mean_dist_to_19/113.33)) ,0) ) %>%
# create each play level stats for the receiver
group_by(gameId, playId) %>%
mutate(play_stat = mean(unique(mean_dist_to_19))) %>%
ungroup() %>%
# create each game level stats for the receiver
group_by(gameId) %>%
mutate(game_stat = mean(unique(play_stat))) %>%
ungroup() %>%
# create each player stat over all plays and all games
mutate(player_stat = mean(unique(game_stat))) %>%
# create a new data frame
data.frame()
#print out play, game, and player stats
df2 %>% select(gameId, playId, play_stat) %>% distinct %>% data.frame()
df2 %>% select(gameId, game_stat) %>% distinct %>% data.frame()
df2 %>% select(player_stat) %>% distinct %>% data.frame()
# THE CODE BELOW IS DESIGNED FOR gameId = 2021010300 and playId = 1586
df3 <- df2 %>% filter(gameId == 2021010300 & playId == 1586) %>% data.frame()
# create a title for the plot using the play description
plot_title <- paste0(df3$playDescription[1],
"\n The halo around the receiver grows darker based on the proximity of players from the opposing team.")
#loading command to make NFL field in ggplot (credit to Marschall Furman)
source('https://raw.githubusercontent.com/mlfurman3/gg_field/main/gg_field.R')
test <- ggplot(data = df3 %>% filter(jerseyNumber==19), aes(x = x, y = y))
test2 <- test + geom_path()Creating the Animation
Below is the code used to create the animation for this assignment
g <- ggplot(data=df3) +
# sets up colors, shapes, and circle sizes
scale_size_manual(values = c(6, 4, 6), guide="none") +
scale_shape_manual(values = c(21, 16, 21), guide="none") +
scale_fill_manual(values = c("dodgerblue1", "#663300", "firebrick1"), guide="none") +
scale_colour_manual(values = c("#000000", "#663300", "#000000"), guide="none") +
# plot the field (full size)
gg_field(yardmin = -5, yardmax = 125) +
# add labels and background to the plot
labs(title = plot_title) +
theme(panel.background = element_rect(fill = 'forestgreen',
color = 'forestgreen'),
panel.grid = element_blank()) +
# add points for players on both teams and the football
geom_point(aes(x = x,
y = y,
shape = team,
fill = team,
group = nflId,
size = team,
colour = team)) +
# add a larger circle around the receiver and shade it
geom_point( data = df3%>% filter(jerseyNumber==19),
aes(x=x,y=y,alpha=alpha),
shape=21,
size=10,
stroke=1,
fill="black",
colour="black") +
# include jersey numbers in the center of all players' circles
geom_text( aes(x = x,
y = y,
group = nflId,
label=ifelse(is.na(jerseyNumber),"",jerseyNumber)),
colour="white", vjust=0.36, size=3.5) +
# add informational text at the top of the plot
geom_text(aes(x=-3, y=56, label="Traffic Meter Scale:"),
colour="white",vjust=0,hjust=0) +
geom_text(aes(x=38, y=56, label="Value:"),
colour="white",vjust=0,hjust=0) +
geom_text(aes(x=53, y=56, label="Distance traveled by receiver (yards):"),
colour="white",vjust=0,hjust=0) +
geom_text(aes(x=92.5, y=56, label="Speed (yards / sec):"),
colour="white",vjust=0,hjust=0) +
# draw an empty rectangle at the top of the plot, fill it in
geom_rect(aes(xmin = 15, xmax = 35, ymin = 56, ymax = 57),
color="black", fill="white") +
geom_rect(data=df3 %>% filter(jerseyNumber==19),
aes(xmin = 15, xmax = 15 + width,
ymin = 56, ymax = 57, alpha=alpha),
color="black", fill="black") +
# report out key metrics (mean dist to receiver)
geom_text(data = df3%>% filter(jerseyNumber==19),
aes(x = 44.5, y = 56,
#label=format(round(100-mean_dist_to_19,2),nsmall=2),
label = format( round( 100*(1-(mean_dist_to_19/113.33)) ,2), nsmall=2),
vjust=0, hjust=0),
color="white") +
# report out key metrics (total yards ran by receiver)
geom_text(data = df3%>% filter(jerseyNumber==19),
aes(x = 85.5, y = 56, label=format(dist_running_total, nsmall=2),vjust=0,hjust=0),
color="white") +
# report out key metrics (speed of receiver)
geom_text(data = df3%>% filter(jerseyNumber==19),
aes(x = 111.9, y = 56, label=format(s, nsmall=2),vjust=0,hjust=0),
color="white") +
# sketch the plot for each frameId
transition_time(frameId) +
geom_encircle(data = df3 %>% filter(team != "football"), #Added convex hulls for each team
aes(x =x,
y = y,
fill = team,
group = team,
color = team),
s_shape = 1,
expand = 0,
alpha = 0.5) +
geom_line(aes(x = x, y = y)) + #Adds a line that shows the closest two players to each other player
# remove all color legends from the side of the plot
guides(alpha = "none")
# number of frames to animate
frames_to_display <- length(unique(df3$frameId))
# build the animation, specify fps, frame size
animate(g, fps=10, nframe = frames_to_display,
width = 800, height = 380,
renderer = gifski_renderer())knitr::include_graphics("out.gif")
Animated GIF of results
Final Thoughts
I decided to add in convex hulls for each team to get a better understanding of the impact player location had on the result of the play. To see more about this I also added lines connecting all the points to the two points that are cloest to them at any time. If they move further away from one point then the line connects them to the next closest point.