Capstone - Complete Analytics System

# Calculate Expected Assists
library(StatsBombR)
library(dplyr)

# Load World Cup data
comps <- FreeCompetitions() %>%
  filter(competition_id == 43, season_id == 106)
matches <- FreeMatches(comps)
events <- free_allevents(MatchesDF = matches)

# Find passes that led to shots
# In StatsBomb, shots have pass info; we need to link back

# Get shots with their xG
shots <- events %>%
  filter(type.name == "Shot") %>%
  select(id, match_id, player.name, team.name, shot.statsbomb_xg,
         shot.outcome.name, shot.key_pass_id)

# Get key passes (passes leading to shots)
key_passes <- events %>%
  filter(type.name == "Pass") %>%
  select(id, match_id, player.name, team.name,
         pass.goal_assist, pass.shot_assist,
         location.x, location.y,
         pass.end_location.x, pass.end_location.y)

# Link key passes to shots
# pass.shot_assist is TRUE for passes leading to shots
shot_assists <- key_passes %>%
  filter(pass.shot_assist == TRUE | pass.goal_assist == TRUE)

# Calculate xA by player (using shots data)
# xA = sum of xG from shots created by player passes
player_xa <- shots %>%
  filter(!is.na(shot.key_pass_id)) %>%
  # Would need to join with key_passes to get passer name
  # For simplicity, we group by the shooter's team assists
  group_by(team.name) %>%
  summarise(
    chances_created = n(),
    total_xA = sum(shot.statsbomb_xg, na.rm = TRUE),
    goals_from_chances = sum(shot.outcome.name == "Goal")
  )

print("Team Chance Creation (xA):")
print(player_xa %>% arrange(desc(total_xA)))

# Detailed player xA analysis
# Using FBref-style calculation where xA = xG of shots from player passes

# Identify all pass -> shot connections
passes_to_shots <- events %>%
  filter(type.name == "Pass",
         pass.shot_assist == TRUE | pass.goal_assist == TRUE) %>%
  select(pass_id = id, passer = player.name, passer_team = team.name,
         match_id, minute,
         pass.goal_assist, pass.shot_assist,
         pass.cross, pass.through_ball, pass.cut_back)

# Match with shot xG (would need shot.key_pass_id linkage)
# For demo, we calculate key pass stats

player_creativity <- passes_to_shots %>%
  group_by(passer, passer_team) %>%
  summarise(
    matches = n_distinct(match_id),
    key_passes = n(),
    assists = sum(pass.goal_assist, na.rm = TRUE),
    crosses_to_shots = sum(pass.cross, na.rm = TRUE),
    through_balls_to_shots = sum(pass.through_ball, na.rm = TRUE),
    cutbacks_to_shots = sum(pass.cut_back, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  filter(key_passes >= 3) %>%
  mutate(
    key_passes_per_match = round(key_passes / matches, 2),
    assist_conversion = round(assists / key_passes * 100, 1)
  ) %>%
  arrange(desc(key_passes))

print("Top Chance Creators (Key Passes):")
print(head(player_creativity, 15))

# xA vs Actual Assists analysis
# When Assists >> xA, likely to regress
# When Assists << xA, bounce-back candidate

# Simulated season data (use actual xA from FBref/StatsBomb)
creator_performance <- data.frame(
  player = c("De Bruyne", "Bruno Fernandes", "Odegaard",
             "Saka", "Maddison", "Trent AA"),
  team = c("Man City", "Man United", "Arsenal",
           "Arsenal", "Tottenham", "Liverpool"),
  assists = c(16, 8, 10, 11, 12, 4),
  xA = c(14.2, 10.5, 8.8, 7.2, 9.1, 7.8),
  key_passes = c(115, 95, 78, 68, 82, 92)
)

creator_performance <- creator_performance %>%
  mutate(
    assists_minus_xA = assists - xA,
    xa_per_kp = round(xA / key_passes, 3),
    assist_rate = round(assists / key_passes * 100, 1)
  )

print("Creator Performance vs xA:")
print(creator_performance %>%
        select(player, assists, xA, assists_minus_xA, assist_rate) %>%
        arrange(desc(assists_minus_xA)))

cat("\nInterpretation:\n")
cat("- Saka: +3.8 over xA - teammates finishing well, may regress\n")
cat("- De Bruyne: +1.8 - slight overperformance, sustainable\n")
cat("- Bruno: -2.5 under xA - unlucky, should bounce back\n")
cat("- Trent: -3.8 under xA - teammates missing his chances\n")

# Calculate Shot-Creating Actions
library(dplyr)

# For each shot, identify the two preceding offensive actions
# This requires possession sequence tracking

# Get shots and their preceding events
shots_with_context <- events %>%
  filter(type.name == "Shot") %>%
  select(shot_id = id, match_id, minute, second, team.name,
         shot.statsbomb_xg, shot.outcome.name)

# For each shot, look at the 2 prior events from same team
# (Simplified - actual SCA requires possession tracking)

# Alternative: Use pass.shot_assist and pass.goal_assist
# along with dribble info

sca_by_player <- events %>%
  filter(
    # Passes leading to shots
    (type.name == "Pass" & pass.shot_assist == TRUE) |
    # Dribbles completed before shots
    (type.name == "Dribble" & dribble.outcome.name == "Complete")
  ) %>%
  group_by(player.name, team.name) %>%
  summarise(
    matches = n_distinct(match_id),
    sca_passes = sum(type.name == "Pass" & pass.shot_assist == TRUE, na.rm = TRUE),
    sca_dribbles = sum(type.name == "Dribble", na.rm = TRUE),
    .groups = "drop"
  ) %>%
  mutate(
    total_sca = sca_passes + sca_dribbles / 3,  # Weight dribbles less
    sca_per_90 = round(total_sca / matches, 2)
  ) %>%
  arrange(desc(sca_per_90))

print("Shot-Creating Actions Leaders:")
print(head(sca_by_player, 15))

# Goal-Creating Actions
gca_by_player <- events %>%
  filter(
    (type.name == "Pass" & pass.goal_assist == TRUE)
  ) %>%
  group_by(player.name, team.name) %>%
  summarise(
    matches = n_distinct(match_id),
    assists = n(),
    .groups = "drop"
  ) %>%
  mutate(
    gca_per_90 = round(assists / matches, 2)
  ) %>%
  arrange(desc(assists))

print("Goal-Creating Actions (Assists) Leaders:")
print(head(gca_by_player, 10))

# Calculate xGChain and xGBuildup
# Requires tracking possession sequences

# For each possession sequence ending in a shot:
# 1. Identify all players involved
# 2. Credit each with the shot's xG (for xGChain)
# 3. Exclude shooter and assister for xGBuildup

# Simplified example using possession tracking
possession_sequences <- events %>%
  arrange(match_id, minute, second) %>%
  group_by(match_id) %>%
  mutate(
    # New possession when team changes or ball goes out
    new_possession = team.name != lag(team.name, default = ""),
    possession_id = cumsum(new_possession)
  ) %>%
  ungroup()

# Find possessions ending in shots
shot_possessions <- possession_sequences %>%
  group_by(match_id, possession_id) %>%
  filter(any(type.name == "Shot")) %>%
  mutate(
    possession_xg = sum(shot.statsbomb_xg[type.name == "Shot"], na.rm = TRUE)
  ) %>%
  ungroup()

# Credit all players in possession with xGChain
xgchain_by_player <- shot_possessions %>%
  filter(!is.na(player.name)) %>%
  group_by(player.name, team.name) %>%
  summarise(
    matches = n_distinct(match_id),
    possessions_involved = n_distinct(paste(match_id, possession_id)),
    xGChain = sum(possession_xg, na.rm = TRUE) / n(),  # Avg xG per action
    .groups = "drop"
  )

# Subtract xG and xA for xGBuildup
player_xg <- events %>%
  filter(type.name == "Shot") %>%
  group_by(player.name) %>%
  summarise(xG = sum(shot.statsbomb_xg, na.rm = TRUE))

# Join and calculate
xgchain_final <- xgchain_by_player %>%
  left_join(player_xg, by = "player.name") %>%
  mutate(
    xG = ifelse(is.na(xG), 0, xG),
    xGBuildup = xGChain - xG  # Would also subtract xA
  ) %>%
  arrange(desc(xGBuildup))

print("xGChain and xGBuildup Leaders:")
print(head(xgchain_final, 15))

# Analyze creator profiles by pass type
creator_profiles <- events %>%
  filter(type.name == "Pass",
         pass.shot_assist == TRUE | pass.goal_assist == TRUE) %>%
  group_by(player.name, team.name) %>%
  summarise(
    key_passes = n(),
    through_balls = sum(pass.through_ball, na.rm = TRUE),
    crosses = sum(pass.cross, na.rm = TRUE),
    cutbacks = sum(pass.cut_back, na.rm = TRUE),
    ground_passes = sum(!pass.cross & !pass.through_ball & !pass.cut_back,
                        na.rm = TRUE),
    .groups = "drop"
  ) %>%
  filter(key_passes >= 5) %>%
  mutate(
    through_ball_pct = round(through_balls / key_passes * 100, 1),
    cross_pct = round(crosses / key_passes * 100, 1),
    cutback_pct = round(cutbacks / key_passes * 100, 1),

    # Classify style
    style = case_when(
      through_ball_pct > 30 ~ "Through Ball",
      cross_pct > 50 ~ "Crosser",
      cutback_pct > 20 ~ "Cutback",
      TRUE ~ "Ground Pass"
    )
  )

print("Creator Profiles:")
print(creator_profiles %>%
        select(player.name, key_passes, through_ball_pct,
               cross_pct, cutback_pct, style) %>%
        arrange(desc(key_passes)) %>%
        head(15))