Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
library(tidyverse)
library(patchwork)
library(ggtext)
team_colors <- nflfastR::teams_colors_logos %>% filter(team_abbr == "TEN") %>%
select(team_color, team_color2) %>%
unlist()
# fake data
run_df <- tibble(
down_distance = c(
"1st & 10",
"2nd & 8+",
"2nd & 3-7",
"2nd & 1-2",
"3rd & 3+",
"3rd & 1-2",
"After pass for 1st",
"After rush for 1st",
"All plays"
),
actual = c(
38, 57, 63, 36, 89, 50, 39, 41, 54
),
expected = c(
56, 72, 66, 39, 92, 54, 54, 57, 64
)
) %>%
mutate(
down_distance = factor(down_distance),
difference = actual - expected,
diff_color = if_else(difference < 0, "#DC143C", "black")
)
run_plot <- run_df %>%
ggplot(aes(x = actual, y = fct_rev(down_distance))) +
geom_text(
aes(x = 100, label = paste0(difference, "%"), color = diff_color),
nudge_x = 10, hjust = 1, fontface= "bold", family = "Chivo", size = 10
) +
geom_col(aes(x = 100), width = 0.7, color = "grey", alpha = 0.2) +
geom_col(aes(x = expected), fill = team_colors[1], alpha = 0.5, width = 0.7) +
geom_col(width = 0.4, fill = team_colors[2]) +
scale_fill_identity() +
scale_x_continuous(breaks = c(25, 50, 75), labels = scales::percent_format(scale = 1)) +
theme_minimal() +
theme(
text = element_text(family = "Chivo"),
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_line(color = "grey", size = 0.2),
panel.ontop = TRUE,
axis.text.y = element_markdown(size = 14, margin = margin(r = -25, unit = "pt")),
axis.text.x = element_text(size = 16, color = "grey"),
plot.title = element_markdown(size = 36, face = "bold"),
plot.subtitle = element_text(size = 24),
plot.margin = unit(c(0.5, 1.5, 0.5, 1.5), "cm"),
legend.position = "none"
) +
labs(
x = "", y = "",
title = glue::glue("Titans <span style='color:{team_colors[2]}'>Pass Frequency</span> over <span style='color:{team_colors[1]}'>Expected</span>, 2020")
)
# Legend plot -------------------------------------------------------------
label_df <- tibble(
x = c(15, 15, 77, 101),
y = c(1.6, 0.35, 0.35, 1),
label = c("Expected Pass Frequency ", "Actual Pass Frequency ", "Difference", "X%")
)
seg_df <- tibble(
x1 = c(0.2, 90, 0.2, 74.8, 75.3, 90, 103),
x2 = c(0.2, 90, 0.2, 74.8, 75.3, 90, 103),
y1 = c(1.3, 1.3, rep(.7, 5)),
y2 = c(1.61, 1.61, rep(.343, 5))
)
seg2_df <- tibble(
x1 = c(0.2, 0.2, 75.3),
x2 = c(90, 74.8, 103),
y1 = c(1.6, .35, .35),
y2 = c(1.6, .35, .35)
)
legend_plot <- tibble(
x = 75,
y = factor("Y"),
x2 = 90
) %>%
ggplot(aes(x = x, y = y)) +
geom_col(aes(x = 100), fill = "white", color = "grey", width = 0.4) +
geom_col(aes(x = x2), width = 0.4, fill = "black", alpha = 0.5) +
geom_col(width = 0.2, color = "black", fill = "black") +
geom_segment(
data = seg_df,
aes(x = x1, y = y1, xend = x2, yend = y2),
color = c(rep("black", 4), rep("#DC143C", 3)),
size = 1
) +
geom_segment(
data = seg2_df,
aes(x = x1, y = y1, xend = x2, yend = y2),
color = c("black", "black", "#DC143C"),
size = 1
) +
geom_label(
data = label_df,
aes(x = x, y = y, label = label),
hjust = 0, size = 8, fontface = "bold", fill = "white",
color = c("black", "black", "#DC143C", "#DC143C"),
label.size = NA,
family = "Oswald",
label.padding = unit(0.05, "lines"),
) +
theme_void() +
theme(
plot.margin = unit(c(0.5, 1.5, 0.5, 1.5), "cm"),
plot.caption = element_markdown(size = 14)
) +
coord_cartesian(ylim = c(0.7, 1.2), xlim = c(0, 108)) +
labs(
caption = "<br><br>**Plot**: @thomas_mock | **Inspiration**: @bburkeESPN"
)
legend_plot
combo_plot <- run_plot / legend_plot + plot_layout(heights = c(5,1))
combo_plot
ggsave("ten_rush.png", combo_plot, height = 14, width = 16, units = "in", dpi = "retina")
# https://git.io/JkNfu
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment