---
title: "2025 Women's Soccer Performance Dashboard"
output:
flexdashboard::flex_dashboard:
source_code: embed
orientation: rows
vertical_layout: fill
theme: bootstrap
self_contained: true
---
```{r setup, include=FALSE}
library(flexdashboard)
library(crosstalk)
library(plotly)
library(DT)
library(dplyr)
library(ggplot2)
library(tidyverse)
library(janitor)
library(lubridate)
library(slider)
library(pdftools)
# --- 2025 DASHBOARD SETUP ---
# Reading verbatim files as specified
df_raw <- read_csv("eos1.csv") %>% clean_names()
df_results <- read_csv("WSoccResults.csv") %>% clean_names()
process_pdf <- function(path) {
d <- mdy(str_replace_all(basename(path), "[_.pdf]", "-"))
txt <- pdf_text(path) %>% str_split("\n") %>% unlist() %>% str_squish()
su_start <- which(str_detect(str_to_upper(txt), "SEATTLE U - STARTERS"))[1]
if (is.na(su_start)) return(NULL)
su_section <- txt[su_start:(min(su_start + 80, length(txt)))]
tibble(line = su_section) %>%
filter(str_detect(line, "\\d{1,2}:\\d{2}$")) %>%
mutate(
athlete_name_raw = str_trim(str_extract(line, "(?<=\\d\\s)[A-Za-z'.\\s]+(?=\\s\\d)")),
minutes = as.numeric(ms(str_extract(line, "\\d{1,2}:\\d{2}$"))) / 60,
start_date = d,
join_name = str_to_lower(athlete_name_raw)
) %>%
filter(!is.na(athlete_name_raw), !str_detect(athlete_name_raw, "Total")) %>%
select(join_name, minutes, start_date)
}
box_score_folder <- "box_scores"
if (!dir.exists(box_score_folder)) dir.create(box_score_folder)
pdf_files <- list.files(path = box_score_folder, pattern = "\\.pdf$", full.names = TRUE)
df_minutes <- map_df(pdf_files, process_pdf)
roster_map <- data.frame(
athlete_name = c(
"Abbie Mai", "Alana Lamb", "Amira Lyons", "Anica Carpenter", "Ashley Wright",
"Bella Bonnett", "Caroline Penner", "Emma Sanchez", "Emma de la Cruz", "Evalani Keawekane",
"Imani Newby", "Jaelyn Byeman", "Jai Thompson", "Juju Barker", "Kailee Wilson",
"Kassidy Kirgan", "Katie Piburn", "Kyla Brakefield", "Kyla Schuster", "Leila Leano",
"Lina Barnecut", "Marla Gaudlitz", "Myah Polzin", "Peyton Yohler", "Rachel Remnet",
"Sofia Deremiah", "Sona Lamarre", "Sophie Hanson", "Sydnee Smith", "Taylor Marks",
"U'I Kaaihue", "Zoe Hopkins"
),
unit = c(
"Midfielders", "Defenders", "Defenders", "Goalkeepers", "Defenders",
"Midfielders", "Midfielders", "Defenders", "Forwards", "Defenders",
"Defenders", "Defenders", "Forwards", "Defenders", "Forwards",
"Goalkeepers", "Midfielders", "Defenders", "Midfielders", "Midfielders",
"Midfielders", "Midfielders", "Forwards", "Defenders", "Goalkeepers",
"Midfielders", "Forwards", "Forwards", "Defenders", "Defenders",
"Midfielders", "Forwards"
)
)
# --- REFINED CLEANING PIPELINE ---
df_clean <- df_raw %>%
mutate(
# Handle the 'Group' field which often contains both Date and Athlete Name
start_date = mdy(coalesce(start_date, str_extract(group, "\\d{2}/\\d{2}/\\d{4}"))),
athlete_name = coalesce(athlete_name, str_trim(str_extract(group, "[^>]+$"))),
join_name = str_to_lower(str_trim(athlete_name)),
# Session Classification
session_type = case_when(
str_detect(tags, "2-md-0") ~ "Match Session",
str_detect(tags, "2-md-" ) ~ "Training Session",
TRUE ~ "Training Session"),
# Extract Taper Day (MD-2, MD-1, etc.)
taper_day = str_extract(tags, "(?i)md-[0-2]") %>% str_to_lower()
) %>%
filter(!is.na(start_date), session_load > 20) %>%
left_join(roster_map, by = "athlete_name") %>%
left_join(df_minutes, by = c("join_name", "start_date")) # From PDF processing
# ── Build master data frame ────────────────────────────────────────────────────
# --- BUILD MASTER DATA FRAME ---
df_master <- df_clean %>%
arrange(athlete_name, start_date) %>%
group_by(athlete_name) %>%
mutate(
rolling_avg_28 = slide_index_dbl(
session_load, .i = start_date,
.f = ~mean(.x, na.rm = TRUE),
.before = days(28)),
load_status = case_when(
session_load > (rolling_avg_28 * 1.2) ~ "High",
session_load < (rolling_avg_28 * 0.7) ~ "Below",
TRUE ~ "Normal"),
# Metric Calculations
no_of_hi = as.numeric(no_of_high_intensity_events),
hi_density = no_of_hi / (as.numeric(distance_yds) / 1000),
row_key = paste0(athlete_name, "_", row_number())
) %>%
ungroup()
df_master <- df_master %>%
select(athlete_name, unit, start_date, session_load, rolling_avg_28, load_status,
no_of_hi, hi_density, top_speed_mph, session_type, taper_day, row_key)
n_athletes <- n_distinct(df_master$athlete_name)
avg_load_all <- round(mean(df_master$session_load, na.rm = TRUE), 1)
# Initialize Crosstalk
shared_df <- SharedData$new(df_master, key = ~row_key, group = "Wsoccer2025")
```
## Sidebar {.sidebar data-width="300"}
### Dashboard Filters
<br>
```{r filters}
filter_slider(
id = "date_range",
label = "Select Date Range",
sharedData = shared_df,
column = ~start_date,
width = "100%"
)
filter_select(
id = "unit",
label = "Position Group",
sharedData = shared_df,
group = ~unit
)
filter_checkbox(
id = "session_type",
label = "Session Type",
sharedData = shared_df,
group = ~session_type,
inline = FALSE
)
```
------------------------------------------------------------------------
### Key Metrics
- **Load Status** — compared with 28-day rolling average
- **HI Events** — moments of high-intensity activity
- **Density** — intensity per 1,000 yards
- **Value boxes** reflect the full unfiltered dataset
## Row {data-height="20"}
### Total Athletes Tracked
```{r vbox_athletes}
valueBox(n_athletes, icon = "fa-users")
```
### Average Session Load (All Sessions)
```{r vbox_load}
valueBox(avg_load_all, icon = "fa-tachometer-alt")
```
## Row {.tabset .tabset-fade data-height="800"}
### Daily Load by Athlete
```{r plot_load}
plot_ly(shared_df) %>%
add_bars(
x = ~session_load,
y = ~athlete_name,
color = ~load_status, # Legend now splits by status automatically
colors = c("High" = "#990000", "Normal" = "#1a1a1a", "Below" = "#808080"),
orientation = "h",
text = ~paste0("Athlete: ", athlete_name, "<br>Load: ", session_load),
hoverinfo = "text"
) %>%
layout(
barmode = "stack", # Changed from 'overlay' to prevent bars hiding each other
title = "2025 Athlete Load Status",
xaxis = list(title = "Session Load"),
yaxis = list(title = "", categoryorder = "total ascending"),
legend = list(
title = list(text = "<b>Load Status</b>"),
orientation = "h",
x = 0.5,
xanchor = "center",
y = -0.2
),
margin = list(l = 150)
)
```
### Intensity Density (HI Events per 1,000 Yards)
```{r plot_density}
plot_ly(shared_df, x = ~taper_day, y = ~hi_density, color = ~taper_day,
colors = c("md-0" = "#990000", "md-1" = "#444444", "md-2" = "#000000"),
type = "box", boxpoints = "all", jitter = 0.3) %>%
layout(xaxis = list(title = "Days to Match", categoryorder = "array",
categoryarray = c("md-2", "md-1", "md-0")))
```
## Row
### Session Summary Table
```{r table}
datatable(
shared_df,
extensions = c("Scroller", "Buttons"),
options = list(
dom = "Bfrtip",
buttons = list("csv", "excel"),
scrollY = 300,
scroller = TRUE,
columnDefs = list(list(visible = FALSE, targets = c(7, 8, 9)))
),
colnames = c(
"Athlete" = "athlete_name",
"Unit" = "unit",
"Date" = "start_date",
"Load" = "session_load",
"28d Avg" = "rolling_avg_28",
"HI Density" = "hi_density",
"Top Speed (mph)" = "top_speed_mph"
),
rownames = FALSE
) %>%
formatRound(c("28d Avg", "HI Density"), digits = 1) %>%
formatRound("Top Speed (mph)", digits = 2)
```