Introduction
This vignette demonstrates how to create rich WNBA visualizations by combining wehoop for player and team data with sdvplotR for team logos, headshots, colors, and gt tables.
Loading WNBA Data
Use wehoop to load this season’s ESPN team and player
box scores:
# The last completed regular season (it ends in mid-September)
season <- as.integer(format(Sys.Date(), "%Y")) -
(format(Sys.Date(), "%m-%d") < "09-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("wnba")$team_abbr
team_stats <- wehoop::load_wnba_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 <- wehoop::load_wnba_player_box(seasons = season) |>
filter(season_type == 2, !did_not_play, team_abbreviation %in% league_teams)WNBA 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 = "wnba",
width = 0.075
) +
labs(
title = "WNBA Team Performance",
subtitle = paste("Season", season),
x = "Average Points per Game",
y = "Average Rebounds per Game",
caption = "Data: wehoop | Viz: sdvplotR"
) +
theme_minimal()WNBA 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))
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 = "wnba", alpha = 0.8) +
scale_y_continuous(labels = scales::percent) +
labs(
title = "WNBA 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 >= 15) |>
arrange(desc(avg_points)) |>
head(8)
ggplot(top_scorers, aes(x = games, y = avg_points)) +
geom_sdv_headshots(
aes(player_id = athlete_id),
sport = "wnba",
height = 0.15
) +
geom_label(
aes(label = athlete_display_name),
nudge_y = -1.0,
size = 3,
alpha = 0.7
) +
labs(
title = "Top 8 WNBA Scorers",
subtitle = paste("Season", season),
x = "Games Played",
y = "Average Points per Game"
) +
theme_minimal()WNBA Stats player IDs
The headshots above use ESPN athlete IDs, the athlete_id
in wehoop’s load_wnba_*() data. wehoop’s
wnba_*() functions read stats.wnba.com, which numbers
players differently (PLAYER_ID). Pass
id_type = "league" to draw those from the WNBA’s own image
CDN. Both are plain numbers, so without it a WNBA Stats ID is read as an
ESPN ID and draws someone else or nothing.
leaders <- wehoop::wnba_leagueleaders(season = season)$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 = "wnba",
id_type = "league",
height = 0.15
) +
labs(title = "WNBA 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
WNBA’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.
WNBA Team Tiers
Create a tier plot ranking WNBA teams:
# Sample tier assignments
tier_data <- data.frame(
tier_no = c(1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5),
team = c("LV", "NY", "WAS", "DAL", "MIN",
"SEA", "CHI", "ATL",
"PHX", "LA", "CON",
"IND")
)
sdv_team_tiers(
tier_data,
sport = "wnba",
title = "WNBA Power Rankings",
subtitle = paste("As of", Sys.Date()),
tier_desc = c(
"1" = "Championship Favorites",
"2" = "Contenders",
"3" = "Playoff Teams",
"4" = "Bubble Teams",
"5" = "Developing"
)
)WNBA Conference Standings
Visualize teams by conference:
# Every team's winning percentage, with the conference sdvplotR keeps for it
conference_standings <- team_stats |>
group_by(team_abbreviation) |>
summarise(win_pct = mean(team_winner, na.rm = TRUE), .groups = "drop") |>
mutate(team_abbr = clean_team_abbrs(team_abbreviation, sport = "wnba")) |>
inner_join(select(team_reference("wnba"), team_abbr, conference), by = "team_abbr") |>
arrange(conference, desc(win_pct)) |>
group_by(conference) |>
mutate(team_rank = row_number()) |>
ungroup() |>
mutate(conference_num = as.numeric(factor(conference)))
ggplot(conference_standings, aes(x = conference_num, y = team_rank)) +
geom_sdv_logos(
aes(team = team_abbr),
sport = "wnba",
width = 0.12
) +
scale_x_continuous(
breaks = seq_along(levels(factor(conference_standings$conference))),
labels = levels(factor(conference_standings$conference)),
expand = expansion(add = 0.6)
) +
scale_y_reverse() +
labs(
title = "WNBA Teams by Conference, Best Record on Top",
x = NULL,
y = NULL
) +
theme_minimal() +
theme(
axis.text.y = element_blank(),
panel.grid = element_blank()
)WNBA Standings Table with Logos
Create a gt table with team logos:
standings_table <- team_wins |>
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 = "wnba", 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 = "WNBA Standings",
subtitle = paste("Season", season)
)Player Performance Comparison
Compare the scoring leaders with the assist leaders:
per_game <- player_stats |>
group_by(athlete_id, athlete_display_name) |>
summarise(
points = mean(points, na.rm = TRUE),
assists = mean(assists, na.rm = TRUE),
games = n(),
.groups = "drop"
) |>
filter(games >= 15)
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(assists, n = 5, with_ties = FALSE) |>
transmute(athlete_id, category = "Assists per Game", value = assists)
) |>
group_by(category) |>
mutate(rank = row_number()) |>
ungroup()
ggplot(comparison, aes(x = rank, y = value)) +
geom_sdv_headshots(
aes(player_id = athlete_id),
sport = "wnba",
height = 0.2
) +
facet_wrap(~category, scales = "free_y") +
scale_x_continuous(breaks = 1:5) +
labs(
title = "WNBA 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 = "wnba", alpha = 0.7) +
scale_x_sdv(sport = "wnba") +
theme_minimal() +
theme_x_sdv() +
labs(
title = "Top 8 WNBA Teams by Win %",
x = NULL,
y = "Win Percentage"
) +
theme(legend.position = "none")Next Steps
- Explore wehoop documentation
- Try combining with oddsapiR for betting lines
- Build weekly dashboard with Quarto