#########################
# app.R (robust against 10000-byte selectInput error)
#########################
library(shiny)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(purrr)
library(scales)
##
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
##
## discard
library(stringr)
library(DT)
##
## Attaching package: 'DT'
## The following objects are masked from 'package:shiny':
##
## dataTableOutput, renderDataTable
library(tibble)
### -------------------------------------------------
### 1. Helpers
### -------------------------------------------------
sanitize_names <- function(df) {
bad <- (names(df) == "") | is.na(names(df))
names(df)[bad] <- NA
names(df) <- make.names(names(df), unique = TRUE)
df
}
getcol <- function(df, nm_vec, default = NA_real_) {
hit <- nm_vec[nm_vec %in% names(df)]
if (length(hit) == 0) {
return(rep(default, nrow(df)))
} else {
return(df[[hit[1]]])
}
}
per60 <- function(x, toi_minutes){
ifelse(toi_minutes > 0 & !is.na(toi_minutes), x / toi_minutes * 60, 0)
}
percentile_rank <- function(x) rank(x, ties.method = "average") / length(x)
GOALS_PER_WIN <- 5.3
normalize_name <- function(x) {
x %>%
tolower() %>%
stringr::str_replace_all("[\\.'`,]", "") %>%
stringr::str_replace_all("\\s+", " ") %>%
stringr::str_trim()
}
### -------------------------------------------------
### 1.1 Team + position normalization
### -------------------------------------------------
team_lookup <- tibble(
abbrev = c(
"ANA","ARI","BOS","BUF","CGY","CAR","CHI","COL","CBJ","DAL","DET","EDM",
"FLA","LAK","MIN","MTL","NSH","NJD","NYI","NYR","OTT","PHI","PIT","SJS",
"SEA","STL","TBL","TOR","VAN","VGK","WSH","WPG","UTA"
),
pretty_name = c(
"Anaheim Ducks","Arizona Coyotes","Boston Bruins","Buffalo Sabres","Calgary Flames",
"Carolina Hurricanes","Chicago Blackhawks","Colorado Avalanche","Columbus Blue Jackets",
"Dallas Stars","Detroit Red Wings","Edmonton Oilers","Florida Panthers","Los Angeles Kings",
"Minnesota Wild","Montréal Canadiens","Nashville Predators","New Jersey Devils",
"New York Islanders","New York Rangers","Ottawa Senators","Philadelphia Flyers",
"Pittsburgh Penguins","San Jose Sharks","Seattle Kraken","St. Louis Blues",
"Tampa Bay Lightning","Toronto Maple Leafs","Vancouver Canucks","Vegas Golden Knights",
"Washington Capitals","Winnipeg Jets","Utah Mammoth"
)
)
team_alias_map <- c(
"NJ" = "NJD","N.J" = "NJD","NJD" = "NJD","NEW JERSEY DEVILS" = "NJD",
"UTA" = "UTA","UTAH MAMMOTH" = "UTA","UTAH" = "UTA",
"SJ" = "SJS","S.J" = "SJS","SJS" = "SJS","SAN JOSE SHARKS" = "SJS","SAN JOSE" = "SJS",
"ST" = "STL","STL" = "STL","ST. LOUIS BLUES" = "STL","ST LOUIS BLUES" = "STL",
"ST. LOUIS" = "STL","ST LOUIS" = "STL",
"MON" = "MTL","MONTRÉAL CANADIENS" = "MTL","MONTREAL CANADIENS" = "MTL",
"MONTREAL" = "MTL","MONTRÉAL" = "MTL","MTL" = "MTL",
"LA" = "LAK","L.A" = "LAK","LAK" = "LAK","LOS ANGELES KINGS" = "LAK","LOS ANGELES" = "LAK",
"TB" = "TBL","T.B" = "TBL","TBL" = "TBL","TAMPA BAY LIGHTNING" = "TBL","TAMPA BAY" = "TBL"
)
canonicalize_team <- function(team_str) {
team_str <- as.character(team_str)
purrr::map_chr(team_str, function(x_raw){
x_clean <- x_raw %>% stringr::str_trim()
x_up <- toupper(x_clean)
if (x_up %in% team_lookup$abbrev) return(x_up)
if (x_up %in% names(team_alias_map)) return(team_alias_map[[x_up]])
hit_idx <- match(
tolower(x_clean),
tolower(team_lookup$pretty_name)
)
if (!is.na(hit_idx)) return(team_lookup$abbrev[hit_idx])
guess <- stringr::str_extract(x_up, "[A-Z]{2,4}")
if (!is.na(guess)) {
if (guess %in% names(team_alias_map)) return(team_alias_map[[guess]])
if (guess %in% team_lookup$abbrev) return(guess)
}
substr(x_up, 1, 3)
})
}
pretty_from_abbrev <- function(abbrev_vec){
out <- team_lookup$pretty_name[ match(abbrev_vec, team_lookup$abbrev) ]
ifelse(is.na(out), abbrev_vec, out)
}
pos_bucket <- function(pos_raw) {
pos_raw <- toupper(as.character(pos_raw))
dplyr::case_when(
pos_raw %in% c("C","CTR","CENTER") ~ "Center",
pos_raw %in% c("LW","L","LEFT WING","LEFTWING") ~ "Left Wing",
pos_raw %in% c("RW","R","RIGHT WING","RIGHTWING") ~ "Right Wing",
pos_raw %in% c("D","LD","RD","DEF","DEFENSE","DEFENCE","DEFENSEMAN","DEFENCEMAN","DEFENSEMEN") ~ "Defenseman",
pos_raw %in% c("F","FWD","FORWARD") ~ "Forward",
TRUE ~ pos_raw
)
}
### -------------------------------------------------
### 2. Load CSVs
### -------------------------------------------------
ev_ind_raw <- read.csv("ev ind.csv", check.names = FALSE, stringsAsFactors = FALSE)
ev_onice_raw <- read.csv("ev on ice.csv", check.names = FALSE, stringsAsFactors = FALSE)
pp_ind_raw <- read.csv("pp ind.csv", check.names = FALSE, stringsAsFactors = FALSE)
pp_onice_raw <- read.csv("pp on ice.csv", check.names = FALSE, stringsAsFactors = FALSE)
pk_ind_raw <- read.csv("PK ind.csv", check.names = FALSE, stringsAsFactors = FALSE)
pk_onice_raw <- read.csv("PK on ice.csv", check.names = FALSE, stringsAsFactors = FALSE)
games_raw <- read.csv("games.csv", check.names = FALSE, stringsAsFactors = FALSE)
player_bio_raw <- read.csv("Player Bios.csv", check.names = FALSE, stringsAsFactors = FALSE)
ev_ind_raw <- sanitize_names(ev_ind_raw)
ev_onice_raw <- sanitize_names(ev_onice_raw)
pp_ind_raw <- sanitize_names(pp_ind_raw)
pp_onice_raw <- sanitize_names(pp_onice_raw)
pk_ind_raw <- sanitize_names(pk_ind_raw)
pk_onice_raw <- sanitize_names(pk_onice_raw)
games_raw <- sanitize_names(games_raw)
player_bio_raw <- sanitize_names(player_bio_raw)
### -------------------------------------------------
### 3. Clean skater stats
### -------------------------------------------------
clean_ind <- function(df, strength_label){
out <- df %>%
mutate(
Player = getcol(df, c("Player","player","Name","Skater"), NA_character_),
Team = getcol(df, c("Team","team","Tm"), NA_character_),
Position = getcol(df, c("Position","Pos"), NA_character_),
Age = getcol(df, c("Age","age","Player.Age","Player_Age"), NA_real_),
GP = getcol(df, c("GP","Games.Played","GP.x"), NA_real_),
TOI = getcol(df, c("TOI","TOI.minutes","TOI_min","TOI.Total"), NA_real_),
Goals = getcol(df, c("Goals","G"), 0),
Assists = getcol(df, c("Total.Assists","Assists","A"), 0),
Points = getcol(df, c("Total.Points","Points","P"), 0),
Shots = getcol(df, c("Shots","S","Shot.Attempts"), 0),
ixG = getcol(df, c("ixG","ixG.Total","ixG_all","ixG_total"), 0),
xA_like = getcol(df, c("xA","xA_total","Exp.Assists","Expected.Assists",
"Primary.Assists","Primary.Assists.Total"), 0),
Entries_Controlled = getcol(df, c("Controlled.Entries",
"Entries.Controlled",
"Zone.Entries.Controlled",
"ControlledEntries"), 0),
Exits_Controlled = getcol(df, c("Controlled.Exits",
"Zone.Exits.Controlled",
"ControlledExits"), 0),
Possession_Wins = getcol(df, c("Puck.Retrievals",
"Successful.Zone.Exits.With.Control",
"OZ.Recoveries",
"DZ.Exits.With.Possession",
"Takeaways"), 0),
Penalties.Drawn = getcol(df, c("Penalties.Drawn","PenaltiesDrawn"), 0),
Penalties.Taken = getcol(df, c("Total.Penalties","Penalties.Taken",
"PenaltiesAgainst"), 0),
strength = strength_label
) %>%
select(Player, Team, Position, Age, GP, TOI,
Goals, Assists, Points, Shots, ixG,
xA_like,
Entries_Controlled, Exits_Controlled, Possession_Wins,
Penalties.Drawn, Penalties.Taken,
strength)
sanitize_names(out)
}
clean_onice <- function(df, strength_label){
out <- df %>%
mutate(
Player = getcol(df, c("Player","player","Name","Skater"), NA_character_),
Team = getcol(df, c("Team","team","Tm"), NA_character_),
Position = getcol(df, c("Position","Pos"), NA_character_),
GP = getcol(df, c("GP","Games.Played","GP.x"), NA_real_),
TOI = getcol(df, c("TOI","TOI.minutes","TOI_min","TOI.Total"), NA_real_),
xGF = getcol(df, c("xGF","xGF.Total","Expected.Goals.For"), 0),
xGA = getcol(df, c("xGA","xGA.Total","Expected.Goals.Against"), 0),
PossessionMetric = getcol(df, c("CF...","CF.","CF.Percent.Rel",
"xGF.","xGF.Rel","CFRel","xGFRel"), NA_real_),
strength = strength_label
) %>%
select(Player, Team, Position, GP, TOI,
xGF, xGA, PossessionMetric,
strength)
out$PossessionMetric <- suppressWarnings(
as.numeric(gsub("[^0-9.-]", "", out$PossessionMetric))
)
sanitize_names(out)
}
ev_ind_c <- clean_ind(ev_ind_raw, "EV")
pp_ind_c <- clean_ind(pp_ind_raw, "PP")
pk_ind_c <- clean_ind(pk_ind_raw, "PK")
ev_on_c <- clean_onice(ev_onice_raw, "EV")
pp_on_c <- clean_onice(pp_onice_raw, "PP")
pk_on_c <- clean_onice(pk_onice_raw, "PK")
### -------------------------------------------------
### 4. Merge per-strength data
### -------------------------------------------------
by_strength_ind <- bind_rows(ev_ind_c, pp_ind_c, pk_ind_c)
by_strength_onice <- bind_rows(ev_on_c, pp_on_c, pk_on_c)
by_strength_all <- by_strength_ind %>%
left_join(
by_strength_onice,
by = c("Player","Team","Position","GP","TOI","strength"),
suffix = c("", ".onice")
) %>%
filter(!is.na(TOI), TOI > 0)
### -------------------------------------------------
### 5. Per-60 stats
### -------------------------------------------------
by_strength_rates <- by_strength_all %>%
mutate(
TOI60 = TOI / 60,
xGF60 = per60(xGF, TOI),
xGA60 = per60(xGA, TOI),
xA60 = per60(xA_like, TOI),
Entry60 = per60(Entries_Controlled, TOI),
Exit60 = per60(Exits_Controlled, TOI),
Trans60 = 0.6 * Entry60 + 0.4 * Exit60,
Poss60 = per60(Possession_Wins, TOI),
Fin60 = per60(Goals - ixG, TOI)
)
### -------------------------------------------------
### 6. Replacement baselines
### -------------------------------------------------
repl_off <- by_strength_rates %>%
group_by(strength) %>%
summarise(repl_xGF60 = quantile(xGF60, probs = 0.20, na.rm = TRUE), .groups="drop")
repl_def <- by_strength_rates %>%
group_by(strength) %>%
summarise(repl_xGA60 = quantile(xGA60, probs = 0.80, na.rm = TRUE), .groups="drop")
repl_play <- by_strength_rates %>%
group_by(strength) %>%
summarise(repl_xA60 = quantile(xA60, probs = 0.20, na.rm = TRUE), .groups="drop")
repl_trans <- by_strength_rates %>%
group_by(strength) %>%
summarise(repl_Trans60 = quantile(Trans60, probs = 0.20, na.rm = TRUE), .groups="drop")
repl_fin <- by_strength_rates %>%
group_by(strength) %>%
summarise(repl_Fin60 = quantile(Fin60, probs = 0.20, na.rm = TRUE), .groups="drop")
repl_poss <- by_strength_rates %>%
group_by(strength) %>%
summarise(repl_Poss60 = quantile(Poss60, probs = 0.20, na.rm = TRUE), .groups="drop")
by_strength_rates <- by_strength_rates %>%
left_join(repl_off, by="strength") %>%
left_join(repl_def, by="strength") %>%
left_join(repl_play, by="strength") %>%
left_join(repl_trans, by="strength") %>%
left_join(repl_fin, by="strength") %>%
left_join(repl_poss, by="strength")
### -------------------------------------------------
### 7. GAR components
### -------------------------------------------------
by_strength_rates <- by_strength_rates %>%
mutate(
GAR_EVoff_raw = (xGF60 - repl_xGF60) * TOI60,
GAR_EVdef_raw = (repl_xGA60 - xGA60) * TOI60,
GAR_Playmaking_raw = (xA60 - repl_xA60) * TOI60,
GAR_Trans_raw = (Trans60 - repl_Trans60) * TOI60,
GAR_Finish_raw = (Fin60 - repl_Fin60) * TOI60,
GAR_PP_raw = ifelse(strength == "PP",
(xGF60 - repl_xGF60) * TOI60, 0),
GAR_PK_raw = ifelse(strength == "PK",
(repl_xGA60 - xGA60) * TOI60, 0),
GAR_Poss_raw = (Poss60 - repl_Poss60) * TOI60,
GAR_Pen_raw = 0.15 * (Penalties.Drawn - Penalties.Taken)
)
### -------------------------------------------------
### 8. Player totals + WAR
### -------------------------------------------------
player_totals <- by_strength_rates %>%
group_by(Player, Team, Position, Age) %>%
summarise(
GP = max(GP, na.rm = TRUE),
TOI_total = sum(TOI, na.rm = TRUE),
Goals = sum(Goals, na.rm = TRUE),
Assists = sum(Assists, na.rm = TRUE),
Points = sum(Points, na.rm = TRUE),
Shots = sum(Shots, na.rm = TRUE),
ixG_total = sum(ixG, na.rm = TRUE),
GAR_EVoff = sum(GAR_EVoff_raw[strength == "EV"], na.rm = TRUE),
GAR_EVdef = sum(GAR_EVdef_raw[strength == "EV"], na.rm = TRUE),
GAR_Playmaking= sum(GAR_Playmaking_raw, na.rm = TRUE),
GAR_Trans = sum(GAR_Trans_raw, na.rm = TRUE),
GAR_Finish = sum(GAR_Finish_raw, na.rm = TRUE),
GAR_PP = sum(GAR_PP_raw, na.rm = TRUE),
GAR_PK = sum(GAR_PK_raw, na.rm = TRUE),
GAR_Poss = sum(GAR_Poss_raw, na.rm = TRUE),
GAR_Pen = sum(GAR_Pen_raw, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
GAR_SpecialTeams = GAR_PP + GAR_PK,
GAR_ReplTax = -0.025 * TOI_total,
GAR_total = GAR_EVoff +
GAR_EVdef +
GAR_Playmaking +
GAR_Trans +
GAR_Finish +
GAR_SpecialTeams +
GAR_Poss +
GAR_Pen +
GAR_ReplTax,
WAR_total = GAR_total / GOALS_PER_WIN,
WAR_off = (GAR_EVoff +
GAR_Playmaking +
GAR_Trans +
GAR_Finish +
GAR_PP) / GOALS_PER_WIN,
WAR_def = (GAR_EVdef +
GAR_PK +
GAR_Poss) / GOALS_PER_WIN,
WAR_st = (GAR_SpecialTeams) / GOALS_PER_WIN
) %>%
mutate(
pct_total = percentile_rank(WAR_total),
pct_off = percentile_rank(WAR_off),
pct_def = percentile_rank(WAR_def),
pct_st = percentile_rank(WAR_st),
PosBucket = pos_bucket(Position),
TeamAbbrev = canonicalize_team(Team),
TeamNameFull = pretty_from_abbrev(TeamAbbrev),
NormName = normalize_name(Player)
)
### -------------------------------------------------
### 9. Bios prep and merge
### -------------------------------------------------
bios_clean <- player_bio_raw %>%
mutate(
Player_raw = getcol(player_bio_raw, c("Player"), NA_character_),
Team_raw = getcol(player_bio_raw, c("Team","Tm","Team.Name","Team Name"), NA_character_),
Position_raw = getcol(player_bio_raw, c("Position","Pos"), NA_character_),
Age_raw = getcol(player_bio_raw, c("Age","Player.Age","AgeYears"), NA_real_),
Date_of_Birth_raw = getcol(player_bio_raw, c("Date of Birth","DOB"), NA_character_),
Birth_City_raw = getcol(player_bio_raw, c("Birth City","Birth.City"), NA_character_),
Birth_State_raw = getcol(player_bio_raw, c("Birth State/Province","Birth State","Birth.State.Province"), NA_character_),
Birth_Country_raw = getcol(player_bio_raw, c("Birth Country","Birth.Country"), NA_character_),
Height_in_raw = getcol(player_bio_raw, c("Height (in)","Height..in."), NA_real_),
Weight_lbs_raw = getcol(player_bio_raw, c("Weight (lbs)","Weight..lbs."), NA_real_),
Draft_Year_raw = getcol(player_bio_raw, c("Draft Year","Draft.Year"), NA_character_),
Draft_Team_raw = getcol(player_bio_raw, c("Draft Team","Draft.Team"), NA_character_),
Draft_Round_raw = getcol(player_bio_raw, c("Draft Round","Draft.Round"), NA_character_),
Overall_Pick_raw = getcol(player_bio_raw, c("Overall Draft Position","Overall.Draft.Position","Overall Pick","OverallPick"), NA_character_)
) %>%
mutate(
TeamAbbrev = canonicalize_team(Team_raw),
NormName = normalize_name(Player_raw)
) %>%
# Truncate any insanely long strings so they can't poison Shiny
mutate(across(where(is.character), ~ ifelse(nchar(.) > 200, substr(.,1,200), .))) %>%
select(
NormName,
TeamAbbrev,
Team_raw,
Position_raw,
Age_raw,
Date_of_Birth_raw,
Birth_City_raw,
Birth_State_raw,
Birth_Country_raw,
Height_in_raw,
Weight_lbs_raw,
Draft_Year_raw,
Draft_Team_raw,
Draft_Round_raw,
Overall_Pick_raw
)
player_totals <- player_totals %>%
left_join(
bios_clean,
by = c("NormName","TeamAbbrev")
) %>%
mutate(
Age = ifelse(is.na(Age) & !is.na(Age_raw), Age_raw, Age)
)
## Warning in left_join(., bios_clean, by = c("NormName", "TeamAbbrev")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 201 of `x` matches multiple rows in `y`.
## ℹ Row 201 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.
### -------------------------------------------------
### 10. Team summary
### -------------------------------------------------
games_team_raw <- games_raw %>%
mutate(
raw_team_name = getcol(games_raw, c("Team","team","Tm","Team.Name"), NA_character_),
Wins_raw = getcol(games_raw, c("W","Win","Wins"), 0),
Losses_raw = getcol(games_raw, c("L","Loss","Losses"), 0),
OTL_raw = getcol(games_raw, c("OTL","OT_Loss","OTLoss","SO_Loss","Shootout.Loss"), 0),
GF_raw = getcol(games_raw, c("GF","Goals.For","GoalsFor","Goals_For"), 0),
GA_raw = getcol(games_raw, c("GA","Goals.Against","GoalsAgainst","Goals_Against"), 0),
TeamAbbrev = canonicalize_team(raw_team_name)
)
games_team <- games_team_raw %>%
group_by(TeamAbbrev) %>%
summarise(
Wins = sum(Wins_raw, na.rm = TRUE),
Losses = sum(Losses_raw, na.rm = TRUE),
OTL = sum(OTL_raw, na.rm = TRUE),
Games_Played_Team = n(),
Goals_For = sum(GF_raw, na.rm = TRUE),
Goals_Against = sum(GA_raw, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
Goal_Diff = Goals_For - Goals_Against,
Points = (2 * Wins) + (1 * OTL)
)
war_team <- player_totals %>%
group_by(TeamAbbrev) %>%
summarise(
WAR_Total = sum(WAR_total, na.rm = TRUE),
WAR_Off_Total = sum(WAR_off, na.rm = TRUE),
WAR_Def_Total = sum(WAR_def, na.rm = TRUE),
WAR_ST_Total = sum(WAR_st, na.rm = TRUE),
.groups = "drop"
)
team_summary <- full_join(
games_team,
war_team,
by = "TeamAbbrev"
) %>%
mutate(
TeamNameFull = pretty_from_abbrev(TeamAbbrev),
WAR_Total = round(WAR_Total, 2),
WAR_Off_Total = round(WAR_Off_Total, 2),
WAR_Def_Total = round(WAR_Def_Total, 2),
WAR_ST_Total = round(WAR_ST_Total, 2)
) %>%
select(
TeamAbbrev,
TeamNameFull,
Games_Played_Team,
Wins, Losses, OTL, Points,
Goals_For, Goals_Against, Goal_Diff,
WAR_Total, WAR_Off_Total, WAR_Def_Total, WAR_ST_Total
) %>%
group_by(TeamAbbrev, TeamNameFull) %>%
summarise(
Games_Played_Team = max(Games_Played_Team, na.rm = TRUE),
Wins = sum(Wins, na.rm = TRUE),
Losses = sum(Losses, na.rm = TRUE),
OTL = sum(OTL, na.rm = TRUE),
Points = sum(Points, na.rm = TRUE),
Goals_For = sum(Goals_For, na.rm = TRUE),
Goals_Against = sum(Goals_Against, na.rm = TRUE),
Goal_Diff = sum(Goal_Diff, na.rm = TRUE),
WAR_Total = sum(WAR_Total, na.rm = TRUE),
WAR_Off_Total = sum(WAR_Off_Total, na.rm = TRUE),
WAR_Def_Total = sum(WAR_Def_Total, na.rm = TRUE),
WAR_ST_Total = sum(WAR_ST_Total, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(desc(Points), desc(WAR_Total))
### -------------------------------------------------
### 11. UI
### -------------------------------------------------
# Build safe player choices for dropdown
player_choices <- player_totals %>%
mutate(Player_clean = ifelse(nchar(Player) > 200, substr(Player,1,200), Player)) %>%
pull(Player_clean) %>%
unique() %>%
sort()
pos_filter_choices <- c("Forward","Center","Left Wing","Right Wing","Defenseman")
all_teams <- sort(unique(player_totals$TeamNameFull))
ui <- fluidPage(
tags$head(
tags$style(HTML("
body {
background-color: #0f172a;
font-family: -apple-system, BlinkMacSystemFont, 'Inter', 'Segoe UI', Roboto, 'Helvetica Neue', Arial, sans-serif;
color: #f8fafc;
}
.container-main {
max-width: 1400px;
margin: 0 auto;
padding: 24px 24px 80px 24px;
}
h2, .panel-title, .filters-title {
font-weight:600;
letter-spacing:-0.03em;
margin-top:0;
color:#ffffff;
}
.player-card {
max-width: 720px;
border-radius: 20px;
background-color:#1e293b;
box-shadow: 0 30px 80px rgba(0,0,0,0.9);
padding: 20px 24px 20px;
border: 1px solid rgba(226,232,240,0.22);
color:#f8fafc;
}
.header-row {
display:flex;
justify-content:space-between;
align-items:flex-start;
margin-bottom:12px;
}
.player-left { max-width:70%; }
.player-name {
font-size:1.25rem;
font-weight:600;
color:#ffffff;
line-height:1.2;
display:flex;
flex-wrap:wrap;
gap:6px;
align-items:baseline;
}
.pos-chip {
font-size:.7rem;
line-height:1.2;
background:#fff;
color:#0f172a;
border:1px solid #fff;
border-radius:999px;
padding:2px 8px;
font-weight:600;
white-space:nowrap;
}
.team-line {
font-size:.8rem;
font-weight:500;
color:#e2e8f0;
margin-top:4px;
}
.tag-row {
display:flex;
flex-wrap:wrap;
gap:6px;
margin-top:8px;
}
.impact-chip {
font-size:.7rem;
line-height:1.2;
background:#38bdf8;
color:#0f172a;
border:1px solid #38bdf8;
border-radius:999px;
padding:2px 8px;
font-weight:600;
white-space:nowrap;
}
.big-war-block { text-align:right; }
.big-war {
font-size:2.4rem;
font-weight:700;
line-height:1.1;
color:#38bdf8;
}
.big-war-label {
font-size:.7rem;
text-transform:uppercase;
color:#e2e8f0;
font-weight:500;
letter-spacing:.05em;
margin-top:4px;
line-height:1.2;
}
.section-header-row {
display:flex;
justify-content:space-between;
align-items:flex-end;
flex-wrap:wrap;
margin-top:16px;
margin-bottom:8px;
}
.stat-section-title {
font-size:.7rem;
text-transform:uppercase;
letter-spacing:.08em;
color:#94a3b8;
font-weight:600;
margin-bottom:0;
}
.vitals-row {
display:grid;
grid-template-columns:repeat(3,1fr);
gap:12px;
background-color:#f8fafc;
border-radius:14px;
border:1px solid #e2e8f0;
padding:12px 12px;
color:#0f172a;
}
.vitals-box-label {
color:#475569;
font-size:.65rem;
text-transform:uppercase;
letter-spacing:.08em;
font-weight:600;
margin-bottom:2px;
}
.vitals-box-val {
color:#0f172a;
font-size:.8rem;
line-height:1.3;
font-weight:600;
word-break:break-word;
}
.line-break {
height:1px;
background:rgba(226,232,240,0.4);
margin:16px 0;
}
.stat-grid-3 {
display:grid;
grid-template-columns:repeat(3,1fr);
gap:12px;
margin-bottom:16px;
}
.stat-box {
background-color:#0f172a;
color:#f8fafc;
border-radius:14px;
padding:12px;
border:1px solid rgba(226,232,240,0.3);
}
.stat-label {
font-size:.7rem;
color:#e2e8f0;
text-transform:uppercase;
letter-spacing:.05em;
font-weight:500;
margin-bottom:2px;
}
.stat-value {
font-size:1.2rem;
font-weight:600;
color:#38bdf8;
line-height:1.2;
}
.percentile {
font-size:.7rem;
font-weight:600;
color:#f8fafc;
}
.basic-stats {
display:grid;
grid-template-columns:repeat(3,1fr);
gap:16px 12px;
font-size:.9rem;
color:#f8fafc;
}
.basic-label {
color:#94a3b8;
font-size:.7rem;
text-transform:uppercase;
letter-spacing:.05em;
font-weight:500;
}
.basic-val {
font-size:1rem;
font-weight:600;
line-height:1.3;
color:#ffffff;
}
.filters-panel {
background-color:#f8fafc;
border:1px solid #cbd5e1;
border-radius:16px;
box-shadow:0 24px 60px rgba(0,0,0,0.7);
padding:16px 20px;
margin-bottom:16px;
color:#0f172a;
}
.filters-title {
font-weight:600;
font-size:1rem;
margin-bottom:12px;
color:#0f172a;
display:flex;
align-items:center;
gap:8px;
}
.filters-title:before{
content:'⚙';
font-size:0.9rem;
color:#38bdf8;
line-height:1;
}
.control-label {
color:#0f172a !important;
font-weight:600;
font-size:.7rem;
text-transform:uppercase;
letter-spacing:.05em;
}
.form-control, .selectize-input {
background-color:#ffffff !important;
color:#0f172a !important;
border:1px solid #475569 !important;
border-radius:10px !important;
font-size:.8rem !important;
min-height:34px !important;
padding-top:4px !important;
padding-bottom:4px !important;
}
.selectize-dropdown,
.selectize-dropdown .active {
background-color:#ffffff !important;
color:#0f172a !important;
}
.selectize-dropdown-content {
color:#0f172a !important;
}
table.dataTable thead th {
background-color:#1e293b !important;
color:#f8fafc !important;
border-bottom:1px solid #475569 !important;
}
table.dataTable tbody tr {
background-color:#f8fafc !important;
color:#0f172a !important;
}
table.dataTable.display tbody tr.even {
background-color:#e2e8f0 !important;
color:#0f172a !important;
}
table.dataTable tbody td {
border-top:1px solid #cbd5e1 !important;
}
.dataTables_wrapper .dataTables_filter label,
.dataTables_wrapper .dataTables_length label,
.dataTables_wrapper .dataTables_info {
color:#f8fafc !important;
}
.dataTables_wrapper .dataTables_paginate .paginate_button {
color:#38bdf8 !important;
}
"))
),
div(class="container-main",
titlePanel(
div(class="panel-title", "Complete Skater WAR Dashboard")
),
tabsetPanel(
tabPanel(
"Player Card",
br(),
sidebarLayout(
sidebarPanel(
selectInput(
"player_select",
"Player:",
choices = player_choices,
selected = player_choices[1]
),
width = 3
),
mainPanel(
uiOutput("player_card"),
width = 9
)
)
),
tabPanel(
"WAR Leaders",
br(),
div(class="filters-panel",
div(class="filters-title","Filters"),
fluidRow(
column(
width = 3,
selectInput(
"team_filter",
"Team(s):",
choices = c("All", all_teams),
selected = "All",
multiple = TRUE
)
),
column(
width = 3,
selectInput(
"pos_filter",
"Position(s):",
choices = pos_filter_choices,
selected = pos_filter_choices,
multiple = TRUE
)
),
column(
width = 2,
numericInput(
"toi_min_filter",
"Min TOI (minutes):",
value = 0,
min = 0,
step = 10
)
),
column(
width = 2,
numericInput(
"age_min_filter",
"Min Age:",
value = 0,
min = 0,
step = 1
)
),
column(
width = 2,
numericInput(
"age_max_filter",
"Max Age:",
value = 100,
min = 0,
step = 1
)
)
)
),
fluidRow(
column(
width = 12,
DTOutput("war_table")
)
)
),
tabPanel(
"Team View",
br(),
fluidRow(
column(
width = 12,
DTOutput("team_table")
)
)
)
)
)
)
### -------------------------------------------------
### 12. Server
### -------------------------------------------------
server <- function(input, output, session){
player_data <- reactive({
# match on cleaned name because dropdown might be truncated
# We'll choose the first row whose Player starts with the selected text
player_totals %>%
filter(substr(Player, 1, 200) == input$player_select |
Player == input$player_select) %>%
head(1)
})
output$player_card <- renderUI({
pdat <- player_data()
if (nrow(pdat) == 0) return(div("No data for this player"))
nm <- pdat$Player[1]
team_full <- pdat$TeamNameFull[1]
pos_disp <- pdat$PosBucket[1]
total_war <- pdat$WAR_total[1]
off_war <- pdat$WAR_off[1]
def_war <- pdat$WAR_def[1]
st_war <- pdat$WAR_st[1]
total_pct <- pdat$pct_total[1]
off_pct <- pdat$pct_off[1]
def_pct <- pdat$pct_def[1]
st_pct <- pdat$pct_st[1]
gp <- pdat$GP[1]
toi_min <- pdat$TOI_total[1]
g_tot <- pdat$Goals[1]
a_tot <- pdat$Assists[1]
p_tot <- pdat$Points[1]
shots <- pdat$Shots[1]
ixg <- pdat$ixG_total[1]
# bios raw columns, truncate to 200 chars in UI just in case
short <- function(x) {
if (is.null(x) || (length(x) == 1 && is.na(x))) return("—")
x <- as.character(x[1])
ifelse(nchar(x) > 200, paste0(substr(x,1,200),"…"), x)
}
Team_raw <- short(pdat$Team_raw[1])
Position_raw <- short(pdat$Position_raw[1])
Age_raw <- pdat$Age_raw[1]
Date_of_Birth_raw <- short(pdat$Date_of_Birth_raw[1])
Birth_City_raw <- short(pdat$Birth_City_raw[1])
Birth_State_raw <- short(pdat$Birth_State_raw[1])
Birth_Country_raw <- short(pdat$Birth_Country_raw[1])
Height_in_raw <- pdat$Height_in_raw[1]
Weight_lbs_raw <- pdat$Weight_lbs_raw[1]
Draft_Year_raw <- short(pdat$Draft_Year_raw[1])
Draft_Team_raw <- short(pdat$Draft_Team_raw[1])
Draft_Round_raw <- short(pdat$Draft_Round_raw[1])
Overall_Pick_raw <- short(pdat$Overall_Pick_raw[1])
fmt_war <- function(x) ifelse(is.finite(x), sprintf('%.2f', x), "—")
fmt_pct <- function(x) ifelse(is.finite(x), percent(x, accuracy = 1), "—")
fmt_num1 <- function(x) ifelse(is.finite(x), sprintf('%.1f', x), "—")
fmt_num0 <- function(x) ifelse(is.finite(x), sprintf('%.0f', x), "—")
div(class="player-card",
# HEADER
div(class="header-row",
div(class="player-left",
div(class="player-name",
span(nm),
if (!is.na(pos_disp)) span(class="pos-chip", pos_disp)
),
div(class="team-line",
paste0(
team_full,
" • GP ", fmt_num0(gp),
" • TOI ", fmt_num1(toi_min)," min"
)
),
div(class="tag-row",
div(class="impact-chip",
paste0("Off Impact ", fmt_pct(off_pct))
),
div(class="impact-chip",
paste0("Def Impact ", fmt_pct(def_pct))
),
div(class="impact-chip",
paste0("ST Value ", fmt_pct(st_pct))
)
)
),
div(class="big-war-block",
div(class="big-war", fmt_war(total_war)),
div(class="big-war-label",
paste0("Total WAR • ", fmt_pct(total_pct), " percentile"))
)
),
# VITALS GRID (labels exactly from CSV headers)
div(class="section-header-row",
div(class="stat-section-title","Vitals & Background")
),
div(class="vitals-row",
div(
div(class="vitals-box-label","Team"),
div(class="vitals-box-val", Team_raw)
),
div(
div(class="vitals-box-label","Position"),
div(class="vitals-box-val", Position_raw)
),
div(
div(class="vitals-box-label","Age"),
div(class="vitals-box-val",
ifelse(is.finite(Age_raw), paste0(Age_raw), "—")
)
),
div(
div(class="vitals-box-label","Date of Birth"),
div(class="vitals-box-val", Date_of_Birth_raw)
),
div(
div(class="vitals-box-label","Birth City"),
div(class="vitals-box-val", Birth_City_raw)
),
div(
div(class="vitals-box-label","Birth State/Province"),
div(class="vitals-box-val", Birth_State_raw)
),
div(
div(class="vitals-box-label","Birth Country"),
div(class="vitals-box-val", Birth_Country_raw)
),
div(
div(class="vitals-box-label","Height (in)"),
div(class="vitals-box-val",
ifelse(is.finite(Height_in_raw), paste0(Height_in_raw," in"), "—")
)
),
div(
div(class="vitals-box-label","Weight (lbs)"),
div(class="vitals-box-val",
ifelse(is.finite(Weight_lbs_raw), paste0(Weight_lbs_raw," lbs"), "—")
)
),
div(
div(class="vitals-box-label","Draft Year"),
div(class="vitals-box-val", Draft_Year_raw)
),
div(
div(class="vitals-box-label","Draft Team"),
div(class="vitals-box-val", Draft_Team_raw)
),
div(
div(class="vitals-box-label","Draft Round"),
div(class="vitals-box-val", Draft_Round_raw)
),
div(
div(class="vitals-box-label","Overall Draft Position"),
div(class="vitals-box-val", Overall_Pick_raw)
)
),
div(class="line-break"),
# VALUE BREAKDOWN
div(class="section-header-row",
div(class="stat-section-title","Value Breakdown")
),
div(class="stat-grid-3",
div(class="stat-box",
div(class="stat-label", "Offense WAR"),
div(class="stat-value", fmt_war(off_war)),
div(class="percentile", paste0(fmt_pct(off_pct), " percentile"))
),
div(class="stat-box",
div(class="stat-label", "Defense WAR"),
div(class="stat-value", fmt_war(def_war)),
div(class="percentile", paste0(fmt_pct(def_pct), " percentile"))
),
div(class="stat-box",
div(class="stat-label", "Special Teams WAR"),
div(class="stat-value", fmt_war(st_war)),
div(class="percentile", paste0(fmt_pct(st_pct), " percentile"))
)
),
div(class="line-break"),
# BOX SCORE
div(class="section-header-row",
div(class="stat-section-title","Box Score Impact")
),
div(class="basic-stats",
div(
div(class="basic-label","Goals"),
div(class="basic-val", fmt_num0(g_tot))
),
div(
div(class="basic-label","Assists"),
div(class="basic-val", fmt_num0(a_tot))
),
div(
div(class="basic-label","Points"),
div(class="basic-val", fmt_num0(p_tot))
),
div(
div(class="basic-label","Shots"),
div(class="basic-val", fmt_num0(shots))
),
div(
div(class="basic-label","ixG (all)"),
div(class="basic-val", fmt_num1(ixg))
),
div(
div(class="basic-label","TOI Total (min)"),
div(class="basic-val", fmt_num1(toi_min))
)
)
)
})
filtered_players <- reactive({
df <- player_totals
if (!("All" %in% input$team_filter) && length(input$team_filter) > 0) {
df <- df %>% filter(TeamNameFull %in% input$team_filter)
}
if (!is.null(input$pos_filter) && length(input$pos_filter) > 0) {
df <- df %>% filter(PosBucket %in% input$pos_filter)
}
df <- df %>% filter(is.na(input$toi_min_filter) | TOI_total >= input$toi_min_filter)
df <- df %>%
filter(
!is.na(Age) &
Age >= input$age_min_filter &
Age <= input$age_max_filter
)
df
})
output$war_table <- renderDT({
filtered_players() %>%
select(
Player,
Team = TeamNameFull,
Position = PosBucket,
Age,
GP, TOI_total,
Goals, Assists, Points,
WAR_total, WAR_off, WAR_def, WAR_st
) %>%
mutate(
WAR_total = round(WAR_total, 2),
WAR_off = round(WAR_off, 2),
WAR_def = round(WAR_def, 2),
WAR_st = round(WAR_st, 2),
TOI_total = round(TOI_total, 1)
) %>%
arrange(desc(WAR_total)) %>%
datatable(
rownames = FALSE,
options = list(
pageLength = 25,
autoWidth = TRUE
)
)
})
output$team_table <- renderDT({
team_summary %>%
select(
Team = TeamNameFull,
Games_Played_Team,
Wins, Losses, OTL, Points,
Goals_For, Goals_Against, Goal_Diff,
WAR_Total, WAR_Off_Total, WAR_Def_Total, WAR_ST_Total
) %>%
datatable(
rownames = FALSE,
options = list(
pageLength = 32,
autoWidth = TRUE
)
)
})
}
shinyApp(ui, server)
Shiny applications not supported in static R Markdown documents