Los Angeles Lakers 10/26/22
Dylan Kinion
2022-10-16
All tables are sortable by clicking on column header.
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
lebron_22 <- lakers_shots_22 %>%
filter( namePlayer == "LeBron James") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
lebron_22$x <- lebron_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_lj <- lebron_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_lj <- shotData_lj %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_lj <- shotData_lj %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_lj <- shotData_lj %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_lj <- shotData_lj %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_lj <- shotData_lj %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_lj <- shotData_lj %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Lebron James
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Restricted Area", "Restricted Area", "Right Corner 3")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
lebron_heat <- plot_court() +
geom_density_2d_filled(lebron_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "LeBron James Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_lj <- shotData_lj %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_lj <- rasterGrob(readPNG(getURLContent(headshot_lj)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
lebron_heat +
geom_text(data = ra_lj , x = 0 , y = 7, label = ra_lj$accuracy) +
geom_text(data = ip_lj, x = 0 , y = 15, label = ip_lj$accuracy) +
geom_text(data = abb3_lj, x = 0 , y = 33, label = abb3_lj$accuracy) +
geom_text(data = mr_lj, x = 0 , y = 24, label = mr_lj$accuracy) +
geom_text(data = rc3_lj, x = -22, y = 7, label = rc3_lj$accuracy) +
geom_text(data = lc3_lj, x = 22, y = 7, label = lc3_lj$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_lj), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
Lack of colored areas is due to variety of shot selection.
Is elite at getting to and finishing in the restricted area.
More comfortable shooting off the dribble and pull-up 3s from left side.
- Makes off of Dribble (sample of 50):
- Left - 53%
- Right - 44%
- Makes off of Dribble (sample of 50):
Shot Summary Tables
right <- shotData_lj %>%
filter( zoneBasic == "Above the Break 3",
x < 0) %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right")
left <- shotData_lj %>%
filter( zoneBasic == "Above the Break 3",
x > 0) %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left")
bind_rows(left, right) %>%
select( zone, makes, shots, accuracy, avg_distance) %>%
reactable(sortable = TRUE) %>%
add_title("Above the Break 3")Above the Break 3
laker_url <- "https://api.pbpstats.com/get-totals/nba?Season=2022-23&SeasonType=Regular%2BSeason&TeamId=1610612747&Type=Player"
pbp_player <- read_json(laker_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
lebron_col <- player %>%
filter( Name == "LeBron James") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(lebron_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_lebron <- bind_rows(ra_lj, ip_lj, mr_lj, abb3_lj, lc3_lj, rc3_lj) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_lebron %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_lebron, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
lebron_df <- team_shared %>%
filter( namePlayer == "LeBron James") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
lebron_df$x <- lebron_df$x * -1
lebron_shared <- SharedData$new( lebron_df, key = ~typeAction, group = "Shot Type")
#shot chart
lebron_heat <- plot_court() +
geom_point( data = lebron_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Lebron Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( lebron_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()lj2_abb3 <- lebron_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lj2_lc3 <- lebron_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
lj2_mr <- lebron_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
lj2_rc3 <- lebron_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
lj2_ip <- lebron_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
lj2_ra <- lebron_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
lj2_st <- bind_rows(lj2_ra, lj2_ip, lj2_mr, lj2_abb3, lj2_lc3, lj2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lj2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2021,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
ad_22 <- lakers_shots_22 %>%
filter( namePlayer == "Anthony Davis") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
ad_22$x <- ad_22$x * -1
lakers_shots_21 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
ad_21 <- lakers_shots_21 %>%
filter( namePlayer == "Anthony Davis") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
ad_21$x <- ad_21$x * -1
ad_com <- bind_rows(ad_21, ad_22)
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_ad <- ad_com %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_ad <- shotData_ad %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_ad <- shotData_ad %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_ad <- shotData_ad %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_ad <- shotData_ad %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_ad <- shotData_ad %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_ad <- shotData_ad %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Anthony Davis
- Data is from ’21 and ’22 seasons to provide better sample size.
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Restricted Area", "Left Croner 3", "Mid-Range")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
ad_heat <- plot_court() +
geom_density_2d_filled(ad_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Anthony Davis Shot Heatmap",
subtitle = "'21 and '22 seasons,
with FG% included by zone")
#prepare headshot
headshot_ad <- shotData_ad %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_ad <- rasterGrob(readPNG(getURLContent(headshot_ad)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
ad_heat +
geom_text(data = ra_ad , x = 0 , y = 7, label = ra_ad$accuracy) +
geom_text(data = ip_ad, x = 0 , y = 15, label = ip_ad$accuracy) +
geom_text(data = abb3_ad, x = 0 , y = 33, label = abb3_ad$accuracy) +
geom_text(data = mr_ad, x = 0 , y = 24, label = mr_ad$accuracy) +
geom_text(data = rc3_ad, x = -22, y = 7, label = rc3_ad$accuracy) +
geom_text(data = lc3_ad, x = 22, y = 7, label = lc3_ad$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_ad), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Takeaways
Poor from above the break.
- 2021 - 19%
- 2022 - 14%
High percentage from corners but lack of attempts suggests lack of confidence.
Good balance of assisted and unassisted from 2pt.
Unassisted level from above the break is higher than it should be given poor accuracy last two years.
Shot Summary Tables
laker_url <- "https://api.pbpstats.com/get-totals/nba?Season=2022-23,2021-22&SeasonType=Regular%2BSeason&TeamId=1610612747&Type=Player"
pbp_player <- read_json(laker_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
ad_col <- player %>%
filter( Name == "Anthony Davis") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(ad_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_ad <- bind_rows(ra_ad, ip_ad, mr_ad, abb3_ad, lc3_ad, rc3_ad) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_ad %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_ad, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
- Team data is just from 2022 season.
Last 20 Games
team_shared <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
ad_df <- team_shared %>%
filter( namePlayer == "Anthony Davis") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20211126)
ad_df$x <- ad_df$x * -1
ad_shared <- SharedData$new( ad_df, key = ~typeAction, group = "Shot Type")
#shot chart
ad_heat <- plot_court() +
geom_point( data = ad_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Davis Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( ad_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()ad2_abb3 <- ad_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
ad2_lc3 <- ad_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
ad2_mr <- ad_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
ad2_rc3 <- ad_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ad2_ip <- ad_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ad2_ra <- ad_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
ad2_st <- bind_rows(ad2_ra, ad2_ip, ad2_mr, ad2_abb3, ad2_lc3, ad2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
ad2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
wolves_shots_22 <- teams_shots(
teams = "Minnesota Timberwolves",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
bev_22 <- wolves_shots_22 %>%
filter( namePlayer == "Patrick Beverley") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
bev_22$x <- bev_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_pb <- bev_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_pb <- shotData_pb %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_pb <- shotData_pb %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_pb <- shotData_pb %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_pb <- shotData_pb %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_pb <- shotData_pb %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_pb <- shotData_pb %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Patrick Beverley
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Above the Break", "Left Corner 3", "Mid-Range")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
bev_heat <- plot_court() +
geom_density_2d_filled(bev_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Patrick Beverley Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_pb <- shotData_pb %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_pb <- rasterGrob(readPNG(getURLContent(headshot_pb)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
bev_heat +
geom_text(data = ra_pb , x = 0 , y = 7, label = ra_pb$accuracy) +
geom_text(data = ip_pb, x = 0 , y = 15, label = ip_pb$accuracy) +
geom_text(data = abb3_pb, x = 0 , y = 33, label = abb3_pb$accuracy) +
geom_text(data = mr_pb, x = 0 , y = 24, label = mr_pb$accuracy) +
geom_text(data = rc3_pb, x = -22, y = 7, label = rc3_pb$accuracy) +
geom_text(data = lc3_pb, x = 22, y = 7, label = lc3_pb$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_pb), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
High percentage of 3s are unassisted, shot selection profiles as volume scorer instead of spot-up/spacer.
Good from corners. Higher 3pt% from left corner but with similar attempts difference is most likely due to variance.
- Corner 3pt%:
- 2019 - 45%
- 2020 - 42%
- 2021 - 46%
- 2022 - 47%
- Corner 3pt%:
Bad at getting all the way to basket as well as finishing when there.
Shot Summary Tables
wolves_url <- "https://api.pbpstats.com/get-totals/nba?Season=2021-22&SeasonType=Regular%2BSeason&TeamId=1610612750&Type=Player"
pbp_player <- read_json(wolves_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
bev_col <- player %>%
filter( Name == "Patrick Beverley") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(bev_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_bev <- bind_rows(ra_pb, ip_pb, mr_pb, abb3_pb, lc3_pb, rc3_pb) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_bev %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_bev, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Minnesota Timberwolves",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
bev_df <- team_shared %>%
filter( namePlayer == "Patrick Beverley") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
bev_df$x <- bev_df$x * -1
bev_shared <- SharedData$new( bev_df, key = ~typeAction, group = "Shot Type")
#shot chart
bev_heat <- plot_court() +
geom_point( data = bev_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Beverley Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( bev_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()pb2_abb3 <- bev_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
pb2_lc3 <- bev_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
pb2_mr <- bev_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
pb2_rc3 <- bev_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
pb2_ip <- bev_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
pb2_ra <- bev_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
pb2_st <- bind_rows(pb2_ra, pb2_ip, pb2_mr, pb2_abb3, pb2_lc3, pb2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
pb2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
rus_22 <- lakers_shots_22 %>%
filter( namePlayer == "Russell Westbrook") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
rus_22$x <- rus_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_rw <- rus_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_rw <- shotData_rw %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_rw <- shotData_rw %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_rw <- shotData_rw %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_rw <- shotData_rw %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_rw <- shotData_rw %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_rw <- shotData_rw %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Russell Westbrook
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Restricted Area", "Left Corner 3", "In the Paint (non RA)")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
rus_heat <- plot_court() +
geom_density_2d_filled(rus_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Russell Westbrook Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_rw <- shotData_rw %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_rw <- rasterGrob(readPNG(getURLContent(headshot_rw)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
rus_heat +
geom_text(data = ra_rw , x = 0 , y = 7, label = ra_rw$accuracy) +
geom_text(data = ip_rw, x = 0 , y = 15, label = ip_rw$accuracy) +
geom_text(data = abb3_rw, x = 0 , y = 33, label = abb3_rw$accuracy) +
geom_text(data = mr_rw, x = 0 , y = 24, label = mr_rw$accuracy) +
geom_text(data = rc3_rw, x = -22, y = 7, label = rc3_rw$accuracy) +
geom_text(data = lc3_rw, x = 22, y = 7, label = lc3_rw$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_rw), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
Well below team average accuracy by zone from every zone except for left corner.
Better from corners last two years.
- Corner 3pt% from last two years:
- Left - 48%
- Right - 31%
- Corner 3pt% from last two years:
High percentage of shots are self-created.
Only restricted area has pts/att greater than 1.
Shot Summary Tables
wolves_url <- "https://api.pbpstats.com/get-totals/nba?Season=2021-22&SeasonType=Regular%2BSeason&TeamId=1610612747&Type=Player"
pbp_player <- read_json(wolves_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
rus_col <- player %>%
filter( Name == "Russell Westbrook") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(rus_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_rus <- bind_rows(ra_rw, ip_rw, mr_rw, abb3_rw, lc3_rw, rc3_rw) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_rus %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_rus, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
rus_df <- team_shared %>%
filter( namePlayer == "Russell Westbrook") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
rus_df$x <- rus_df$x * -1
rus_shared <- SharedData$new( rus_df, key = ~typeAction, group = "Shot Type")
#shot chart
rus_heat <- plot_court() +
geom_point( data = rus_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Westbrook Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( rus_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()rw2_abb3 <- rus_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
rw2_lc3 <- rus_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
rw2_mr <- rus_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rw2_rc3 <- rus_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
rw2_ip <- rus_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
rw2_ra <- rus_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
rw2_st <- bind_rows(rw2_ra, rw2_ip, rw2_mr, rw2_abb3, rw2_lc3,rw2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
rw2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
team_shots_22 <- teams_shots(
teams = "Chicago Bulls",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
brown_22 <- team_shots_22 %>%
filter( namePlayer == "Troy Brown Jr.") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
brown_22$x <- brown_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_bj <- brown_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_bj <- shotData_bj %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_bj <- shotData_bj %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_bj <- shotData_bj %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_bj <- shotData_bj %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_bj <- shotData_bj %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_bj <- shotData_bj %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Troy Brown Jr.
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Restricted Area", "Above the Break 3", "Mid Range")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
brown_heat <- plot_court() +
geom_density_2d_filled(brown_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Troy Brown Jr. Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_bj <- shotData_bj %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_bj <- rasterGrob(readPNG(getURLContent(headshot_bj)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
brown_heat +
geom_text(data = ra_bj , x = 0 , y = 7, label = ra_bj$accuracy) +
geom_text(data = ip_bj, x = 0 , y = 15, label = ip_bj$accuracy) +
geom_text(data = abb3_bj, x = 0 , y = 33, label = abb3_bj$accuracy) +
geom_text(data = mr_bj, x = 0 , y = 24, label = mr_bj$accuracy) +
geom_text(data = rc3_bj, x = -22, y = 7, label = rc3_bj$accuracy) +
geom_text(data = lc3_bj, x = 22, y = 7, label = lc3_bj$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_bj), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
Below team average from every zone except for above the break 3 and in the paint (non RA)
Efficient shot selection, 84% of shots come from 3 or restricted area.
High percentage of shots are assisted, shot selection profile of a spacer/spot up shooter.
Shot Summary Tables
bulls_url <- "https://api.pbpstats.com/get-totals/nba?Season=2021-22&SeasonType=Regular%2BSeason&TeamId=1610612741&Type=Player"
pbp_player <- read_json(bulls_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
brown_col <- player %>%
filter( Name == "Troy Brown Jr.") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(brown_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_brown <- bind_rows(ra_bj, ip_bj, mr_bj, abb3_bj, lc3_bj, rc3_bj) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_brown %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_brown, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Chicago Bulls",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
brown_df <- team_shared %>%
filter( namePlayer == "Troy Brown Jr.") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
brown_df$x <- brown_df$x * -1
brown_shared <- SharedData$new( brown_df, key = ~typeAction, group = "Shot Type")
#shot chart
brown_heat <- plot_court() +
geom_point( data = brown_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Brown Jr Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( brown_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()bj2_abb3 <- brown_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
bj2_lc3 <- brown_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
bj2_mr <- brown_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
bj2_rc3 <- brown_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
bj2_ip <- brown_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
bj2_ra <- brown_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
bj2_st <- bind_rows(bj2_ra, bj2_ip, bj2_mr, bj2_abb3, bj2_lc3,bj2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
bj2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
team_shots_22 <- teams_shots(
teams = "San Antonio Spurs",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
walker_22 <- team_shots_22 %>%
filter( namePlayer == "Lonnie Walker IV") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
walker_22$x <- walker_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_lw <- walker_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_lw <- shotData_lw %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_lw <- shotData_lw %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_lw <- shotData_lw %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_lw <- shotData_lw %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_lw <- shotData_lw %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_lw <- shotData_lw %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Lonnie Walker
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Above the Break 3", "Restricted Area", "Mid Range")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
walker_heat <- plot_court() +
geom_density_2d_filled(walker_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Lonnie Walker Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_lw <- shotData_lw %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_lw <- rasterGrob(readPNG(getURLContent(headshot_lw)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
walker_heat +
geom_text(data = ra_lw , x = 0 , y = 7, label = ra_lw$accuracy) +
geom_text(data = ip_lw, x = 0 , y = 15, label = ip_lw$accuracy) +
geom_text(data = abb3_lw, x = 0 , y = 33, label = abb3_lw$accuracy) +
geom_text(data = mr_lw, x = 0 , y = 24, label = mr_lw$accuracy) +
geom_text(data = rc3_lw, x = -22, y = 7, label = rc3_lw$accuracy) +
geom_text(data = lc3_lw, x = 22, y = 7, label = lc3_lw$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_lw), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
Below team average from every zone except for in the paint (non RA) and right corner 3.
- 39% from right corner in last three seasons
- 33% from left corner in last three seasons
High percentage of shots are self created, shot selection more similar to volume scorer than spacer/spot-up.
Confident in mid range despite only shooting 37% but when attacking basket he does so aggressively, 159 restricted area to 85 in the paint (non RA).
Shot Summary Tables
spurs_url <- "https://api.pbpstats.com/get-totals/nba?Season=2021-22&SeasonType=Regular%2BSeason&TeamId=1610612759&Type=Player"
pbp_player <- read_json(spurs_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
walker_col <- player %>%
filter( Name == "Lonnie Walker IV") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(walker_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_walker <- bind_rows(ra_lw, ip_lw, mr_lw, abb3_lw, lc3_lw, rc3_lw) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_walker %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_walker, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Chicago Bulls",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
brown_df <- team_shared %>%
filter( namePlayer == "Troy Brown Jr.") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
brown_df$x <- brown_df$x * -1
brown_shared <- SharedData$new( brown_df, key = ~typeAction, group = "Shot Type")
#shot chart
brown_heat <- plot_court() +
geom_point( data = brown_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Brown Jr Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( brown_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()bj2_abb3 <- brown_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
bj2_lc3 <- brown_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
bj2_mr <- brown_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
bj2_rc3 <- brown_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
bj2_ip <- brown_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
bj2_ra <- brown_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
bj2_st <- bind_rows(bj2_ra, bj2_ip, bj2_mr, bj2_abb3, bj2_lc3,bj2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
bj2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
reav_22 <- lakers_shots_22 %>%
filter( namePlayer == "Austin Reaves") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
reav_22$x <- reav_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_ar <- reav_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_ar <- shotData_ar %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_ar <- shotData_ar %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_ar <- shotData_ar %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_ar <- shotData_ar %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_ar <- shotData_ar %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_ar <- shotData_ar %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Austin Reaves
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Above the Break 3", "Restricted Area", "Mid-Range")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
reav_heat <- plot_court() +
geom_density_2d_filled(reav_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Austin Reaves Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_ar <- shotData_ar %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_ar <- rasterGrob(readPNG(getURLContent(headshot_ar)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
reav_heat +
geom_text(data = ra_ar , x = 0 , y = 7, label = ra_ar$accuracy) +
geom_text(data = ip_ar, x = 0 , y = 15, label = ip_ar$accuracy) +
geom_text(data = abb3_ar, x = 0 , y = 33, label = abb3_ar$accuracy) +
geom_text(data = mr_ar, x = 0 , y = 24, label = mr_ar$accuracy) +
geom_text(data = rc3_ar, x = -22, y = 7, label = rc3_ar$accuracy) +
geom_text(data = lc3_ar, x = 22, y = 7, label = lc3_ar$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_ar), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
Really good in the paint at 57% (small sample size, 45 attempts), which is 19 percentage points above the team average from there.
Basically equivalent 3pt% as team from right corner but worse from left and above the break both by about 3 percentage points.
High percentage of 3pt attempts are assisted, shot selection profile of spacer/cutter.
Shot Summary Tables
lakers_url <- "https://api.pbpstats.com/get-totals/nba?Season=2021-22&SeasonType=Regular%2BSeason&TeamId=1610612747&Type=Player"
pbp_player <- read_json(lakers_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
reav_col <- player %>%
filter( Name == "Austin Reaves") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(reav_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_reav <- bind_rows(ra_ar, ip_ar, mr_ar, abb3_ar, lc3_ar, rc3_ar) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_reav %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_reav, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
reav_df <- team_shared %>%
filter( namePlayer == "Austin Reaves") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
reav_df$x <- reav_df$x * -1
reav_shared <- SharedData$new( reav_df, key = ~typeAction, group = "Shot Type")
#shot chart
reav_heat <- plot_court() +
geom_point( data = reav_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Reaves Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( reav_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()ar2_abb3 <- reav_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
ar2_lc3 <- reav_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
ar2_mr <- reav_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
ar2_rc3 <- reav_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ar2_ip <- reav_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ar2_ra <- reav_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
ar2_st <- bind_rows(ar2_ra, ar2_ip, ar2_mr, ar2_abb3, ar2_lc3, ar2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
ar2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
heat_shots_22 <- teams_shots(
teams = "Miami Heat",
seasons = 2021,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
nunn_22 <- heat_shots_22 %>%
filter( namePlayer == "Kendrick Nunn") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
nunn_22$x <- nunn_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_kn <- nunn_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_kn <- shotData_kn %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_kn <- shotData_kn %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_kn <- shotData_kn %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_kn <- shotData_kn %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_kn <- shotData_kn %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_kn <- shotData_kn %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Kendrick Nunn
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Above the Break 3", "Restricted Area", "In the Paint (non RA)")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
nunn_heat <- plot_court() +
geom_density_2d_filled(nunn_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Kendrick Nunn Shot Heatmap",
subtitle = "2020-2021 season,
with FG% included by zone")
#prepare headshot
headshot_kn <- shotData_kn %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_kn <- rasterGrob(readPNG(getURLContent(headshot_kn)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
nunn_heat +
geom_text(data = ra_kn , x = 0 , y = 7, label = ra_kn$accuracy) +
geom_text(data = ip_kn, x = 0 , y = 15, label = ip_kn$accuracy) +
geom_text(data = abb3_kn, x = 0 , y = 33, label = abb3_kn$accuracy) +
geom_text(data = mr_kn, x = 0 , y = 24, label = mr_kn$accuracy) +
geom_text(data = rc3_kn, x = -22, y = 7, label = rc3_kn$accuracy) +
geom_text(data = lc3_kn, x = 22, y = 7, label = lc3_kn$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_kn), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
Below team average accuracy from corners, above from all other zones.
Aggressively attacks basket, 176 restricted area attempts to 77 in the paint (non RA) attempts.
Comfortable off of dribble in mid range, shooting 47% accuracy with 72% of makes being self created.
Shot Summary Tables
heat_url <- "https://api.pbpstats.com/get-totals/nba?Season=2020-21&SeasonType=Regular%2BSeason&TeamId=1610612748&Type=Player"
pbp_player <- read_json(heat_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
nunn_col <- player %>%
filter( Name == "Kendrick Nunn") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(nunn_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_nunn <- bind_rows(ra_kn, ip_kn, mr_kn, abb3_kn, lc3_kn, rc3_kn) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_nunn %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_nunn, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Miami Heat",
seasons = 2021,
season_types = "Regular Season",
return_message = FALSE
)
nunn_df <- team_shared %>%
filter( namePlayer == "Kendrick Nunn") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20210305)
nunn_df$x <- nunn_df$x * -1
nunn_shared <- SharedData$new( nunn_df, key = ~typeAction, group = "Shot Type")
#shot chart
nunn_heat <- plot_court() +
geom_point( data = nunn_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Nunn Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( nunn_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()kn2_abb3 <- nunn_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
kn2_lc3 <- nunn_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
kn2_mr <- nunn_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
kn2_rc3 <- nunn_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
kn2_ip <- nunn_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
kn2_ra <- nunn_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
kn2_st <- bind_rows(kn2_ra, kn2_ip, kn2_mr, kn2_abb3, kn2_lc3, kn2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
kn2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
dubs_shots_22 <- teams_shots(
teams = "Golden State Warriors",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
yta_22 <- dubs_shots_22 %>%
filter( namePlayer == "Juan Toscano-Anderson") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
yta_22$x <- yta_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_yta <- yta_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_yta <- shotData_yta %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_yta <- shotData_yta %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_yta <- shotData_yta %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_yta <- shotData_yta %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_yta <- shotData_yta %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_yta <- shotData_yta %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Juan Toscano-Anderson
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Restricted Area", "Restricted Area", "Mid-Range")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
yta_heat <- plot_court() +
geom_density_2d_filled(yta_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Juan Toscano-Anderson Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_yta <- shotData_yta %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_yta <- rasterGrob(readPNG(getURLContent(headshot_yta)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
yta_heat +
geom_text(data = ra_yta , x = 0 , y = 7, label = ra_yta$accuracy) +
geom_text(data = ip_yta, x = 0 , y = 15, label = ip_yta$accuracy) +
geom_text(data = abb3_yta, x = 0 , y = 33, label = abb3_yta$accuracy) +
geom_text(data = mr_yta, x = 0 , y = 24, label = mr_yta$accuracy) +
geom_text(data = rc3_yta, x = -22, y = 7, label = rc3_yta$accuracy) +
geom_text(data = lc3_yta, x = 22, y = 7, label = lc3_yta$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_yta), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
Just above team average from above the break, well below team average from corners.
Small sample size, over two season his 3pt% is 37% and ft% is 65%.
Shot Summary Tables
dubs_url <- "https://api.pbpstats.com/get-totals/nba?Season=2021-22&SeasonType=Regular%2BSeason&TeamId=1610612744&Type=Player"
pbp_player <- read_json(dubs_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
yta_col <- player %>%
filter( Name == "Juan Toscano-Anderson") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(yta_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_yta <- bind_rows(ra_yta, ip_yta, mr_yta, abb3_yta, lc3_yta, rc3_yta) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_yta %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_yta, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Golden State Warriors",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
yta_df <- team_shared %>%
filter( namePlayer == "Juan Toscano-Anderson") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
yta_df$x <- yta_df$x * -1
yta_shared <- SharedData$new( yta_df, key = ~typeAction, group = "Shot Type")
#shot chart
yta_heat <- plot_court() +
geom_point( data = yta_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Toscano-Anderson Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( yta_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()yta2_abb3 <- yta_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
yta2_lc3 <- yta_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
yta2_mr <- yta_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
yta2_rc3 <- yta_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
yta2_ip <- yta_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
yta2_ra <- yta_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
yta2_st <- bind_rows(yta2_ra, yta2_ip, yta2_mr, yta2_abb3, yta2_lc3, yta2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
yta2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
kings_shots_22 <- teams_shots(
teams = "Sacramento Kings",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
jones_22 <- kings_shots_22 %>%
filter( namePlayer == "Damian Jones") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
jones_22$x <- jones_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_jones <- jones_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_dj <- shotData_jones %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_dj <- shotData_jones %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_dj <- shotData_jones %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_dj <- shotData_jones %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_dj <- shotData_jones %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_dj <- shotData_jones %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Damian Jones
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Restricted Area", "Restricted Area", "Right Corner 3")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
jones_heat <- plot_court() +
geom_density_2d_filled(jones_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Damian Jones Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_dj <- shotData_jones %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_dj <- rasterGrob(readPNG(getURLContent(headshot_dj)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
jones_heat +
geom_text(data = ra_dj , x = 0 , y = 7, label = ra_dj$accuracy) +
geom_text(data = ip_dj, x = 0 , y = 15, label = ip_dj$accuracy) +
geom_text(data = abb3_dj, x = 0 , y = 33, label = abb3_dj$accuracy) +
geom_text(data = mr_dj, x = 0 , y = 24, label = mr_dj$accuracy) +
geom_text(data = rc3_dj, x = -22, y = 7, label = rc3_dj$accuracy) +
geom_text(data = lc3_dj, x = 22, y = 7, label = lc3_dj$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_dj), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
High percentage of 2pt attempts are assisted.
Above team average accuracy in restricted area, mid range, and above the break.
Limited sample size but shot 73% from ft line last 3 years so has some touch.
Shot Summary Tables
king_url <- "https://api.pbpstats.com/get-totals/nba?Season=2021-22&SeasonType=Regular%2BSeason&TeamId=1610612758&Type=Player"
pbp_player <- read_json(king_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
dj_col <- player %>%
filter( Name == "Damian Jones") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(dj_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_dj <- bind_rows(ra_dj, ip_dj, mr_dj, abb3_dj, lc3_dj, rc3_dj) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_dj %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_dj, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Sacramento Kings",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
dj_df <- team_shared %>%
filter( namePlayer == "Damian Jones") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
dj_df$x <- dj_df$x * -1
dj_shared <- SharedData$new( dj_df, key = ~typeAction, group = "Shot Type")
#shot chart
dj_heat <- plot_court() +
geom_point( data = dj_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Damian Jones Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( dj_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()dj2_abb3 <- dj_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
dj2_lc3 <- dj_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
dj2_mr <- dj_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
dj2_rc3 <- dj_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
dj2_ip <- dj_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
dj2_ra <- dj_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
dj2_st <- bind_rows(dj2_ra, dj2_ip, dj2_mr, dj2_abb3, dj2_lc3, dj2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
dj2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
library(tidyverse)
library(nbastatR)
library(plyr)
library(scales)
library(dplyr)
library(paletteer)
library(cowplot)
library(grid)
library(gridExtra)
library(png)
library(RCurl)
library(crosstalk)
library(plotly)
library(reactable)
library(reactablefmtr)
library(rpubs)
library(jsonlite)
Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)
#court function from owen phillips
circle_points = function(center = c(0, 0), radius = 1, npoints = 360) {
angles = seq(0, 2 * pi, length.out = npoints)
return(data_frame(x = center[1] + radius * cos(angles),
y = center[2] + radius * sin(angles)))
}
width = 50
height = 94 / 2
key_height = 19
inner_key_width = 12
outer_key_width = 16
backboard_width = 6
backboard_offset = 4
neck_length = 0.5
hoop_radius = 0.75
hoop_center_y = backboard_offset + neck_length + hoop_radius
three_point_radius = 23.75
three_point_side_radius = 22
three_point_side_height = 14
court_themes = list(
light = list(
court = 'floralwhite',
lines = '#999999',
text = '#222222',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 1,
hex_border_color = "#000000"
),
dark = list(
court = '#000004',
lines = '#999999',
text = '#f0f0f0',
made = '#00bfc4',
missed = '#f8766d',
hex_border_size = 0,
hex_border_color = "#000000"
)
)
plot_court = function(court_theme = court_themes$light, use_short_three = FALSE) {
if (use_short_three) {
three_point_radius = 22
three_point_side_height = 0
}
court_points = data_frame(
x = c(width / 2, width / 2, -width / 2, -width / 2, width / 2),
y = c(height, 0, 0, height, height),
desc = "perimeter"
)
court_points = bind_rows(court_points , data_frame(
x = c(outer_key_width / 2, outer_key_width / 2, -outer_key_width / 2, -outer_key_width / 2),
y = c(0, key_height, key_height, 0),
desc = "outer_key"
))
court_points = bind_rows(court_points , data_frame(
x = c(-backboard_width / 2, backboard_width / 2),
y = c(backboard_offset, backboard_offset),
desc = "backboard"
))
court_points = bind_rows(court_points , data_frame(
x = c(0, 0), y = c(backboard_offset, backboard_offset + neck_length), desc = "neck"
))
foul_circle = circle_points(center = c(0, key_height), radius = inner_key_width / 2)
foul_circle_top = filter(foul_circle, y > key_height) %>%
mutate(desc = "foul_circle_top")
foul_circle_bottom = filter(foul_circle, y < key_height) %>%
mutate(
angle = atan((y - key_height) / x) * 180 / pi,
angle_group = floor((angle - 5.625) / 11.25),
desc = paste0("foul_circle_bottom_", angle_group)
) %>%
filter(angle_group %% 2 == 0) %>%
select(x, y, desc)
hoop = circle_points(center = c(0, hoop_center_y), radius = hoop_radius) %>%
mutate(desc = "hoop")
restricted = circle_points(center = c(0, hoop_center_y), radius = 4) %>%
filter(y >= hoop_center_y) %>%
mutate(desc = "restricted")
three_point_circle = circle_points(center = c(0, hoop_center_y), radius = three_point_radius) %>%
filter(y >= three_point_side_height, y >= hoop_center_y)
three_point_line = data_frame(
x = c(three_point_side_radius, three_point_side_radius, three_point_circle$x, -three_point_side_radius, -three_point_side_radius),
y = c(0, three_point_side_height, three_point_circle$y, three_point_side_height, 0),
desc = "three_point_line"
)
court_points = bind_rows(
court_points,
foul_circle_top,
foul_circle_bottom,
hoop,
restricted,
three_point_line
)
court_points <- court_points
ggplot() +
geom_path(
data = court_points,
aes(x = x, y = y, group = desc),
color = court_theme$lines
) +
coord_fixed(ylim = c(0, 45), xlim = c(-25, 25)) +
theme_minimal(base_size = 22) +
theme(
text = element_text(color = court_theme$text),
plot.background = element_rect(fill = 'floralwhite', color = 'floralwhite'),
panel.background = element_rect(fill = court_theme$court, color = court_theme$court),
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
legend.background = element_rect(fill = court_theme$court, color = court_theme$court),
legend.position = "bottom",
legend.key = element_blank(),
legend.text = element_text(size = rel(1.0))
)
}
pc <- plot_court(court_themes$light)
#shot data from nbastatR
team_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
#clean data for plot_court
wg_22 <- team_shots_22 %>%
filter( namePlayer == "Wenyen Gabriel") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
wg_22$x <- wg_22$x * -1
#use nbastatR to get player headshots
active_player_photos <- nba_players() %>%
filter( isActive == "TRUE") %>%
select(namePlayer,
idPlayer,
urlPlayerHeadshot,
urlPlayerActionPhoto)
#remove backcourt shots
shotData_wg <- wg_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
)) %>%
right_join(active_player_photos)
#find fg% by zone
abb3_wg <- shotData_wg %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
lc3_wg <- shotData_wg %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
mr_wg <- shotData_wg %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
rc3_wg <- shotData_wg %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
ip_wg <- shotData_wg %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
ra_wg <- shotData_wg %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")Wenyen Gabriel
c <- c("Favorite zone", "Best zone", "Worst zone")
d <- c("Restricted Area", "Restricted Area", "Mid-Range")
bind_cols(c,d) %>%
rename( " " = '...2',
" " = '...1') %>%
reactable() %>%
add_title("Quick Summary")Quick Summary
Heatmap
#heat map
palette <- paletteer_d( "RColorBrewer::YlOrRd", direction = -1 )
wg_heat <- plot_court() +
geom_density_2d_filled(wg_22, mapping = aes( x = x, y = y,
fill = ..level..,),
contour_var = "ndensity" ,
breaks = seq(0.1,1.0, length.out = 10),
alpha = .75) +
scale_fill_manual( values = c(palette), aesthetics = c("fill", "color")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0, 45)) +
theme( legend.position = "none",
plot.title = element_text( hjust = .5 , size = 22,
family = "Comic Sans MS",
face = "bold",
vjust = -4),
plot.subtitle = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
vjust = -5),
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text( hjust = .5, size = 10,
family = "Comic Sans MS",
face = "bold",
color = "white"),
plot.caption = element_text(hjust = .5, size = 6,
family = "Comic Sans MS",
face = "bold",
color = "lightgrey",
vjust = 8)
) +
labs( title = "Wenyen Gabriel Shot Heatmap",
subtitle = "2021-2022 season,
with FG% included by zone")
#prepare headshot
headshot_wg <- shotData_wg %>%
select(urlPlayerHeadshot) %>%
.[1,1]
playerImg_wg <- rasterGrob(readPNG(getURLContent(headshot_wg)),
width = unit(.15, "npc"))
#combine heatmap with fg% by zones
wg_heat +
geom_text(data = ra_wg , x = 0 , y = 7, label = ra_wg$accuracy) +
geom_text(data = ip_wg, x = 0 , y = 15, label = ip_wg$accuracy) +
geom_text(data = abb3_wg, x = 0 , y = 33, label = abb3_wg$accuracy) +
geom_text(data = mr_wg, x = 0 , y = 24, label = mr_wg$accuracy) +
geom_text(data = rc3_wg, x = -22, y = 7, label = rc3_wg$accuracy) +
geom_text(data = lc3_wg, x = 22, y = 7, label = lc3_wg$accuracy)
#add player photo
pushViewport(viewport(x = unit(0.9, "npc"), y = unit(0.8, "npc")))
print(grid.draw(playerImg_wg), newpage=FALSE)
## NULLColored areas represent where a player takes most of their shots from (where they like to operate from), the brighter areas equate to a higher frequency.
Zones: Restricted Area, In the Paint(non-Restricted Area), Mid-Range, Above the Break 3, Left Corner 3, and Right Corner 3.
Left and right determined from the perspective of half-court facing the hoop.
Heatmap Takeaways
All makes outside of restricted area were assisted on.
Slightly above team average finisher, below from every other area.
Shot Summary Tables
lakers_url <- "https://api.pbpstats.com/get-totals/nba?Season=2021-22&SeasonType=Regular%2BSeason&TeamId=1610612747&Type=Player"
pbp_player <- read_json(lakers_url)
player <- pbp_player[["multi_row_table_data"]] %>%
bind_rows()
wg_col <- player %>%
filter( Name == "Wenyen Gabriel") %>%
select(Assisted2sPct,
ShortMidRangePctAssisted,
LongMidRangePctAssisted,
Assisted3sPct,
Corner3PctAssisted,
Arc3PctAssisted) %>%
mutate_at(vars(Assisted2sPct, Assisted3sPct, ShortMidRangePctAssisted, LongMidRangePctAssisted, Corner3PctAssisted, Arc3PctAssisted), funs(round(.,4))) %>%
rename( '2ptFG' = "Assisted2sPct",
'Short Mid-Range' = "ShortMidRangePctAssisted",
'Long Mid-Range' = "LongMidRangePctAssisted",
'3ptFG' = "Assisted3sPct",
'Corner 3' = "Corner3PctAssisted",
'Above the Break 3' = "Arc3PctAssisted") %>%
pivot_longer( cols = c('2ptFG':'Above the Break 3'),
names_to = "Stat",
values_to = "value") %>%
mutate( value = value *100,
shot = case_when(
Stat == "2ptFG" ~ "Two",
Stat == "Short Mid-Range" ~ "Two",
Stat == "Long Mid-Range" ~ "Two",
TRUE ~ "Three"
))
ggplot(wg_col, aes(x = factor(Stat, level = c('2ptFG', 'Short Mid-Range','Long Mid-Range', '3ptFG','Corner 3', 'Above the Break 3')), y = value, fill = shot)) +
geom_col() +
geom_text( aes(label = value), position = position_stack(vjust = .85)) +
theme( axis.title.x = element_blank(),
axis.text.x = element_text( angle = 60, vjust = .5, hjust = .5)) +
labs( title = "% of makes assisted by range",
x = "Range",
y = "% of makes assisted")
st_wg <- bind_rows(ra_wg, ip_wg, mr_wg, abb3_wg, lc3_wg, rc3_wg) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
lakers_shots_22 <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
team_22 <- lakers_shots_22 %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame))
team_22$x <- team_22$x * -1
shotData_team <- team_22 %>%
filter( nameZone != "Back Court") %>%
mutate( isShotAttempted =
case_when(
isShotAttempted == "TRUE" ~ 1,
TRUE ~ 0
),
isShotMade =
case_when(
isShotMade == "TRUE" ~ 1,
TRUE ~ 0
))
abb3_t <- shotData_team %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot)) %>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Above the Break 3")
lc3_t <- shotData_team %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Left Corner 3")
mr_t <- shotData_team %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Mid-Range")
rc3_t <- shotData_team %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "Right Corner 3")
ip_t <- shotData_team %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate( team_accuracy = team_accuracy * 100,
zone = "In the Paint (non RA)")
ra_t <- shotData_team %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( team_accuracy = mean(isShotMade),
team_shots = sum(isShotAttempted),
team_makes = sum(isShotMade),
team_avg_distance = mean(distanceShot))%>%
mutate_at(vars(team_accuracy, team_avg_distance), funs(round(.,4))) %>%
mutate(zone = "Restricted Area",
team_accuracy = team_accuracy * 100,)
st_team <- bind_rows(ra_t, ip_t, mr_t, abb3_t, lc3_t, rc3_t) %>%
select(zone, team_makes, team_shots, team_accuracy, team_avg_distance) %>%
rename( 'team_accuracy %' = team_accuracy,
team_attempts = team_shots) %>%
mutate( 'team_pts/att' =
case_when(
zone == "Restricted Area" ~ (team_makes * 2)/team_attempts,
zone == "In the Paint (non RA)" ~ (team_makes * 2)/team_attempts,
zone == "Mid-Range" ~ (team_makes * 2)/team_attempts,
TRUE ~ (team_makes * 3)/team_attempts
)) %>%
mutate_at(vars('team_pts/att'), funs(round(.,4))) %>%
select( zone, 'team_accuracy %', 'team_pts/att')
st_wg %>%
reactable() %>%
add_title("Attempts, Makes, & Accuracy by Zone")Attempts, Makes, & Accuracy by Zone
right_join(st_wg, st_team) %>%
select( zone, 'accuracy %', 'team_accuracy %', 'pts/att', 'team_pts/att') %>%
reactable(sortable = TRUE) %>%
add_title("Player vs Team")Player vs Team
Last 20 Games
team_shared <- teams_shots(
teams = "Los Angeles Lakers",
seasons = 2022,
season_types = "Regular Season",
return_message = FALSE
)
wg_df <- team_shared %>%
filter( namePlayer == "Wenyen Gabriel") %>%
mutate( x = as.numeric(as.character(locationX))/10,
y = as.numeric(as.character(locationY))/ 10 + hoop_center_y,
dateGame = as.numeric(dateGame)) %>%
filter(dateGame > 20220305)
wg_df$x <- wg_df$x * -1
wg_shared <- SharedData$new( wg_df, key = ~typeAction, group = "Shot Type")
#shot chart
wg_heat <- plot_court() +
geom_point( data = wg_shared, aes( x = x , y = y,
color = isShotMade,
fill = isShotMade),
size = 2, shape = 21, stroke = .2) +
scale_color_manual( values = c("green4", "red3"),
aesthetics = "color",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_fill_manual( values = c("green2", "grey20"),
aesthetics = "fill",
breaks = c("TRUE", "FALSE"),
labels = c("Made", "Missed")) +
scale_x_continuous( limits = c(-27.5, 27.5)) +
scale_y_continuous( limits = c(0,45)) +
theme( legend.title = element_blank()) +
ggtitle( label = "Gabriel Shot Chart",
subtitle = "last 20 games of '22")
ggplotly( wg_heat) %>%
highlight( selectize = TRUE) %>%
hide_legend()wg2_abb3 <- wg_df %>%
filter( zoneBasic == "Above the Break 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot)) %>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Above the Break 3")
wg2_lc3 <- wg_df %>%
filter( zoneBasic == "Left Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Left Corner 3")
wg2_mr <- wg_df %>%
filter( zoneBasic == "Mid-Range") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Mid-Range")
wg2_rc3 <- wg_df %>%
filter( zoneBasic == "Right Corner 3") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Right Corner 3")
wg2_ip <- wg_df %>%
filter( zoneBasic == "In The Paint (Non-RA)") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "In the Paint (non RA)")
wg2_ra <- wg_df %>%
filter( zoneBasic == "Restricted Area") %>%
summarise( accuracy = mean(isShotMade),
shots = sum(isShotAttempted),
makes = sum(isShotMade),
avg_distance = mean(distanceShot))%>%
mutate_at(vars(accuracy, avg_distance), funs(round(.,4))) %>%
mutate( accuracy = accuracy * 100,
zone = "Restricted Area")
wg2_st <- bind_rows(wg2_ra, wg2_ip, wg2_mr, wg2_abb3, wg2_lc3, wg2_rc3) %>%
select(zone, makes, shots, accuracy, avg_distance) %>%
rename( 'accuracy %' = accuracy,
attempts = shots) %>%
mutate( 'pts/att' =
case_when(
zone == "Restricted Area" ~ (makes * 2)/attempts,
zone == "In the Paint (non RA)" ~ (makes * 2)/attempts,
zone == "Mid-Range" ~ (makes * 2)/attempts,
TRUE ~ (makes * 3)/attempts
)) %>%
mutate_at(vars('pts/att'), funs(round(.,4)))
wg2_st %>%
reactable() %>%
add_title("Last 20 Games: Attempts, Makes, & Accuracy by Zone")Last 20 Games: Attempts, Makes, & Accuracy by Zone
Notes
- Quick Summary Template:
- Favorite zone = highest number of shot attempts
- Best zone = highest pts/att
- Worst zone = lowest pts/att
Team stats refer to Lakers 2021-2022 season
All stats are from the 2021-2022 regular season.