recreate synergy table

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")