Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
library(tidyverse)
library(gt)
# create data
df <- data.frame(
stringsAsFactors = FALSE,
player = c("Evan Mobley",
"Sandro Mamukelashvili","Charles Bassey","Luka Garza",
"Moses Wright","Neeimisa Queta",
"Isaiah Jackson","Day'Ron Sharpe"),
team = c("USC","Seton Hall",
"Western Kentucky","Iowa","Georgia Tech",
"Utah St","Kentucky","North Carolina"),
ht = c("7'0\"","6'10\"","6'10\"",
"6'11\"","6'9\"","7'1\"","6'11\"",
"6'11\""),
dunks_and_layups_pct_time = c(40L, 48L, 50L, 50L, 51L, 55L, 60L, 66L),
dunks_and_layups_PPS = c(1.62,1.02,1.54,1.33,1.46,1.37,
1.33,1.18),
hooks_tips_floaters_pct_time = c(26L, 10L, 19L, 15L, 25L, 27L, 15L, 24L),
hooks_tips_floaters_pps = c(0.88,0.97,1,1.05,0.63,0.85,
0.76,0.84),
jumpers_pct_time = c(34L, 42L, 31L, 35L, 25L, 18L, 25L, 10L),
jumpers_pps = c(0.91,0.91,0.78,1.04,0.86,0.74,
0.71,0.42)
)
# make function to create bar plots
plot_group <- function(name) {
plot_object <- df %>%
filter(player == name) %>%
select(player, ends_with("pct_time")) %>%
pivot_longer(-player) %>%
ggplot(aes(x = value, y = player, fill = fct_rev(name))) +
geom_col(position = 'stack', color = 'white', size = 10) +
geom_text(aes(label = value), color = 'white', position = position_stack(vjust = .5), size = 55, fontface = 'bold') +
scale_fill_manual(values = c("Black", "Gray", "Red")) +
theme_void() +
theme(legend.position = 'none')
return(plot_object)
}
# add a column to our dataframe that lists the ggplot details
tibble_plot <- df %>%
mutate(plot = map(player, plot_group)) %>%
mutate(ggplot = NA)
# make table
tibble_plot %>%
gt() %>%
tab_header(
title = md("**EVAN MOBLEY IS A VERSATILE BIG MAN**"),
subtitle = md("Distribution of shot types for collegiate big men entering the NBA draft, 2020-21 NCAA men's basketball season")
)%>%
text_transform(
locations = cells_body(vars(ggplot)),
fn = function(x) {
map(tibble_plot$plot, ggplot_image, height = px(25), aspect_ratio = 9)
}
) %>%
cols_hide(vars(plot)) %>%
cols_label(player = "PLAYER",
team = "TEAM",
ht = "HT",
dunks_and_layups_pct_time = "%TIME",
dunks_and_layups_PPS = "PPS",
hooks_tips_floaters_pct_time = "%TIME",
hooks_tips_floaters_pps = "PPS",
jumpers_pct_time = "%TIME",
jumpers_pps = "PPS",
ggplot = html("<span style = 'color: #FF0000'><b>DUNKS + LAYS</b></span> || <span style = 'color: #808080'><b>HOOKS + FLOATERS</b></span> || <span style = 'color: #000000'><b>JUMPERS</b></span>")) %>%
tab_spanner(
label = md("**DUNKS AND<br>LAYUPS**"),
columns = vars(dunks_and_layups_pct_time, dunks_and_layups_PPS)
) %>%
tab_spanner(
label = md("**TIPS, HOOKS,<br>AND FLOATERS**"),
columns = vars(hooks_tips_floaters_pct_time, hooks_tips_floaters_pps)
) %>%
tab_spanner(
label = md("**JUMP<br>SHOTS**"),
columns = vars(jumpers_pct_time, jumpers_pps)
) %>%
tab_spanner(
label = md("**SHOT<br>MIX**"),
columns = vars(ggplot)
) %>%
tab_style(
style = list(
cell_fill(color = "gray95")
),
locations = cells_body(
columns = vars(dunks_and_layups_pct_time)
)
) %>%
cols_width(
ends_with("pct_time") ~ px(40),
ends_with("pps") ~ px(40),
vars(player) ~ px(135),
vars(team) ~ px(110),
vars(ggplot) ~px(250),
everything() ~ px(50)
) %>%
opt_align_table_header(align = "left") %>%
tab_options(
table.font.names = "Consolas",
heading.title.font.size = 30,
heading.subtitle.font.size = 10,
column_labels.font.weight = 'bold',
table.font.size = 10,
data_row.padding = px(1),
table.border.top.color = "white",
heading.border.bottom.color = "white",
table.border.bottom.color = 'white'
) %>%
tab_source_note(
source_note = html("<span style = 'color: #808080'>%Time = Percent of player's FGA accounted for by each shot type, PPS = Points per shot</span>")
) %>%
gtsave("tbl.png")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment