#| label: setup-r
#| message: false
#| warning: false

library(tidyverse)
library(nflfastR)
library(cfbfastR)
library(gt)
library(patchwork)

# Set theme
theme_set(theme_minimal())

#| label: overtime-analysis-r
#| message: false
#| warning: false
#| cache: true

# NFL overtime win probability
nfl_ot_data <- tibble(
  scenario = c("Receive kickoff", "Kick off", "Win coin toss"),
  win_prob = c(0.542, 0.458, 0.542),
  level = "NFL"
)

# College overtime (simplified - possession order matters less)
college_ot_data <- tibble(
  scenario = c("Defend first", "Offense first", "Win coin toss"),
  win_prob = c(0.548, 0.452, 0.548),
  level = "College"
)

# Combine and visualize
ot_comparison <- bind_rows(nfl_ot_data, college_ot_data) %>%
  filter(scenario != "Win coin toss")

ot_comparison %>%
  ggplot(aes(x = scenario, y = win_prob, fill = level)) +
  geom_col(position = "dodge", alpha = 0.8) +
  geom_hline(yintercept = 0.5, linetype = "dashed", alpha = 0.5) +
  scale_y_continuous(labels = scales::percent_format(), limits = c(0, 0.6)) +
  scale_fill_manual(values = c("NFL" = "#013369", "College" = "#841617")) +
  labs(
    title = "Overtime Win Probability by Scenario",
    subtitle = "Receiving/defending first provides similar advantages at both levels",
    x = NULL,
    y = "Win Probability",
    fill = "Level",
    caption = "Note: NFL data from 2012-2023; College data from 2013-2023"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 14),
    legend.position = "top"
  )

#| label: hash-mark-impact-r
#| message: false
#| warning: false
#| eval: false

# Simulated data showing directional tendency differences
set.seed(42)

# Generate simulated play direction data
hash_impact <- tibble(
  level = rep(c("NFL", "College"), each = 1000),
  hash_position = rep(c("Left hash", "Right hash", "Middle"),
                     length.out = 2000),
  play_direction = sample(c("Left", "Right", "Middle"), 2000, replace = TRUE,
                         prob = c(0.33, 0.33, 0.34))
) %>%
  mutate(
    # In college, stronger tendency to go to wide side from hash
    play_direction = case_when(
      level == "College" & hash_position == "Left hash" &
        runif(n()) > 0.4 ~ "Right",
      level == "College" & hash_position == "Right hash" &
        runif(n()) > 0.4 ~ "Left",
      TRUE ~ play_direction
    )
  )

# Calculate directional tendencies by hash position
hash_tendencies <- hash_impact %>%
  filter(hash_position != "Middle") %>%
  mutate(to_wide_side = case_when(
    hash_position == "Left hash" & play_direction == "Right" ~ TRUE,
    hash_position == "Right hash" & play_direction == "Left" ~ TRUE,
    TRUE ~ FALSE
  )) %>%
  group_by(level, hash_position) %>%
  summarise(
    pct_to_wide_side = mean(to_wide_side),
    .groups = "drop"
  )

hash_tendencies %>%
  ggplot(aes(x = hash_position, y = pct_to_wide_side, fill = level)) +
  geom_col(position = "dodge", alpha = 0.8) +
  geom_hline(yintercept = 0.5, linetype = "dashed", alpha = 0.5) +
  scale_y_continuous(labels = scales::percent_format()) +
  scale_fill_manual(values = c("NFL" = "#013369", "College" = "#841617")) +
  labs(
    title = "Tendency to Attack Wide Side from Hash Marks",
    subtitle = "College's wider hashes create stronger directional tendencies",
    x = "Hash Mark Position",
    y = "% of Plays to Wide Side",
    fill = "Level"
  )

#| label: pace-comparison-r
#| message: false
#| warning: false
#| cache: true
#| eval: false

# Simulated pace of play comparison
pace_data <- tibble(
  level = c("NFL", "College"),
  avg_plays_per_game = c(128, 142),
  avg_time_per_play = c(28.1, 25.4),
  avg_game_length = c(180, 195)
)

pace_data %>%
  gt() %>%
  cols_label(
    level = "Level",
    avg_plays_per_game = "Plays/Game",
    avg_time_per_play = "Seconds/Play",
    avg_game_length = "Game Length (min)"
  ) %>%
  fmt_number(
    columns = c(avg_plays_per_game, avg_time_per_play, avg_game_length),
    decimals = 1
  ) %>%
  tab_header(
    title = "Pace of Play Comparison",
    subtitle = "College football features more plays despite longer games"
  ) %>%
  tab_source_note(
    source_note = "Data: 2023 season averages"
  )

#| label: talent-disparity-r
#| message: false
#| warning: false
#| cache: true

# Simulate talent distributions
set.seed(123)

# NFL: Narrower distribution (best of best)
nfl_talent <- tibble(
  level = "NFL",
  team = paste0("Team ", 1:32),
  talent_rating = rnorm(32, mean = 85, sd = 5)
)

# College: Much wider distribution
college_talent <- tibble(
  level = "College",
  team = c(paste0("Elite ", 1:10),
           paste0("Good ", 1:25),
           paste0("Average ", 1:40),
           paste0("Weak ", 1:25),
           paste0("Poor ", 1:30)),
  talent_rating = c(
    rnorm(10, mean = 85, sd = 3),   # Elite programs
    rnorm(25, mean = 75, sd = 4),   # Good programs
    rnorm(40, mean = 65, sd = 5),   # Average programs
    rnorm(25, mean = 55, sd = 5),   # Weak programs
    rnorm(30, mean = 45, sd = 6)    # Poor programs
  )
)

talent_combined <- bind_rows(nfl_talent, college_talent)

# Visualize distributions
talent_combined %>%
  ggplot(aes(x = talent_rating, fill = level)) +
  geom_density(alpha = 0.6) +
  scale_fill_manual(values = c("NFL" = "#013369", "College" = "#841617")) +
  labs(
    title = "Talent Distribution: NFL vs College Football",
    subtitle = "NFL features compressed talent range; college shows extreme variation",
    x = "Talent Rating",
    y = "Density",
    fill = "Level"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 14),
    legend.position = "top"
  )

# Calculate dispersion metrics
talent_stats <- talent_combined %>%
  group_by(level) %>%
  summarise(
    mean = mean(talent_rating),
    sd = sd(talent_rating),
    min = min(talent_rating),
    max = max(talent_rating),
    range = max - min,
    cv = sd / mean
  )

talent_stats %>%
  gt() %>%
  cols_label(
    level = "Level",
    mean = "Mean",
    sd = "Std Dev",
    min = "Min",
    max = "Max",
    range = "Range",
    cv = "Coef. of Var."
  ) %>%
  fmt_number(decimals = 2) %>%
  tab_header(
    title = "Talent Dispersion Metrics"
  )

#| label: competitive-balance-r
#| message: false
#| warning: false
#| cache: true

# Simulated win distribution (Gini coefficient approach)
set.seed(456)

# NFL: More balanced
nfl_wins <- tibble(
  level = "NFL",
  team = paste0("Team ", 1:32),
  wins = pmax(0, pmin(17, rnorm(32, mean = 8.5, sd = 2.5)))
) %>%
  arrange(wins)

# College: Less balanced (using FBS-level data)
college_wins <- tibble(
  level = "College",
  team = paste0("Team ", 1:130),
  wins = c(
    pmax(8, pmin(13, rnorm(15, mean = 11, sd = 1.5))),  # Elite
    pmax(6, pmin(11, rnorm(25, mean = 8, sd = 2))),     # Good
    pmax(3, pmin(9, rnorm(50, mean = 6, sd = 2))),      # Average
    pmax(0, pmin(6, rnorm(40, mean = 3, sd = 2)))       # Weak
  )
) %>%
  arrange(wins)

# Calculate Gini coefficient
gini_coefficient <- function(x) {
  n <- length(x)
  x_sorted <- sort(x)
  2 * sum((1:n) * x_sorted) / (n * sum(x_sorted)) - (n + 1) / n
}

gini_stats <- bind_rows(nfl_wins, college_wins) %>%
  group_by(level) %>%
  summarise(
    gini = gini_coefficient(wins),
    win_sd = sd(wins)
  )

# Visualize win distributions
bind_rows(nfl_wins, college_wins) %>%
  ggplot(aes(x = wins, fill = level)) +
  geom_histogram(alpha = 0.6, bins = 15, position = "identity") +
  scale_fill_manual(values = c("NFL" = "#013369", "College" = "#841617")) +
  labs(
    title = "Win Distribution: NFL vs College",
    subtitle = "NFL shows greater competitive balance",
    x = "Wins",
    y = "Number of Teams",
    fill = "Level"
  ) +
  facet_wrap(~level, ncol = 1, scales = "free_y")

print("Competitive Balance Metrics:")
print(gini_stats)

#| label: tempo-analysis-r
#| message: false
#| warning: false
#| cache: true

# Simulated tempo data across teams
set.seed(789)

# NFL tempo distribution
nfl_tempo <- tibble(
  level = "NFL",
  team = paste0("Team ", 1:32),
  seconds_per_play = rnorm(32, mean = 28, sd = 2.5),
  plays_per_game = rnorm(32, mean = 64, sd = 4)
)

# College tempo distribution (wider variance)
college_tempo <- tibble(
  level = "College",
  team = paste0("Team ", 1:130),
  seconds_per_play = c(
    rnorm(20, mean = 20, sd = 2),   # Hurry-up offenses
    rnorm(50, mean = 25, sd = 2.5), # Fast tempo
    rnorm(40, mean = 28, sd = 2),   # Medium tempo
    rnorm(20, mean = 32, sd = 2)    # Slow tempo
  ),
  plays_per_game = c(
    rnorm(20, mean = 82, sd = 5),   # Hurry-up
    rnorm(50, mean = 73, sd = 4),   # Fast
    rnorm(40, mean = 68, sd = 4),   # Medium
    rnorm(20, mean = 62, sd = 4)    # Slow
  )
)

tempo_combined <- bind_rows(nfl_tempo, college_tempo)

# Scatter plot of tempo metrics
tempo_combined %>%
  ggplot(aes(x = seconds_per_play, y = plays_per_game, color = level)) +
  geom_point(alpha = 0.6, size = 3) +
  geom_smooth(method = "lm", se = FALSE) +
  scale_color_manual(values = c("NFL" = "#013369", "College" = "#841617")) +
  labs(
    title = "Pace of Play: NFL vs College Football",
    subtitle = "College shows much wider variance in tempo",
    x = "Seconds per Play",
    y = "Plays per Game",
    color = "Level"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 14),
    legend.position = "top"
  )

# Summary statistics
tempo_stats <- tempo_combined %>%
  group_by(level) %>%
  summarise(
    mean_seconds = mean(seconds_per_play),
    sd_seconds = sd(seconds_per_play),
    mean_plays = mean(plays_per_game),
    sd_plays = sd(plays_per_game),
    .groups = "drop"
  )

tempo_stats %>%
  gt() %>%
  cols_label(
    level = "Level",
    mean_seconds = "Avg Sec/Play",
    sd_seconds = "SD Sec/Play",
    mean_plays = "Avg Plays/Game",
    sd_plays = "SD Plays/Game"
  ) %>%
  fmt_number(decimals = 1) %>%
  tab_header(title = "Pace of Play Summary Statistics")

#| label: qb-projection-model-r
#| message: false
#| warning: false
#| cache: true

# Simulated QB data for projection modeling
set.seed(2024)

# Create synthetic college and NFL performance data
qb_data <- tibble(
  player_id = 1:150,
  # College stats (per game averages)
  college_cmp_pct = rnorm(150, mean = 63, sd = 5),
  college_ypa = rnorm(150, mean = 8.2, sd = 1.2),
  college_td_pct = rnorm(150, mean = 5.5, sd = 1.5),
  college_int_pct = rnorm(150, mean = 2.8, sd = 1.0),
  college_rush_yds = rnorm(150, mean = 25, sd = 15),

  # Contextual factors
  conf_strength = sample(1:10, 150, replace = TRUE),
  games_started = sample(15:50, 150, replace = TRUE),

  # Combine measurables
  height = rnorm(150, mean = 75, sd = 2),
  weight = rnorm(150, mean = 225, sd = 10),
  arm_strength = rnorm(150, mean = 55, sd = 5),

  # Draft capital (proxy for NFL evaluation)
  draft_pick = sample(1:250, 150, replace = TRUE)
) %>%
  mutate(
    # NFL performance (synthetic - correlated with college but noisy)
    nfl_epa_per_play =
      0.003 * college_cmp_pct +
      0.02 * college_ypa +
      0.01 * college_td_pct +
      -0.01 * college_int_pct +
      0.002 * conf_strength +
      -0.0005 * draft_pick +
      rnorm(150, mean = 0, sd = 0.08),

    # Categorize outcomes
    nfl_success = case_when(
      nfl_epa_per_play > 0.10 ~ "Elite",
      nfl_epa_per_play > 0.00 ~ "Average",
      TRUE ~ "Below Average"
    )
  )

# Build projection model
library(broom)

qb_model <- lm(
  nfl_epa_per_play ~
    college_cmp_pct +
    college_ypa +
    college_td_pct +
    college_int_pct +
    conf_strength +
    log(draft_pick + 1) +
    height,
  data = qb_data
)

# Display model results
tidy(qb_model) %>%
  gt() %>%
  cols_label(
    term = "Variable",
    estimate = "Coefficient",
    std.error = "Std Error",
    statistic = "t-stat",
    p.value = "p-value"
  ) %>%
  fmt_number(
    columns = c(estimate, std.error, statistic),
    decimals = 4
  ) %>%
  fmt_number(
    columns = p.value,
    decimals = 4
  ) %>%
  tab_header(
    title = "QB College-to-NFL Projection Model",
    subtitle = "Predicting NFL EPA per Play from College Performance"
  )

# Model performance
glance(qb_model) %>%
  select(r.squared, adj.r.squared, sigma, statistic, p.value) %>%
  gt() %>%
  fmt_number(decimals = 4) %>%
  tab_header(title = "Model Fit Statistics")

# Visualize actual vs predicted
qb_data <- qb_data %>%
  mutate(predicted_nfl_epa = predict(qb_model))

qb_data %>%
  ggplot(aes(x = predicted_nfl_epa, y = nfl_epa_per_play)) +
  geom_point(alpha = 0.5, size = 2) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "red") +
  geom_smooth(method = "lm", se = TRUE, alpha = 0.2) +
  labs(
    title = "QB Projection Model: Actual vs Predicted NFL Performance",
    subtitle = sprintf("R² = %.3f", summary(qb_model)$r.squared),
    x = "Predicted NFL EPA/Play",
    y = "Actual NFL EPA/Play"
  ) +
  theme(plot.title = element_text(face = "bold"))

#| label: position-translation-r
#| message: false
#| warning: false

# Position translation success rates (synthetic data)
position_translation <- tibble(
  position = c("QB", "RB", "WR", "TE", "OL", "DL", "LB", "CB", "S"),
  success_rate = c(0.35, 0.42, 0.48, 0.38, 0.45, 0.52, 0.44, 0.40, 0.46),
  college_nfl_correlation = c(0.45, 0.38, 0.52, 0.41, 0.35, 0.48, 0.40, 0.36, 0.43),
  avg_adjustment_period = c(2.5, 1.5, 1.8, 2.2, 2.8, 2.0, 2.3, 2.6, 2.1)
) %>%
  arrange(desc(success_rate))

position_translation %>%
  gt() %>%
  cols_label(
    position = "Position",
    success_rate = "Success Rate",
    college_nfl_correlation = "College-NFL Corr.",
    avg_adjustment_period = "Adj. Period (yrs)"
  ) %>%
  fmt_percent(
    columns = c(success_rate, college_nfl_correlation),
    decimals = 1
  ) %>%
  fmt_number(
    columns = avg_adjustment_period,
    decimals = 1
  ) %>%
  data_color(
    columns = success_rate,
    colors = scales::col_numeric(
      palette = c("#ef476f", "#ffd166", "#06d6a0"),
      domain = NULL
    )
  ) %>%
  tab_header(
    title = "College-to-NFL Translation by Position",
    subtitle = "Success rates and correlation of college performance to NFL outcomes"
  )

# Visualize
position_translation %>%
  ggplot(aes(x = reorder(position, success_rate), y = success_rate)) +
  geom_col(aes(fill = success_rate), alpha = 0.8) +
  geom_text(aes(label = scales::percent(success_rate, accuracy = 1)),
            hjust = -0.2, size = 3.5) +
  scale_fill_gradient(low = "#ef476f", high = "#06d6a0") +
  scale_y_continuous(labels = scales::percent_format(), limits = c(0, 0.6)) +
  coord_flip() +
  labs(
    title = "NFL Success Rate by Position",
    subtitle = "Defined as becoming above-average NFL starter within first 4 years",
    x = NULL,
    y = "Success Rate"
  ) +
  theme(legend.position = "none")

#| label: metric-transfer-correlation-r
#| message: false
#| warning: false

# Correlation of college metrics to NFL performance
metric_correlations <- tibble(
  metric = c(
    "40-Yard Dash", "Height", "Weight", "Vertical Jump",
    "Yards per Attempt", "Completion %", "TD Rate", "INT Rate",
    "Total Yards", "Total TDs", "Wins", "Team EPA"
  ),
  category = c(
    "Physical", "Physical", "Physical", "Physical",
    "Efficiency", "Efficiency", "Efficiency", "Efficiency",
    "Volume", "Volume", "Team", "Team"
  ),
  correlation_to_nfl = c(
    0.52, 0.38, 0.31, 0.47,
    0.45, 0.42, 0.39, -0.35,
    0.18, 0.22, 0.09, 0.28
  )
) %>%
  arrange(desc(abs(correlation_to_nfl)))

metric_correlations %>%
  mutate(
    correlation_abs = abs(correlation_to_nfl),
    transfers_well = if_else(correlation_abs >= 0.35, "Yes", "No")
  ) %>%
  ggplot(aes(x = reorder(metric, correlation_to_nfl),
             y = correlation_to_nfl,
             fill = transfers_well)) +
  geom_col(alpha = 0.8) +
  geom_hline(yintercept = c(-0.35, 0.35), linetype = "dashed", alpha = 0.5) +
  scale_fill_manual(values = c("Yes" = "#06d6a0", "No" = "#ef476f")) +
  coord_flip() +
  labs(
    title = "College Metric Correlation to NFL Success",
    subtitle = "Physical and efficiency metrics translate better than volume stats",
    x = NULL,
    y = "Correlation to NFL Performance",
    fill = "Transfers Well"
  ) +
  theme(
    plot.title = element_text(face = "bold"),
    legend.position = "top"
  )