3pt shot type function

library(tidyverse)
library(reactable)
library(reactablefmtr)
library(dplyr)
library(nbastatR)

Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)

clean_df <- combined_3pt %>%
  mutate(Type =
           case_when(
             str_detect(typeAction, "Jump Shot") ~ "Set",
             str_detect(typeAction, "Jump Bank Shot") ~ "Set",
             str_detect(typeAction, "Hook Shot") ~ "Set",
             str_detect(typeAction, "Putback Layup Shot") ~ "Set",
             str_detect(typeAction, "Fadeaway Jump Shot") ~ "Fadeaway",
             str_detect(typeAction, "Turnaround Fadeaway shot") ~ "Fadeaway",
             str_detect(typeAction, "Turnaround Fadeaway Bank Jump Shot") ~ "Fadeaway",
             str_detect(typeAction, "Turnaround Bank shot") ~ "Fadeaway",
             str_detect(typeAction, "Turnaround Bank Hook shot") ~ "Fadeaway",
             str_detect(typeAction, "Fadeaway Bank shot") ~ "Fadeaway",
             str_detect(typeAction, "Turnaround Jump Shot") ~ "Fadeaway",
             str_detect(typeAction, "Turnaround Hook Shot") ~ "Fadeaway",
             str_detect(typeAction, "Running Bank shot") ~ "Movement",
             str_detect(typeAction, "Running Jump Shot") ~ "Movement",
             str_detect(typeAction, "Floating Jump shot") ~ "Movement",
             str_detect(typeAction, "Driving Layup Shot") ~ "Movement",
             str_detect(typeAction, "Driving Bank Shot") ~ "Movement",
             str_detect(typeAction, "Driving Bank shot") ~ "Movement",
             str_detect(typeAction, "Driving Bank Hook Shot") ~ "Movement",
             str_detect(typeAction, "Driving Hook Shot") ~ "Movement",
             str_detect(typeAction, "Driving Floating Jump Shot") ~ "Movement",
             str_detect(typeAction, "Driving Floating Bank Jump Shot") ~ "Movement",
             str_detect(typeAction, "Layup Shot") ~ "Movement",
             str_detect(typeAction, "Tip Shot") ~ "Movement",
             str_detect(typeAction, "Running Hook Shot") ~ "Movement",
             str_detect(typeAction, "Driving Jump shot") ~ "Fadeaway",
             str_detect(typeAction, "Pullup Jump shot") ~ "Pullup",
             str_detect(typeAction, "Running Pull-up Jump Shot") ~ "Pullup",
             str_detect(typeAction, "Pullup Bank shot") ~ "Pullup",
             str_detect(typeAction, "Step Back Jump shot") ~ "Step Back",
             str_detect(typeAction, "Step Back Bank Jump shot") ~ "Step Back",
             TRUE ~ "other"
           )) %>%
  mutate(Result = case_when(
    str_detect(typeEvent, "Made Shot") ~ 1,
    str_detect(typeEvent, "Missed Shot") ~ 0,
    TRUE ~ NA_real_
  ))

game_logs <- clean_df %>%
  group_by(idPlayer, namePlayer, idGame, zoneBasic, Type, dateGame) %>%
  summarize(
    makes = sum(Result),
    attempts = n()
  ) %>%
  mutate(percent = makes/attempts) %>%
  ungroup() %>%
  arrange(desc(dateGame)) %>%
  mutate( days_old = first(dateGame) - dateGame)

game_logs$days_old <- gsub("days", "", game_logs$days_old)
game_logs$days_old <- as.numeric(game_logs$days_old)

game_decay <- game_logs %>%
  filter(zoneBasic != "Left Corner 3",
         zoneBasic != "Right Corner 3") %>%
  mutate(expo_decay = .99^days_old) %>%
  group_by(idPlayer, namePlayer, zoneBasic, Type) %>%
  summarize(
    weighted_avg = weighted.mean(percent, expo_decay),
    total_makes = sum(makes),
    total_attempts = sum(attempts)
  ) %>%
  mutate_at(vars(weighted_avg), round, digits = 4)

game_logs_corner <- clean_df %>%
  filter(zoneBasic != "Above the Break 3") %>%
  group_by(idPlayer, namePlayer, idGame, dateGame, zoneBasic) %>%
  summarize(
    makes = sum(Result),
    attempts = n()
  ) %>%
  mutate(percent = makes/attempts) %>%
  ungroup() %>%
  arrange(desc(dateGame)) %>%
  group_by(dateGame) %>%
  mutate( days_old = game_logs$dateGame[1] - dateGame)

game_logs_corner$days_old <- gsub("days", "", game_logs_corner$days_old)
game_logs_corner$days_old <- as.numeric(game_logs_corner$days_old)

game_decay_corner <- game_logs_corner %>%
  mutate(expo_decay = .99^days_old) %>%
  group_by(idPlayer, namePlayer, zoneBasic) %>%
  summarize(
    weighted_avg = weighted.mean(percent, expo_decay),
    total_makes = sum(makes),
    total_attempts = sum(attempts)
  ) %>%
  mutate_at(vars(weighted_avg), round, digits = 4)


cor_date <- clean_df %>%
  group_by(dateGame, zoneBasic, Type) %>%
  summarize(
    makes = sum(Result),
    attempts = n()
  ) %>%
  ungroup()

percents <- game_logs %>%
  filter(dateGame > '2022-10-01') %>%
  group_by(zoneBasic, Type) %>%
  summarize(
    total_makes = sum(makes),
    total_attempts = sum(attempts)
  ) %>%
  mutate(
    percent = total_makes / total_attempts
  ) %>%
  ungroup()  %>%
  filter(total_attempts > 50)

above_break_pull_up_p <- .3317
above_break_stepback_p <- .3213
above_break_set_p <- .3577
corner_left_p <- .3788
corner_right_p <- .3766

shooting_adj_pf <- function(x) {
  df <- percents_player %>%
    filter(namePlayer == x) %>%
    filter(total_attempts > 1)
  
  df <- df %>%
    mutate( anchored = case_when(
      str_detect(Type, "Pullup") ~ ((total_makes + (100 * above_break_pull_up_p))/ (100 + total_attempts)),
      str_detect(Type, "Step Back") ~ ((total_makes + (100 * above_break_stepback_p))/ (100 + total_attempts)),
      str_detect(Type, "Set") ~ ((total_makes + (100 * above_break_set_p))/ (100 + total_attempts))
  )) 
  df$zoneBasic <- paste(df$zoneBasic, df$Type)
  df <- df %>%
    select(zoneBasic,
           idPlayer,
           namePlayer,
           total_makes,
           total_attempts,
           percent,
           anchored)


  df_2 <- corners %>%
    filter(namePlayer == x)
  
  df_2 <- df_2 %>%
    mutate(anchored = case_when(
      str_detect(zoneBasic, "Left Corner 3") ~ ((total_makes + (100 * corner_left_p))/ (100 + total_attempts)),
      str_detect(zoneBasic, "Right Corner 3") ~ ((total_makes + (100 * corner_right_p))/ (100 + total_attempts))
    ))
  
  df_3 <- rbind(df, df_2)
  df_3 <- df_3 %>%
    mutate(adjusted = 
             ifelse(zoneBasic == "Above the Break 3 Pullup",
                    ( (anchored * 100) + (50 * df_3$anchored[df_3$zoneBasic == "Above the Break 3 Step Back"]) + (50 * df_3$anchored[df_3$zoneBasic == "Above the Break 3 Set"]) ) / 200,
             ifelse(zoneBasic == "Above the Break 3 Step Back",
                    ( (anchored * 100) + (50 * df_3$anchored[df_3$zoneBasic == "Above the Break 3 Pullup"]) + (50 * df_3$anchored[df_3$zoneBasic == "Above the Break 3 Set"]) ) / 200,
             ifelse(zoneBasic == "Above the Break 3 Set",
                    ( (anchored * 140) + (30 * df_3$anchored[df_3$zoneBasic == "Above the Break 3 Step Back"]) + (30 * df_3$anchored[df_3$zoneBasic == "Above the Break 3 Pullup"]) ) / 200,
             ifelse(zoneBasic == "Right Corner 3",
                    ( (anchored * 100) + (65 * df_3$anchored[df_3$zoneBasic == "Left Corner 3"]) + (35 * df_3$anchored[df_3$zoneBasic == "Above the Break 3 Set"]) ) / 200,
                    ( (anchored * 100) + (65 * df_3$anchored[df_3$zoneBasic == "Right Corner 3"]) + (35 * df_3$anchored[df_3$zoneBasic == "Above the Break 3 Set"]) ) / 200
             )))))
  df_3 <- df_3 %>%
    select(zoneBasic,
           total_makes,
           total_attempts,
           percent,
           anchored,
           adjusted) %>%
    mutate_at(vars(c(percent, anchored, adjusted)), round, digits = 4) %>%
     rename(Shot = zoneBasic,
           Makes = total_makes,
           Attempts = total_attempts,
           'Raw Percentage' = percent,
           'Anchored Percentage' = anchored,
           'Adjusted Percentage' = adjusted)
  return(df_3)
}

Table Notes

• Shot category breaks down into five categories: Above the break 3 pullup, above the break 3 step back, above the break 3 set, right corner 3, left corner 3
  • Limited categories for corners due to limited volume.
• Raw percentage is found using the last two seasons.
• Expo Decay Weighted is an average where each previous performance is weighted on an exponential decay scale so each game from the last ten seasons is accounted for but more recent games have a stronger influence on the result.
• Anchored Percentage: a player’s expo decay weighted average anchored or “stabilized” by the league average from the same shot.
  • Anchored or stabilization percentage is determined by the average from the last two playoffs.
• Adjusted Percentage: a player’s anchored percentage adjusted by similar shots percentages using a weighted average.
  • Some low volume players do not have adjusted values in certain categories because they did not take attempts from shots used to adjust.
  • Weights for adjustment:
    • Above the Break 3 set - ab3 set: 70% rc3: 15% lc3: 15%
    • Above the Break 3 pullup - ab3 pullup: 50% ab3 step back: 25% ab3 set: 25%
    • Above the Break 3 step back - ab3 step back: 50% ab3 pullup: 25% ab3 set: 25%
    • Right Corner 3 - rc3: 50% lc3: 32.5% ab3 set: 17.5%
    • Left Corner 3 - lc3: 50% rc3: 32.5% ab3 set: 17.5%
• Model aims to find a percentage we can “trust” so anchoring method has much more influence on low volume shooters thus resulting in inflating the percentage of low volume low skilled players and deflating the percentage of low volume high skilled players.

ab3 = Above the break 3 lc3 = Left Corner 3 rc3 = Right Corner 3

fg3pt_fun_pf("LeBron James") %>%
  reactable(theme = espn()) %>%
  add_title("LeBron James Adjusted 3pt shooting - Playoffs")

LeBron James Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("D'Angelo Russell") %>%
  reactable(theme = espn()) %>%
  add_title("D'Angelo Russell Adjusted 3pt shooting - Playoffs")

D'Angelo Russell Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Austin Reaves") %>%
  reactable(theme = espn()) %>%
  add_title("Austin Reaves Adjusted 3pt shooting - Playoffs")

Austin Reaves Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Taurean Prince") %>%
  reactable(theme = espn()) %>%
  add_title("Taurean Prince Adjusted 3pt shooting - Playoffs")

Taurean Prince Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Rui Hachimura") %>%
  reactable(theme = espn()) %>%
  add_title("Rui Hachimura Adjusted 3pt shooting - Playoffs")

Rui Hachimura Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Anthony Davis") %>%
  reactable(theme = espn()) %>%
  add_title("Anthony Davis Adjusted 3pt shooting - Playoffs")

Anthony Davis Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Cam Reddish") %>%
  reactable(theme = espn()) %>%
  add_title("Cam Reddish Adjusted 3pt shooting - Playoffs")

Cam Reddish Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Max Christie") %>%
  reactable(theme = espn()) %>%
  add_title("Max Christie Adjusted 3pt shooting - Playoffs")

Max Christie Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Jaxson Hayes") %>%
  reactable(theme = espn()) %>%
  add_title("Jaxson Hayes Adjusted 3pt shooting - Playoffs")

Jaxson Hayes Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Christian Wood") %>%
  reactable(theme = espn()) %>%
  add_title("Christian Wood Adjusted 3pt shooting - Playoffs")

Christian Wood Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Spencer Dinwiddie") %>%
  reactable(theme = espn()) %>%
  add_title("Spencer Dinwiddie Adjusted 3pt shooting - Playoffs")

Spencer Dinwiddie Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Jarred Vanderbilt") %>%
  reactable(theme = espn()) %>%
  add_title("Jarred Vanderbilt Adjusted 3pt shooting - Playoffs")

Jarred Vanderbilt Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Gabe Vincent") %>%
  reactable(theme = espn()) %>%
  add_title("Gabe Vincent Adjusted 3pt shooting - Playoffs")

Gabe Vincent Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Jalen Hood-Schifino") %>%
  reactable(theme = espn()) %>%
  add_title("Jalen Hood-Schifino Adjusted 3pt shooting - Playoffs")

Jalen Hood-Schifino Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Maxwell Lewis") %>%
  reactable(theme = espn()) %>%
  add_title("Maxwell Lewis Adjusted 3pt shooting - Playoffs")

Maxwell Lewis Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Skylar Mays") %>%
  reactable(theme = espn()) %>%
  add_title("Skylar Mays Adjusted 3pt shooting - Playoffs")

Skylar Mays Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Colin Castleton") %>%
  reactable(theme = espn()) %>%
  add_title("Colin Castleton Adjusted 3pt shooting - Playoffs")

Colin Castleton Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("D'Moi Hodge") %>%
  reactable(theme = espn()) %>%
  add_title("D'Moi Hodge Adjusted 3pt shooting - Playoffs")

D'Moi Hodge Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Dylan Windler") %>%
  reactable(theme = espn()) %>%
  add_title("Dylan Windler Adjusted 3pt shooting - Playoffs")

Dylan Windler Adjusted 3pt shooting - Playoffs

fg3pt_fun_pf("Harry Giles III") %>%
  reactable(theme = espn()) %>%
  add_title("Harry Giles III Adjusted 3pt shooting - Playoffs")

Harry Giles III Adjusted 3pt shooting - Playoffs

shooting_adj_pf("Alex Fudge") %>%
  reactable(theme = espn()) %>%
  add_title("Alex Fudge Adjusted 3pt shooting - Playoffs")

Alex Fudge Adjusted 3pt shooting - Playoffs