Introduction
This vignette demonstrates how to create rich NBA visualizations by combining hoopR for player and team data with sdvplotR for team logos, headshots, colors, and gt tables.
Loading NBA Data
Use hoopR to load this season’s ESPN team and player box
scores:
# The last completed regular season (hoopR names a season for the year it
# ends; the regular season ends in mid-April)
season <- as.integer(format(Sys.Date(), "%Y")) -
(format(Sys.Date(), "%m-%d") < "04-20")
# One row per team per game (ESPN box scores), regular season only. ESPN tags
# the All-Star games as regular season too; keeping the league's own teams
# drops them
league_teams <- team_reference("nba")$team_abbr
team_stats <- hoopR::load_nba_team_box(seasons = season) |>
filter(season_type == 2, team_abbreviation %in% league_teams)
# One row per player per game, with ESPN athlete IDs; players who did not
# play are dropped so games played counts real games
player_stats <- hoopR::load_nba_player_box(seasons = season) |>
filter(season_type == 2, !did_not_play, team_abbreviation %in% league_teams)NBA Team Performance
Visualize team performance with team logos:
# Calculate team metrics
team_perf <- team_stats |>
filter(!is.na(team_abbreviation)) |>
group_by(team_abbreviation) |>
summarise(
avg_points = mean(team_score, na.rm = TRUE),
avg_rebounds = mean(total_rebounds, na.rm = TRUE),
games = n(),
.groups = "drop"
) |>
filter(games >= 10)
ggplot(team_perf, aes(x = avg_points, y = avg_rebounds)) +
geom_sdv_logos(
aes(team = team_abbreviation),
sport = "nba",
width = 0.075
) +
labs(
title = "NBA Team Performance",
subtitle = paste("Season", season),
x = "Average Points per Game",
y = "Average Rebounds per Game",
caption = "Data: hoopR | Viz: sdvplotR"
) +
theme_minimal()NBA Team Colors
Use team colors to visualize win percentages:
# Calculate win percentage
team_wins <- team_stats |>
filter(!is.na(team_abbreviation)) |>
group_by(team_abbreviation) |>
summarise(
wins = sum(team_winner, na.rm = TRUE),
games = n(),
.groups = "drop"
) |>
filter(games >= 10) |>
mutate(win_pct = wins / games) |>
arrange(desc(win_pct)) |>
head(16)
ggplot(team_wins, aes(x = reorder(team_abbreviation, win_pct), y = win_pct)) +
geom_col(aes(fill = team_abbreviation), width = 0.7) +
scale_fill_sdv(sport = "nba", alpha = 0.8) +
scale_y_continuous(labels = scales::percent) +
labs(
title = "Top 16 NBA Teams by Win Percentage",
x = NULL,
y = "Win Percentage"
) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "none"
)Player Headshots
Visualize top performers with player headshots:
# Top scorers
top_scorers <- player_stats |>
filter(!is.na(athlete_id)) |>
group_by(athlete_id, athlete_display_name) |>
summarise(
avg_points = mean(points, na.rm = TRUE),
games = n(),
.groups = "drop"
) |>
filter(games >= 20) |>
arrange(desc(avg_points)) |>
head(8)
ggplot(top_scorers, aes(x = games, y = avg_points)) +
geom_sdv_headshots(
aes(player_id = athlete_id),
sport = "nba",
height = 0.15
) +
geom_label(
aes(label = athlete_display_name),
nudge_y = -1.5,
size = 3,
alpha = 0.7
) +
labs(
title = "Top 8 NBA Scorers",
subtitle = paste("Season", season),
x = "Games Played",
y = "Average Points per Game"
) +
theme_minimal()NBA Stats player IDs
The headshots above use ESPN athlete IDs, the athlete_id
in hoopR’s load_nba_*() data. hoopR’s nba_*()
functions read stats.nba.com, which numbers players differently
(PLAYER_ID). Pass id_type = "league" to draw
those from the NBA’s own image CDN. Both are plain numbers, so without
it an NBA Stats ID is read as an ESPN ID and draws someone else or
nothing: Dirk Nowitzki’s NBA Stats ID, 1717, is ESPN’s Jared
Jeffries.
leaders <- hoopR::nba_leagueleaders(season = hoopR::year_to_season(season - 1), stat_category = "PTS")$LeagueLeaders |>
mutate(across(c(GP, PTS), as.numeric)) |>
head(8)
ggplot(leaders, aes(x = GP, y = PTS)) +
geom_sdv_headshots(
aes(player_id = PLAYER_ID),
sport = "nba",
id_type = "league",
height = 0.15
) +
labs(title = "NBA scoring leaders", x = "Games Played", y = "Points")id_type works the same in
gt_sdv_headshots(), reactable_sdv_headshots(),
the headshot axis scales and element_sdv_headshot(). The
NBA’s image CDN refuses requests from datacenter IPs, so a plot rendered
on CI or a server can come back without these headshots; tables are
unaffected, because the reader’s browser loads the images.
NBA Team Tiers
Create a tier plot ranking NBA teams:
# Sample tier assignments
tier_data <- data.frame(
tier_no = c(1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5),
team = c("BOS", "DEN", "MIL", "PHX", "LAL", "GSW", "MIA",
"DAL", "PHI", "NYK", "CLE",
"SAC", "MIN", "MEM", "BKN",
"ATL")
)
sdv_team_tiers(
tier_data,
sport = "nba",
title = "NBA Power Rankings",
subtitle = paste("As of", Sys.Date()),
tier_desc = c(
"1" = "Championship Contenders",
"2" = "Playoff Favorites",
"3" = "Solid Playoffs",
"4" = "Bubble Teams",
"5" = "Rebuilding"
)
)NBA Conference Map
Show each conference’s teams in a column, using the conferences sdvplotR keeps for every team:
conference_map <- team_reference("nba") |>
arrange(conference, team_name) |>
group_by(conference) |>
mutate(team_rank = row_number()) |>
ungroup() |>
mutate(conference_num = as.numeric(factor(conference)))
ggplot(conference_map, aes(x = conference_num, y = team_rank)) +
geom_sdv_logos(
aes(team = team_abbr),
sport = "nba",
width = 0.08
) +
scale_x_continuous(
breaks = seq_along(levels(factor(conference_map$conference))),
labels = levels(factor(conference_map$conference)),
expand = expansion(add = 0.6)
) +
scale_y_reverse() +
labs(
title = "NBA Teams by Conference",
x = NULL,
y = NULL
) +
theme_minimal() +
theme(
axis.text.y = element_blank(),
panel.grid = element_blank()
)NBA Standings Table with Logos
Create a gt table with team logos:
standings_table <- team_wins |>
head(10) |>
mutate(
logo = team_abbreviation,
rank = row_number()
) |>
select(rank, logo, team_abbreviation, wins, games, win_pct)
standings_table |>
gt() |>
gt_sdv_logos(columns = "logo", sport = "nba", height = 35) |>
fmt_number(columns = "win_pct", decimals = 3) |>
cols_label(
rank = "#",
logo = "Team",
team_abbreviation = "Abbrev",
wins = "Wins",
games = "Games",
win_pct = "Win %"
) |>
tab_header(
title = "NBA Top 10",
subtitle = paste("Season", season)
)Player Performance Comparison
Compare the scoring leaders with the rebounding leaders:
per_game <- player_stats |>
group_by(athlete_id, athlete_display_name) |>
summarise(
points = mean(points, na.rm = TRUE),
rebounds = mean(rebounds, na.rm = TRUE),
games = n(),
.groups = "drop"
) |>
filter(games >= 20)
comparison <- bind_rows(
per_game |>
slice_max(points, n = 5, with_ties = FALSE) |>
transmute(athlete_id, category = "Points per Game", value = points),
per_game |>
slice_max(rebounds, n = 5, with_ties = FALSE) |>
transmute(athlete_id, category = "Rebounds per Game", value = rebounds)
) |>
group_by(category) |>
mutate(rank = row_number()) |>
ungroup()
ggplot(comparison, aes(x = rank, y = value)) +
geom_sdv_headshots(
aes(player_id = athlete_id),
sport = "nba",
height = 0.2
) +
facet_wrap(~category, scales = "free_y") +
scale_x_continuous(breaks = 1:5) +
labs(
title = "NBA Top Performers",
subtitle = paste("Season", season),
x = "Rank",
y = NULL
) +
theme_minimal()Axis Labels with Logos
Replace axis labels with team logos:
top_8 <- team_wins |>
head(8) |>
mutate(team_abbreviation = factor(team_abbreviation, levels = team_abbreviation))
ggplot(top_8, aes(x = team_abbreviation, y = win_pct)) +
geom_col(aes(fill = team_abbreviation), width = 0.6) +
scale_fill_sdv(sport = "nba", alpha = 0.7) +
scale_x_sdv(sport = "nba") +
theme_minimal() +
theme_x_sdv() +
labs(
title = "Top 8 NBA Teams by Win %",
x = NULL,
y = "Win Percentage"
) +
theme(legend.position = "none")Next Steps
- Explore hoopR documentation
- Try combining with oddsapiR for betting lines
- Build weekly dashboard with Quarto