WSL Capstone: Performance, Locations, and Decision Support

MSBA 580 — Athletes, Seasons, Surf Locations, and Managerial Insights

Interactive dashboard: WSL Tour Worldwide Event Map

library(readxl)
library(dplyr)
library(tidyr)
library(stringr)
library(forcats)
library(ggplot2)
library(scales)
library(knitr)
library(plotly)

ocean <- list(
  deep  = "#0B3D4A",
  teal  = "#1A7A8C",
  foam  = "#5EB3C1",
  sand  = "#E8D5B7",
  coral = "#D4654A",
  dusk  = "#2C5F7C",
  ink   = "#1A2332"
)

theme_wsl <- function(base_size = 13) {
  theme_minimal(base_size = base_size) +
    theme(
      plot.title = element_text(face = "bold", color = ocean$ink, size = base_size + 3),
      plot.subtitle = element_text(color = ocean$dusk, margin = margin(b = 12)),
      axis.title = element_text(color = ocean$dusk),
      panel.grid.minor = element_blank(),
      panel.grid.major = element_line(color = "#E6EEF0"),
      legend.position = "bottom",
      strip.text = element_text(face = "bold", color = ocean$deep)
    )
}

div_cols <- c(Men = "#2E86DE", Women = "#F8A5C2")

Introduction

Problem statement

The World Surf League (WSL) Championship Tour and Longboard Tour generate rich competitive results across seasons, athletes, divisions, and surf locations. Sponsors, event organizers, media partners, and athlete managers need clearer answers to questions such as:

• Which athletes accumulate the most points across completed seasons?
• How does performance change over time for top multi-year athletes?
• Which contest locations produce higher average scoring outcomes?
• How do Men’s and Women’s placement structures differ because of draw size and elimination format?

Research objectives

1. Describe Championship Tour and Longboard Tour performance using cleaned multi-season placement and points data.
2. Model relationships between athlete outcomes and observable factors (division, season, location intensity) using multiple regression and cluster segmentation.
3. Communicate insights through interactive Plotly visuals and a deployed Shiny map for decision makers.
4. Recommend managerial actions for sponsorship targeting, athlete storytelling, and event portfolio review.

Business relevance

Sports and sponsorship analytics are a natural Capstone fit for MSBA 580. Quantifying who scores, where scoring is richest, and how tour structure shapes finishes supports decisions about athlete partnerships, content calendars, and which stops deserve more marketing investment.

This report is the primary RPubs deliverable. The companion Shiny app extends the geography story for interactive exploration.

Data Collection

Primary dataset

The core dataset is a curated multi-sheet Excel workbook of WSL results:

• File: WSL_Combined_All_Tours_READY.xlsx
• Sheets used: Events, Locations, Event Finalists, Full Placements (CT), Longboard Full Placements, Rankings
• Coverage:
  • Championship Tour placements: primarily 2022–2026 (treat 2026 as incomplete in career-style totals)
  • Longboard placements: 2021–2025
  • Rankings: 2021–2026 (both tours)

Missing seasons are not treated as zero performance. Career-style point totals and models use completed Championship Tour seasons 2022–2025 unless noted otherwise.

candidate_paths <- c(
  "data/WSL_Combined_All_Tours_READY.xlsx",
  "WSL_Combined_All_Tours_READY.xlsx",
  file.path("..", "WSL_Combined_All_Tours_READY.xlsx"),
  "~/Desktop/WSL_Combined_All_Tours_READY.xlsx",
  "~/Desktop/R Projects/WSL-Visualizations/data/WSL_Combined_All_Tours_READY.xlsx",
  "~/Desktop/R Projects/WSL-Visualizations/WSL_Combined_All_Tours_READY.xlsx",
  "~/Documents/580/JeffsSurfFinal/data/WSL_Combined_All_Tours_READY.xlsx"
)

candidate_paths <- path.expand(candidate_paths)
data_path <- candidate_paths[file.exists(candidate_paths)][1]

if (is.na(data_path) || !nzchar(data_path)) {
  stop(
    "Could not find WSL_Combined_All_Tours_READY.xlsx. ",
    "Place it in JeffsSurfFinal/data/ (or project root) and re-knit."
  )
}

cat("Using data file:\n", data_path, "\n")

## Using data file:
##  ../WSL_Combined_All_Tours_READY.xlsx

Scope note

This Capstone focuses on sports performance and location analytics built from the WSL results warehouse and a deployed interactive map. It does not include a class survey component.

Data Preparation

events    <- read_excel(data_path, "Events")
locations <- read_excel(data_path, "Locations")
finalists <- read_excel(data_path, "Event Finalists")
ct        <- read_excel(data_path, "Full Placements (CT)")
lb        <- read_excel(data_path, "Longboard Full Placements")
rankings  <- read_excel(data_path, "Rankings")

normalize_country <- function(x) {
  dplyr::recode(x, "USA" = "United States", .default = as.character(x))
}

placement_to_num <- function(x) {
  dplyr::case_when(
    x == "1st" ~ 1, x == "2nd" ~ 2, x == "3rd" ~ 3, x == "4th" ~ 4,
    x == "5th" ~ 5, x == "9th" ~ 9, x == "13th" ~ 13, x == "17th" ~ 17,
    x == "33rd" ~ 33, TRUE ~ NA_real_
  )
}

events <- events %>% mutate(Country = normalize_country(Country))

ct <- ct %>%
  mutate(
    Country = normalize_country(Country),
    Place_Num = placement_to_num(Placement),
    Podium = Place_Num %in% 1:3,
    Tour = "Championship"
  )

lb <- lb %>%
  mutate(
    Country = normalize_country(Country),
    Place_Num = placement_to_num(Placement),
    Podium = Place_Num %in% 1:3,
    Location = case_when(
      Location %in% c("Malibu", "Malibu, California") ~ "Malibu, California",
      TRUE ~ Location
    ),
    Tour = "Longboard"
  )

rankings <- rankings %>%
  mutate(
    is_champion = World_Champion %in% c(TRUE, "Yes", "yes", "YES"),
    Tour_Short = if_else(str_detect(Tour, "Longboard"), "Longboard", "Championship")
  )

ct_complete <- ct %>% filter(Season %in% 2022:2025, !is.na(Points))
lb_complete <- lb %>% filter(Season %in% 2021:2025, !is.na(Points))

Cleaning procedures

• Standardized country labels (USA → United States).
• Converted ordinal placements (1st, 2nd, …) to numeric Place_Num.
• Harmonized Longboard location name variants (e.g., Malibu).
• Excluded incomplete 2026 Championship Tour season from cumulative and model inputs.
• Built Podium flags for finishes 1st–3rd.

Variable construction

athlete_season <- ct_complete %>%
  group_by(Athlete, Division, Season) %>%
  summarise(
    Events = n(),
    Total_Points = sum(Points, na.rm = TRUE),
    Avg_Points = mean(Points, na.rm = TRUE),
    Best_Place = min(Place_Num, na.rm = TRUE),
    Podium_Rate = mean(Podium, na.rm = TRUE),
    .groups = "drop"
  )

loc_intensity <- ct_complete %>%
  group_by(Location) %>%
  summarise(
    Loc_Avg_Points = mean(Points, na.rm = TRUE),
    Loc_Starts = n(),
    .groups = "drop"
  )

ct_model <- ct_complete %>%
  left_join(loc_intensity, by = "Location") %>%
  mutate(
    Division = factor(Division),
    Season = factor(Season)
  )

Data integration

Primary integration is within the WSL workbook (events ↔︎ locations ↔︎ placements ↔︎ rankings). The Shiny map uses location coordinates from the same warehouse so stakeholders can move from static charts to interactive geography.

Analysis

Descriptive overview

ct_summary <- ct_complete %>%
  summarise(
    Starts = n(),
    Athletes = n_distinct(Athlete),
    Locations = n_distinct(Location),
    Seasons = n_distinct(Season),
    Mean_Points = mean(Points, na.rm = TRUE),
    Podium_Pct = mean(Podium, na.rm = TRUE)
  )

lb_summary <- lb_complete %>%
  summarise(
    Starts = n(),
    Athletes = n_distinct(Athlete),
    Locations = n_distinct(Location),
    Seasons = n_distinct(Season),
    Mean_Points = mean(Points, na.rm = TRUE),
    Podium_Pct = mean(Podium, na.rm = TRUE)
  )

bind_rows(
  ct_summary %>% mutate(Tour = "Championship (2022–2025)"),
  lb_summary %>% mutate(Tour = "Longboard (2021–2025)")
) %>%
  relocate(Tour) %>%
  mutate(
    Mean_Points = round(Mean_Points, 1),
    Podium_Pct = percent(Podium_Pct, accuracy = 0.1)
  ) %>%
  kable(caption = "Tour-level descriptive summary (completed seasons)")

Tour-level descriptive summary (completed seasons)

Tour	Starts	Athletes	Locations	Seasons	Mean_Points	Podium_Pct
Championship (2022–2025)	1653	78	16	4	3612.0	19.3%
Longboard (2021–2025)	562	87	8	5	3333.4	19.9%

Championship Tour — who scores

Who banked the most Championship Tour points across completed seasons? The chart below ranks leading athletes in each division by summed event points for 2022–2025.

top_athletes <- ct_complete %>%
  group_by(Athlete, Division) %>%
  summarise(
    Total_Points = sum(Points, na.rm = TRUE),
    Events = n(),
    Avg_Points = mean(Points, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  group_by(Division) %>%
  slice_max(Total_Points, n = 8, with_ties = FALSE) %>%
  ungroup() %>%
  mutate(Athlete = fct_reorder(Athlete, Total_Points))

ggplot(top_athletes, aes(x = Athlete, y = Total_Points, fill = Division)) +
  geom_col(width = 0.75) +
  coord_flip() +
  facet_wrap(~ Division, scales = "free_y") +
  scale_fill_manual(values = div_cols) +
  scale_y_continuous(labels = comma) +
  labs(
    title = "Top Championship Tour Surfers by Total Points",
    subtitle = "Completed seasons 2022–2025 only (2026 excluded as incomplete)",
    x = NULL,
    y = "Total points",
    fill = "Division"
  ) +
  theme_wsl() +
  theme(legend.position = "none")

top_athletes %>%
  arrange(Division, desc(Total_Points)) %>%
  mutate(
    Total_Points = comma(Total_Points),
    Avg_Points = round(Avg_Points, 0)
  ) %>%
  kable(col.names = c("Athlete", "Division", "Total Points", "Event Starts", "Avg Points / Start"))

Athlete	Division	Total Points	Event Starts	Avg Points / Start
Griffin Colapinto	Men	207,740	42	4946
Jack Robinson	Men	190,905	41	4656
Ethan Ewing	Men	189,135	41	4613
Yago Dora	Men	167,490	41	4085
Ítalo Ferreira	Men	167,115	41	4076
Filipe Toledo	Men	159,325	32	4979
Jordy Smith	Men	152,125	41	3710
Kanoa Igarashi	Men	142,555	40	3564
Molly Picklum	Women	211,155	37	5707
Caroline Marks	Women	209,010	42	4976
Gabriela Bryan	Women	195,680	41	4773
Tyler Wright	Women	189,105	39	4849
Caitlin Simmers	Women	180,110	31	5810
Tatiana Weston-Webb	Women	159,680	38	4202
Lakey Peterson	Women	152,070	37	4110
Bettylou Sakura Johnson	Women	140,785	36	3911

Takeaway: A small set of athletes dominate cumulative scoring within each division — the natural shortlist for always-on sponsorship and content partnerships.

Championship Tour — trajectories over time (Plotly)

Totals hide when points were earned. This interactive chart tracks season total points for featured multi-year Championship Tour athletes. Hover any point for surfer, season, and points.

multi_season <- ct_complete %>%
  group_by(Athlete, Division) %>%
  summarise(
    seasons = n_distinct(Season),
    Total_Points = sum(Points, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  filter(seasons >= 3)

featured <- multi_season %>%
  group_by(Division) %>%
  slice_max(Total_Points, n = 4, with_ties = FALSE) %>%
  ungroup()

season_points <- ct_complete %>%
  semi_join(featured, by = c("Athlete", "Division")) %>%
  group_by(Season, Athlete, Division) %>%
  summarise(Season_Points = sum(Points, na.rm = TRUE), .groups = "drop") %>%
  mutate(
    hover = paste0(
      "<b>", Athlete, "</b><br>",
      "Season: ", Season, "<br>",
      "Points: ", comma(Season_Points)
    )
  )

men_cols <- c("#1B4F72", "#5DADE2", "#C0392B", "#E74C3C")
women_cols <- c("#F8A5C2", "#E84393", "#9B59B6", "#F1C40F")

men_athletes <- season_points %>%
  filter(Division == "Men") %>%
  pull(Athlete) %>%
  unique() %>%
  sort()

women_athletes <- season_points %>%
  filter(Division == "Women") %>%
  pull(Athlete) %>%
  unique() %>%
  sort()

names(men_cols) <- men_athletes
names(women_cols) <- women_athletes

axis_space <- theme(
  axis.title.x = element_text(margin = margin(t = 18)),
  axis.title.y = element_text(margin = margin(r = 18)),
  plot.title = element_text(face = "bold", size = 16, hjust = 0.5, color = ocean$ink),
  legend.position = "bottom",
  legend.title = element_blank()
)

p_men <- season_points %>%
  filter(Division == "Men") %>%
  ggplot(aes(
    x = Season, y = Season_Points, color = Athlete, group = Athlete,
    text = hover
  )) +
  geom_line(linewidth = 1.15) +
  geom_point(size = 2.6) +
  scale_x_continuous(breaks = 2022:2025) +
  scale_y_continuous(labels = comma) +
  scale_color_manual(values = men_cols) +
  labs(title = "Men", x = "Season", y = "Season total points") +
  theme_wsl() +
  axis_space

p_women <- season_points %>%
  filter(Division == "Women") %>%
  ggplot(aes(
    x = Season, y = Season_Points, color = Athlete, group = Athlete,
    text = hover
  )) +
  geom_line(linewidth = 1.15) +
  geom_point(size = 2.6) +
  scale_x_continuous(breaks = 2022:2025) +
  scale_y_continuous(labels = comma) +
  scale_color_manual(values = women_cols) +
  labs(title = "Women", x = "Season", y = "Season total points") +
  theme_wsl() +
  axis_space

subplot(
  ggplotly(p_men, tooltip = "text") %>% layout(legend = list(orientation = "h", y = -0.2)),
  ggplotly(p_women, tooltip = "text") %>% layout(legend = list(orientation = "h", y = -0.2)),
  nrows = 1,
  margin = 0.06,
  titleX = TRUE,
  titleY = TRUE
) %>%
  layout(
    title = list(
      text = paste0(
        "<b>Featured Athletes: Points Across Seasons</b>",
        "<br><sup>Top multi-season Championship Tour earners (2022–2025)</sup>"
      ),
      x = 0,
      xanchor = "left"
    ),
    margin = list(t = 70, b = 80)
  )

Takeaway: Rising lines signal gaining form or consistency; drops can reflect fewer deep runs, injury, or tougher fields — useful timing for campaign moments.

Championship Tour — where scoring is richest (Plotly)

Location averages show where the tour awards the most points per start (minimum 40 starts).

loc_avg <- ct_complete %>%
  filter(!is.na(Location)) %>%
  group_by(Location, Country) %>%
  summarise(
    Avg_Points = mean(Points, na.rm = TRUE),
    Starts = n(),
    Total_Points = sum(Points, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  filter(Starts >= 40) %>%
  slice_max(Avg_Points, n = 12) %>%
  mutate(Location = fct_reorder(Location, Avg_Points))

p_loc <- ggplot(
  loc_avg,
  aes(
    x = Location,
    y = Avg_Points,
    fill = Avg_Points,
    text = paste0(
      "<b>", Location, "</b><br>",
      Country, "<br>",
      "Avg points: ", round(Avg_Points, 0), "<br>",
      "Starts: ", Starts
    )
  )
) +
  geom_col(width = 0.75) +
  coord_flip() +
  scale_fill_gradient(low = "#AED6F1", high = "#1B4F72") +
  scale_y_continuous(labels = comma) +
  labs(
    title = "Average Points by Surf Location",
    subtitle = "Championship Tour, 2022–2025 (40+ athlete starts)",
    x = NULL,
    y = "Average points per start",
    fill = "Avg"
  ) +
  theme_wsl() +
  theme(legend.position = "right")

ggplotly(p_loc, tooltip = "text")

loc_avg %>%
  arrange(desc(Avg_Points)) %>%
  mutate(
    Avg_Points = round(Avg_Points, 0),
    Total_Points = comma(Total_Points)
  ) %>%
  kable(col.names = c("Location", "Country", "Avg Points", "Athlete Starts", "Total Points"))

Location	Country	Avg Points	Athlete Starts	Total Points
Cloudbreak, Tavarua	Fiji	4606	41	188,860
Jeffreys Bay, Eastern Cape	South Africa	4172	101	421,335
Saquarema, Rio de Janeiro	Brazil	4030	135	544,090
Teahupo’o, Tahiti	French Polynesia	3864	134	517,765
Punta Roca, La Libertad	El Salvador	3762	155	583,155
Sunset Beach, Oahu, Hawaii	United States	3483	133	463,190
Margaret River, Western Australia	Australia	3364	184	618,980
Supertubos, Peniche	Portugal	3362	185	621,980
Banzai Pipeline, Oahu, Hawaii	United States	3319	187	620,665
Bells Beach, Victoria	Australia	3263	184	600,405
Hudayriat Island, Abu Dhabi	United Arab Emirates	3140	52	163,275
Gold Coast, Queensland	Australia	2887	52	150,115

Takeaway: Higher average points at a break can reflect scoring formats, field depth, or deep-heat advancement. These stops are natural candidates for highlight packages and hospitality investment.

Championship Tour — placement structure

Totals and location averages show how much is scored. Placement distributions show how finishes are shaped for Men vs Women.

On the Championship Tour, athletes eliminated in the same round usually receive the same placement. Men’s events typically run a larger draw, so more results land at 17th. Women’s smaller draws concentrate finishes later. That structural difference — not raw “skill” — is the main reason the shapes differ.

place_dist <- ct %>%
  filter(!is.na(Place_Num), Season %in% 2022:2025)

place_summary <- place_dist %>%
  group_by(Division) %>%
  summarise(
    n = n(),
    Mean = mean(Place_Num),
    Median = median(Place_Num),
    Podium_Pct = mean(Place_Num <= 3) * 100,
    Exit_17_Pct = mean(Place_Num >= 17) * 100,
    Exit_9_Pct  = mean(Place_Num >= 9) * 100,
    Exit_5_Pct  = mean(Place_Num >= 5) * 100,
    .groups = "drop"
  ) %>%
  mutate(
    label_x = if_else(Division == "Men", 0.48, 2.52),
    label_hjust = if_else(Division == "Men", 1, 0),
    label_y = Median,
    label = paste0(
      "n = ", comma(n), "\n",
      "Mean = ", round(Mean, 1), "\n",
      "Median = ", Median, "\n",
      "Podium = ", round(Podium_Pct, 0), "%\n",
      "17th+ = ", round(Exit_17_Pct, 0), "%"
    )
  )

ggplot(place_dist, aes(x = Division, y = Place_Num, fill = Division)) +
  geom_violin(alpha = 0.35, color = NA, width = 0.75) +
  geom_boxplot(width = 0.20, outlier.alpha = 0.25, color = ocean$ink) +
  geom_point(
    data = place_summary,
    aes(x = Division, y = Mean),
    shape = 23, size = 3.2, fill = "white", color = ocean$ink,
    inherit.aes = FALSE
  ) +
  geom_text(
    data = place_summary,
    aes(x = label_x, y = label_y, label = label, hjust = label_hjust),
    size = 5.2, fontface = "bold", color = ocean$ink, lineheight = 1.15,
    inherit.aes = FALSE
  ) +
  scale_fill_manual(values = div_cols) +
  scale_y_reverse(breaks = c(1, 3, 5, 9, 17, 33)) +
  coord_cartesian(xlim = c(0.15, 2.85)) +
  labs(
    title = "Placement Distribution by Division",
    subtitle = "Championship Tour, 2022–2025 (1 = best). Diamond = mean.",
    x = NULL,
    y = "Placement (better finishes toward the top)",
    fill = "Division"
  ) +
  theme_wsl(base_size = 14) +
  theme(
    legend.position = "none",
    axis.title.x = element_text(margin = margin(t = 18)),
    axis.title.y = element_text(margin = margin(r = 18)),
    axis.text = element_text(size = 12)
  )

funnel_order <- c("33rd", "17th", "9th", "5th", "4th", "3rd", "2nd", "1st")

place_pct <- place_dist %>%
  count(Division, Placement, Place_Num) %>%
  group_by(Division) %>%
  mutate(Pct = n / sum(n)) %>%
  ungroup() %>%
  mutate(Placement = factor(Placement, levels = funnel_order)) %>%
  filter(!is.na(Placement))

starts_note <- place_summary %>%
  transmute(Division, note = paste0(Division, " starts: ", comma(n))) %>%
  pull(note) %>%
  paste(collapse = "   |   ")

ggplot(place_pct, aes(x = Placement, y = Pct, fill = Division)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.75) +
  geom_text(
    aes(label = percent(Pct, accuracy = 1)),
    position = position_dodge(width = 0.8),
    vjust = -0.35, size = 4, fontface = "bold", color = ocean$ink
  ) +
  scale_fill_manual(values = div_cols) +
  scale_y_continuous(labels = percent_format(accuracy = 1), expand = expansion(mult = c(0, 0.14))) +
  labs(
    title = "WSL Cutoff Funnel: Share of Results at Each Stage",
    subtitle = paste0(starts_note, "\nLeft = early exits → Right = podium"),
    x = "Placement cutoff (event order)",
    y = "Percent of division results",
    fill = "Division"
  ) +
  theme_wsl(base_size = 14) +
  theme(
    axis.title.x = element_text(margin = margin(t = 18)),
    axis.title.y = element_text(margin = margin(r = 18)),
    plot.subtitle = element_text(size = 11, lineheight = 1.2)
  )

Takeaway: Publish Men’s and Women’s metrics separately. Larger men’s draws create more early-exit placements; smaller women’s draws concentrate finishes later. Do not treat raw podium % as a pure cross-division skill comparison.

Longboard Tour — who scores and where

The same performance questions applied to Longboard (2021–2025).

lb_top_athletes <- lb_complete %>%
  group_by(Athlete, Division) %>%
  summarise(
    Total_Points = sum(Points, na.rm = TRUE),
    Events = n(),
    Avg_Points = mean(Points, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  group_by(Division) %>%
  slice_max(Total_Points, n = 8, with_ties = FALSE) %>%
  ungroup() %>%
  mutate(Athlete = fct_reorder(Athlete, Total_Points))

ggplot(lb_top_athletes, aes(x = Athlete, y = Total_Points, fill = Division)) +
  geom_col(width = 0.75) +
  coord_flip() +
  facet_wrap(~ Division, scales = "free_y") +
  scale_fill_manual(values = div_cols) +
  scale_y_continuous(labels = comma) +
  labs(
    title = "Top Longboard Tour Surfers by Total Points",
    subtitle = "Seasons 2021–2025",
    x = NULL,
    y = "Total points",
    fill = "Division"
  ) +
  theme_wsl() +
  theme(legend.position = "none")

lb_loc_avg <- lb_complete %>%
  filter(!is.na(Points), !is.na(Location)) %>%
  group_by(Location) %>%
  summarise(
    Avg_Points = mean(Points, na.rm = TRUE),
    Starts = n(),
    Total_Points = sum(Points, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  filter(Starts >= 20) %>%
  slice_max(Avg_Points, n = 12) %>%
  mutate(Location = fct_reorder(Location, Avg_Points))

ggplot(lb_loc_avg, aes(x = Location, y = Avg_Points, fill = Avg_Points)) +
  geom_col(width = 0.75) +
  coord_flip() +
  scale_fill_gradient(low = "#F8A5C2", high = "#9B59B6") +
  scale_y_continuous(labels = comma) +
  labs(
    title = "Longboard Tour: Average Points by Surf Location",
    subtitle = "Seasons 2021–2025 (locations with 20+ athlete starts)",
    x = NULL,
    y = "Average points per start",
    fill = "Avg points"
  ) +
  theme_wsl() +
  theme(legend.position = "right")

Takeaway: Longboard leaders and high-intensity stops give a second portfolio for partnerships and content — distinct from Championship Tour shortboard storylines.

Model 1 — Multiple regression

Objective: Estimate how Championship Tour event points relate to division, season, and location scoring intensity.

Variables: Dependent = Points; independent = Division, Season, Loc_Avg_Points.

Caveat: This is a descriptive association tool, not a causal claim. Location averages are endogenous to the outcomes that generate them.

m_points <- lm(
  Points ~ Division + Season + Loc_Avg_Points,
  data = ct_model
)

sm <- summary(m_points)
coef_mat <- as.data.frame(sm$coefficients)
coef_mat$term <- rownames(coef_mat)
rownames(coef_mat) <- NULL

coef_mat %>%
  transmute(
    term,
    Estimate = round(Estimate, 2),
    `Std. Error` = round(`Std. Error`, 2),
    `t value` = round(`t value`, 2),
    `Pr(>|t|)` = signif(`Pr(>|t|)`, 3)
  ) %>%
  kable(caption = "Multiple regression: Championship Tour event points")

Multiple regression: Championship Tour event points

term	Estimate	Std. Error	t value	Pr(>|t|)
(Intercept)	-375.21	478.10	-0.78	0.433
DivisionWomen	1146.26	118.37	9.68	0.000
Season2023	48.07	168.60	0.29	0.776
Season2024	-182.64	166.05	-1.10	0.272
Season2025	-165.46	158.01	-1.05	0.295
Loc_Avg_Points	1.01	0.13	8.00	0.000

cat(
  sprintf(
    "Adj. R-squared = %.3f | Residual DF = %.0f | N = %.0f\n",
    sm$adj.r.squared,
    sm$df[2],
    nobs(m_points)
  )
)

## Adj. R-squared = 0.087 | Residual DF = 1647 | N = 1653

Model 2 — Athlete segmentation (k-means)

Objective: Segment Championship Tour athletes into performance profiles using total points, average points, podium rate, and event volume (athletes with 8+ starts).

athlete_feat <- ct_complete %>%
  group_by(Athlete, Division) %>%
  summarise(
    Total_Points = sum(Points, na.rm = TRUE),
    Avg_Points = mean(Points, na.rm = TRUE),
    Events = n(),
    Podium_Rate = mean(Podium, na.rm = TRUE),
    Best_Place = min(Place_Num, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  filter(Events >= 8)

set.seed(580)
X <- athlete_feat %>%
  select(Total_Points, Avg_Points, Events, Podium_Rate) %>%
  scale()

km <- kmeans(X, centers = 3, nstart = 25)
athlete_feat$Cluster <- factor(km$cluster, labels = c("Cluster 1", "Cluster 2", "Cluster 3"))

athlete_feat %>%
  group_by(Cluster, Division) %>%
  summarise(
    Athletes = n(),
    Med_Total_Points = median(Total_Points),
    Med_Avg_Points = round(median(Avg_Points), 0),
    Med_Events = median(Events),
    Med_Podium_Rate = percent(median(Podium_Rate), accuracy = 0.1),
    .groups = "drop"
  ) %>%
  kable(caption = "K-means athlete segments (k = 3), Championship Tour completed seasons")

K-means athlete segments (k = 3), Championship Tour completed seasons

Cluster	Division	Athletes	Med_Total_Points	Med_Avg_Points	Med_Events	Med_Podium_Rate
Cluster 1	Men	19	83470.0	3008	28	11.5%
Cluster 1	Women	9	84390.0	3911	22	17.6%
Cluster 2	Men	7	167490.0	4613	41	33.3%
Cluster 2	Women	9	180110.0	4849	37	40.5%
Cluster 3	Men	12	26797.5	2296	11	0.0%
Cluster 3	Women	3	28400.0	3094	9	0.0%

Athlete segments scatter (Plotly)

p_cluster <- ggplot(
  athlete_feat,
  aes(
    x = Avg_Points,
    y = Podium_Rate,
    color = Cluster,
    size = Events,
    text = paste0(
      "<b>", Athlete, "</b> (", Division, ")<br>",
      "Cluster: ", Cluster, "<br>",
      "Avg points: ", round(Avg_Points, 0), "<br>",
      "Podium rate: ", percent(Podium_Rate, accuracy = 0.1), "<br>",
      "Events: ", Events
    )
  )
) +
  geom_point(alpha = 0.85) +
  scale_y_continuous(labels = percent_format(accuracy = 1)) +
  labs(
    title = "Athlete Segments: Average Points vs Podium Rate",
    x = "Average points per start",
    y = "Podium rate",
    color = "Cluster",
    size = "Events"
  ) +
  theme_wsl()

ggplotly(p_cluster, tooltip = "text")

Takeaway: Clusters typically separate high-volume scorers, high-efficiency podium athletes, and depth / mid-pack profiles — commercially distinct groups for partnership tiers.

Interactive decision support

The deployed Shiny app lets stakeholders explore WSL contest geography beyond static charts:

Open the WSL Tour Worldwide Event Map

Findings

1. Scoring leadership is concentrated. A small set of Championship Tour and Longboard athletes account for the largest completed-season point totals.
2. Trajectories matter as much as totals. Multi-season Plotly lines reveal peaks and dips that cumulative rankings hide — useful for form storytelling and sponsor timing.
3. Locations differ in average scoring outcomes. Higher average-point stops are natural candidates for highlight packages and hospitality investment (subject to format caveats).
4. Division placement shapes are structural. Men’s larger draws create more early-exit placements; Women’s smaller draws concentrate finishes later. Do not treat raw podium % as a pure skill comparison across divisions.
5. Regression associations. After division and season controls, location average intensity is associated with higher event points — consistent with the descriptive charts, but not proof of causality.
6. Segments are actionable. K-means profiles separate athletes into commercially distinct groups for always-on vs campaign partnerships.
7. The Shiny map extends the report for geographic exploration by decision makers.

Managerial Recommendations

1. Sponsor / partnership targeting: Prioritize high-scoring / high-podium cluster athletes for always-on partnerships; use rising-trajectory athletes for campaign moments.
2. Content and media: Build location-based storylines around high average-point stops and season inflection points visible in the Plotly trajectories.
3. Event portfolio review: Compare low- vs high-intensity stops when allocating broadcast minutes, creator coverage, and on-site activations.
4. Gender-aware reporting: Publish Men’s and Women’s metrics separately and explain draw-size effects so stakeholders do not misread placement distributions.
5. Decision support: Keep the Shiny event map linked in stakeholder decks; use this report for methods, models, and recommendations.
6. Tour portfolio balance: Treat Championship Tour and Longboard as complementary storytelling lanes — different leaders, locations, and audience hooks.

Limitations and Future Research

Data limitations

• Compiled Excel warehouse. Results are only as current and complete as the workbook refresh process; this project does not use a live automated API pull as the primary pipeline.
• Incomplete seasons. Championship Tour 2026 is incomplete and excluded from cumulative and model inputs.
• Format confounding. Placement distributions differ by division largely because of draw size and elimination structure.
• Endogenous location metrics. Location average points are calculated from the same outcomes used in regression — treat coefficients as associative, not causal.
• Project scope. This Capstone centers on WSL performance, location, and decision-support analytics. It does not include a class survey.
• External validity. Insights are specific to WSL Championship and Longboard tours in the covered seasons.

Future research

1. Automate workbook refresh via approved public sources (httr / jsonlite or permitted rvest).
2. Add sentiment or text mining on social or news coverage of featured athletes and stops.
3. Compare model families (e.g., logistic podium models, hierarchical athlete effects).
4. Extend the Shiny app with filters for season, division, and cluster membership tied to this report’s segments.

Session info

sessionInfo()

## R version 4.6.1 (2026-06-24)
## Platform: aarch64-apple-darwin23
## Running under: macOS Tahoe 26.5.2
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.6/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.6/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.1
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: America/Los_Angeles
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] plotly_4.12.1 knitr_1.51    scales_1.4.0  ggplot2_4.0.3 forcats_1.0.1
## [6] stringr_1.6.0 tidyr_1.3.2   dplyr_1.2.1   readxl_1.5.0 
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.6       jsonlite_2.0.0     compiler_4.6.1     tidyselect_1.2.1  
##  [5] jquerylib_0.1.4    yaml_2.3.12        fastmap_1.2.0      R6_2.6.1          
##  [9] labeling_0.4.3     generics_0.1.4     htmlwidgets_1.6.4  tibble_3.3.1      
## [13] RColorBrewer_1.1-3 bslib_0.11.0       pillar_1.11.1      rlang_1.2.0       
## [17] cachem_1.1.0       stringi_1.8.7      xfun_0.59          S7_0.2.2          
## [21] sass_0.4.10        otel_0.2.0         viridisLite_0.4.3  cli_3.6.6         
## [25] withr_3.0.3        magrittr_2.0.5     crosstalk_1.2.2    digest_0.6.39     
## [29] grid_4.6.1         rstudioapi_0.19.0  lifecycle_1.0.5    vctrs_0.7.3       
## [33] data.table_1.18.4  evaluate_1.0.5     glue_1.8.1         farver_2.1.2      
## [37] cellranger_1.1.0   httr_1.4.8         rmarkdown_2.31     purrr_1.2.2       
## [41] tools_4.6.1        pkgconfig_2.0.3    htmltools_0.5.9

Knit tip: In RStudio, set the working directory to JeffsSurfFinal/, ensure WSL_Combined_All_Tours_READY.xlsx is in data/ (or another path the locator finds), then Knit → HTML and publish to RPubs.