#| label: imu-simulation-r
#| message: false
#| warning: false

library(tidyverse)
library(plotly)

# Simulate IMU data for a running play
set.seed(42)
time_points <- seq(0, 5, by = 0.01)

imu_data <- tibble(
  time = time_points,
  # Acceleration in m/s^2
  accel_x = 2 + sin(time_points * 3) * 1.5 + rnorm(length(time_points), 0, 0.2),
  accel_y = 0.5 + cos(time_points * 2) * 0.8 + rnorm(length(time_points), 0, 0.15),
  accel_z = 9.81 + sin(time_points * 4) * 0.5 + rnorm(length(time_points), 0, 0.1),
  # Angular velocity in deg/s
  gyro_x = sin(time_points * 5) * 30 + rnorm(length(time_points), 0, 2),
  gyro_y = cos(time_points * 3) * 20 + rnorm(length(time_points), 0, 1.5),
  gyro_z = sin(time_points * 2) * 15 + rnorm(length(time_points), 0, 1)
)

# Calculate total acceleration magnitude
imu_data <- imu_data %>%
  mutate(
    accel_magnitude = sqrt(accel_x^2 + accel_y^2 + accel_z^2),
    gyro_magnitude = sqrt(gyro_x^2 + gyro_y^2 + gyro_z^2)
  )

cat("IMU Data Summary:\n")
cat("Time range:", min(imu_data$time), "to", max(imu_data$time), "seconds\n")
cat("Peak acceleration:", round(max(imu_data$accel_magnitude), 2), "m/s²\n")
cat("Peak rotation rate:", round(max(imu_data$gyro_magnitude), 2), "deg/s\n")

#| label: fig-imu-visualization-r
#| fig-cap: "IMU sensor data during a running play"
#| fig-width: 10
#| fig-height: 8
#| message: false
#| warning: false

library(patchwork)

p1 <- ggplot(imu_data, aes(x = time, y = accel_magnitude)) +
  geom_line(color = "#00BFC4", linewidth = 1) +
  geom_hline(yintercept = 9.81, linetype = "dashed", color = "gray50") +
  labs(
    title = "Acceleration Magnitude",
    x = NULL,
    y = "Acceleration (m/s²)"
  ) +
  theme_minimal() +
  theme(plot.title = element_text(face = "bold"))

p2 <- ggplot(imu_data, aes(x = time, y = gyro_magnitude)) +
  geom_line(color = "#F8766D", linewidth = 1) +
  labs(
    title = "Angular Velocity Magnitude",
    x = "Time (seconds)",
    y = "Angular Velocity (deg/s)"
  ) +
  theme_minimal() +
  theme(plot.title = element_text(face = "bold"))

p1 / p2 +
  plot_annotation(
    title = "IMU Sensor Data During Running Play",
    subtitle = "Simulated data showing acceleration and rotation",
    caption = "Dashed line indicates gravitational acceleration (9.81 m/s²)"
  )

#| label: biometric-analysis-r
#| message: false
#| warning: false

# Simulate biometric data for a player over a week
set.seed(123)
dates <- seq.Date(as.Date("2024-01-01"), by = "day", length.out = 7)

biometric_data <- tibble(
  date = dates,
  day_type = c("Practice", "Practice", "Rest", "Practice",
               "Practice", "Game", "Rest"),
  resting_hr = c(52, 54, 50, 53, 55, 58, 51),
  hrv_score = c(68, 64, 75, 66, 62, 55, 72),
  sleep_hours = c(7.5, 7.0, 8.5, 7.2, 6.8, 6.5, 9.0),
  recovery_score = c(75, 68, 88, 70, 65, 52, 85),
  subjective_soreness = c(3, 4, 2, 4, 5, 6, 2)
)

# Calculate readiness score
biometric_data <- biometric_data %>%
  mutate(
    readiness = (
      (100 - resting_hr) * 0.3 +
      hrv_score * 0.3 +
      recovery_score * 0.3 +
      (10 - subjective_soreness) * 10 * 0.1
    ),
    status = case_when(
      readiness >= 70 ~ "Ready",
      readiness >= 50 ~ "Caution",
      TRUE ~ "At Risk"
    )
  )

biometric_data %>%
  select(date, day_type, resting_hr, hrv_score, readiness, status) %>%
  gt::gt() %>%
  gt::cols_label(
    date = "Date",
    day_type = "Activity",
    resting_hr = "Resting HR",
    hrv_score = "HRV Score",
    readiness = "Readiness",
    status = "Status"
  ) %>%
  gt::fmt_number(
    columns = readiness,
    decimals = 1
  ) %>%
  gt::data_color(
    columns = status,
    colors = scales::col_factor(
      palette = c("Ready" = "#28a745", "Caution" = "#ffc107", "At Risk" = "#dc3545"),
      domain = NULL
    )
  )

#| label: injury-risk-model-r
#| message: false
#| warning: false

# Simulate training load and injury risk data
set.seed(456)
n_days <- 90

training_data <- tibble(
  day = 1:n_days,
  acute_load = cumsum(rnorm(n_days, 100, 20)),
  chronic_load = cumsum(rnorm(n_days, 95, 15))
) %>%
  mutate(
    # Acute:Chronic Workload Ratio
    acwr = acute_load / (chronic_load + 0.1),
    # Simulate injury risk based on ACWR
    injury_risk = plogis((acwr - 1) * 3),
    risk_category = case_when(
      injury_risk < 0.2 ~ "Low",
      injury_risk < 0.4 ~ "Moderate",
      TRUE ~ "High"
    )
  )

# Summary statistics
risk_summary <- training_data %>%
  group_by(risk_category) %>%
  summarise(
    days = n(),
    avg_acwr = mean(acwr),
    avg_risk = mean(injury_risk),
    .groups = "drop"
  )

cat("\nInjury Risk Summary (90-day period):\n")
print(risk_summary)

#| label: ar-visualization-concept-r
#| message: false
#| warning: false

# Simulate AR-enhanced play data
set.seed(789)

# Create a sample play with route projections
play_data <- tibble(
  player_id = 1:11,
  position = c("QB", "RB", "WR1", "WR2", "TE", "LT", "LG", "C", "RG", "RT", "FB"),
  start_x = c(50, 45, 35, 65, 48, 42, 46, 50, 54, 58, 47),
  start_y = c(26.65, 24, 20, 20, 23, 28, 27, 26.65, 26.65, 28, 25),
  route_type = c("Drop", "Swing", "Go", "Post", "Seam",
                 "Pass Block", "Pass Block", "Pass Block", "Pass Block", "Pass Block", "Block")
)

# Generate route coordinates
generate_route <- function(start_x, start_y, route_type, steps = 20) {
  x <- numeric(steps)
  y <- numeric(steps)

  x[1] <- start_x
  y[1] <- start_y

  if (route_type == "Go") {
    for (i in 2:steps) {
      x[i] <- x[i-1]
      y[i] <- y[i-1] - 1.5
    }
  } else if (route_type == "Post") {
    for (i in 2:steps) {
      x[i] <- x[i-1] + ifelse(i > 10, 1, 0)
      y[i] <- y[i-1] - 1.5
    }
  } else if (route_type == "Seam") {
    for (i in 2:steps) {
      x[i] <- x[i-1]
      y[i] <- y[i-1] - 1.2
    }
  } else if (route_type == "Swing") {
    for (i in 2:steps) {
      x[i] <- x[i-1] - 0.5
      y[i] <- y[i-1] - 0.3
    }
  } else if (route_type == "Drop") {
    for (i in 2:steps) {
      x[i] <- x[i-1]
      y[i] <- y[i-1] + 0.5
    }
  } else {
    x <- rep(start_x, steps)
    y <- rep(start_y, steps)
  }

  tibble(x = x, y = y)
}

# Generate routes for skill players
routes <- map2_df(
  play_data$start_x[1:5],
  play_data$start_y[1:5],
  ~tibble(
    player_id = play_data$player_id[which(play_data$start_x == .x & play_data$start_y == .y)[1]],
    route = list(generate_route(.x, .y,
                                 play_data$route_type[which(play_data$start_x == .x &
                                                            play_data$start_y == .y)[1]]))
  )
) %>%
  unnest(route)

cat("AR-Enhanced Route Visualization Data Generated\n")
cat("Players tracked:", length(unique(routes$player_id)), "\n")
cat("Total route points:", nrow(routes), "\n")

#| label: vr-metrics-r
#| message: false
#| warning: false

# Simulate VR training session data
set.seed(321)

vr_sessions <- tibble(
  session_id = 1:20,
  session_date = seq.Date(as.Date("2024-01-01"), by = "day", length.out = 20),
  scenario_type = sample(c("Blitz Recognition", "Coverage Read", "Hot Route"),
                         20, replace = TRUE),
  reaction_time_ms = rnorm(20, 800, 100),
  decision_accuracy = rbeta(20, 8, 2),
  completion_time_s = rnorm(20, 45, 8),
  scenarios_completed = rpois(20, 12)
) %>%
  mutate(
    # Performance score (0-100)
    performance_score = (
      (1 / (reaction_time_ms / 500)) * 30 +
      decision_accuracy * 50 +
      (scenarios_completed / 15) * 20
    ),
    performance_score = pmin(performance_score, 100)
  )

# Calculate improvement over time
vr_improvement <- vr_sessions %>%
  arrange(session_date) %>%
  mutate(
    session_num = row_number(),
    rolling_avg = zoo::rollmean(performance_score, k = 5, fill = NA, align = "right")
  )

cat("VR Training Performance Summary:\n")
cat("Total sessions:", nrow(vr_sessions), "\n")
cat("Average reaction time:", round(mean(vr_sessions$reaction_time_ms)), "ms\n")
cat("Average accuracy:", round(mean(vr_sessions$decision_accuracy) * 100, 1), "%\n")
cat("Performance improvement:",
    round(tail(vr_improvement$rolling_avg, 1) - head(vr_improvement$rolling_avg[!is.na(vr_improvement$rolling_avg)], 1), 1),
    "points\n")

#| label: fig-vr-progress-r
#| fig-cap: "VR training performance progression over time"
#| fig-width: 10
#| fig-height: 6
#| message: false
#| warning: false

ggplot(vr_improvement, aes(x = session_num)) +
  geom_point(aes(y = performance_score, color = scenario_type),
             size = 3, alpha = 0.6) +
  geom_line(aes(y = rolling_avg), color = "black", linewidth = 1.2) +
  geom_smooth(aes(y = performance_score), method = "lm",
              se = TRUE, color = "#00BFC4", linetype = "dashed") +
  scale_color_manual(
    values = c("Blitz Recognition" = "#E74C3C",
               "Coverage Read" = "#3498DB",
               "Hot Route" = "#2ECC71")
  ) +
  labs(
    title = "VR Training Performance Progression",
    subtitle = "Individual sessions with 5-session rolling average",
    x = "Session Number",
    y = "Performance Score (0-100)",
    color = "Scenario Type"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(face = "bold", size = 14),
    legend.position = "top"
  )

#| label: edge-computing-simulation-r
#| message: false
#| warning: false

# Simulate edge computing processing times
set.seed(555)

processing_comparison <- tibble(
  scenario = rep(c("Edge Computing", "Cloud Computing"), each = 100),
  data_points = rep(1:100, 2)
) %>%
  mutate(
    # Simulate processing latency
    latency_ms = case_when(
      scenario == "Edge Computing" ~ rgamma(n(), shape = 2, rate = 0.3),
      scenario == "Cloud Computing" ~ rgamma(n(), shape = 4, rate = 0.05)
    ),
    # Simulate data freshness
    data_age_ms = case_when(
      scenario == "Edge Computing" ~ rexp(n(), rate = 0.1),
      scenario == "Cloud Computing" ~ rexp(n(), rate = 0.02)
    )
  )

# Summary statistics
latency_summary <- processing_comparison %>%
  group_by(scenario) %>%
  summarise(
    mean_latency = mean(latency_ms),
    p95_latency = quantile(latency_ms, 0.95),
    mean_data_age = mean(data_age_ms),
    .groups = "drop"
  )

cat("Processing Latency Comparison:\n")
print(latency_summary)

cat("\nLatency Improvement (Edge vs Cloud):",
    round((1 - latency_summary$mean_latency[1] / latency_summary$mean_latency[2]) * 100, 1),
    "%\n")

#| label: real-time-decision-r
#| message: false
#| warning: false

# Simulate real-time play suggestion system
simulate_real_time_analysis <- function(down, distance, yard_line, score_diff,
                                        time_remaining) {
  # Simple decision model
  go_for_it_threshold <- case_when(
    down == 4 & distance <= 2 & yard_line >= 40 ~ 0.6,
    down == 4 & distance <= 1 & yard_line >= 50 ~ 0.7,
    down == 4 & score_diff < -7 & time_remaining < 300 ~ 0.5,
    TRUE ~ 0.3
  )

  # Simulate confidence in decision
  confidence <- runif(1, 0.6, 0.95)

  decision <- ifelse(confidence >= go_for_it_threshold, "GO FOR IT", "PUNT")

  list(
    decision = decision,
    confidence = confidence,
    threshold = go_for_it_threshold,
    processing_time_ms = rgamma(1, shape = 2, rate = 0.3)
  )
}

# Example scenarios
scenarios <- tibble(
  scenario = c("4th & 1 at midfield", "4th & 2 at own 40", "4th & 3 at opp 35"),
  down = c(4, 4, 4),
  distance = c(1, 2, 3),
  yard_line = c(50, 40, 65),
  score_diff = c(0, -3, 7),
  time_remaining = c(600, 450, 180)
)

results <- scenarios %>%
  rowwise() %>%
  mutate(
    analysis = list(simulate_real_time_analysis(down, distance, yard_line,
                                                  score_diff, time_remaining))
  ) %>%
  unnest_wider(analysis)

cat("Real-Time Decision Support Examples:\n\n")
results %>%
  select(scenario, decision, confidence, processing_time_ms) %>%
  mutate(
    confidence = scales::percent(confidence, accuracy = 0.1),
    processing_time_ms = round(processing_time_ms, 1)
  ) %>%
  print()

#| label: blockchain-concept-r
#| message: false
#| warning: false

library(digest)

# Simulate simple blockchain for player tracking data
create_block <- function(index, timestamp, data, previous_hash) {
  block <- list(
    index = index,
    timestamp = timestamp,
    data = data,
    previous_hash = previous_hash
  )

  # Calculate hash
  block$hash <- digest(
    paste(block$index, block$timestamp, block$data, block$previous_hash),
    algo = "sha256"
  )

  block
}

# Create genesis block
genesis_block <- create_block(0, Sys.time(), "Genesis Block", "0")

# Add player tracking data blocks
blockchain <- list(genesis_block)

tracking_data <- list(
  list(player_id = "QB1", x = 50, y = 26.65, timestamp = "2024-01-15 13:00:01"),
  list(player_id = "QB1", x = 50, y = 27.15, timestamp = "2024-01-15 13:00:02"),
  list(player_id = "QB1", x = 49.5, y = 27.65, timestamp = "2024-01-15 13:00:03")
)

for (i in 1:length(tracking_data)) {
  new_block <- create_block(
    index = i,
    timestamp = tracking_data[[i]]$timestamp,
    data = jsonlite::toJSON(tracking_data[[i]]),
    previous_hash = blockchain[[i]]$hash
  )
  blockchain[[length(blockchain) + 1]] <- new_block
}

# Display blockchain
cat("Blockchain for Player Tracking Data:\n\n")
for (i in 1:min(3, length(blockchain))) {
  cat("Block", blockchain[[i]]$index, "\n")
  cat("  Hash:", substr(blockchain[[i]]$hash, 1, 16), "...\n")
  cat("  Previous:", substr(blockchain[[i]]$previous_hash, 1, 16), "...\n")
  cat("  Data:", as.character(blockchain[[i]]$data), "\n\n")
}

cat("Total blocks:", length(blockchain), "\n")

#| label: quantum-inspired-r
#| message: false
#| warning: false

# Quantum-inspired roster optimization using simulated annealing
set.seed(999)

# Simulate player pool
players <- tibble(
  player_id = 1:20,
  position = rep(c("QB", "RB", "WR", "TE", "OL", "DL", "LB", "DB"),
                 length.out = 20),
  value = rnorm(20, 75, 15),
  salary = runif(20, 1, 10) * 1e6
) %>%
  mutate(
    value = pmax(value, 40),  # Minimum value
    value_per_dollar = value / (salary / 1e6)
  )

# Optimization parameters
salary_cap <- 50e6
roster_size <- 10

# Simulated annealing function
optimize_roster <- function(players, salary_cap, roster_size,
                           iterations = 1000, temp_start = 100) {

  # Random initial solution
  current_roster <- sample(nrow(players), roster_size)
  current_value <- sum(players$value[current_roster])
  current_salary <- sum(players$salary[current_roster])

  # Adjust if over cap
  while (current_salary > salary_cap) {
    remove_idx <- sample(roster_size, 1)
    current_roster <- current_roster[-remove_idx]
    add_idx <- sample(setdiff(1:nrow(players), current_roster), 1)
    current_roster <- c(current_roster, add_idx)
    current_value <- sum(players$value[current_roster])
    current_salary <- sum(players$salary[current_roster])
  }

  best_roster <- current_roster
  best_value <- current_value

  # Simulated annealing
  temperature <- temp_start

  for (i in 1:iterations) {
    # Generate neighbor solution
    new_roster <- current_roster
    swap_out <- sample(roster_size, 1)
    swap_in <- sample(setdiff(1:nrow(players), current_roster), 1)
    new_roster[swap_out] <- swap_in

    new_value <- sum(players$value[new_roster])
    new_salary <- sum(players$salary[new_roster])

    # Accept if under cap and better, or probabilistically
    if (new_salary <= salary_cap) {
      delta <- new_value - current_value

      if (delta > 0 || runif(1) < exp(delta / temperature)) {
        current_roster <- new_roster
        current_value <- new_value
        current_salary <- new_salary

        if (current_value > best_value) {
          best_roster <- current_roster
          best_value <- current_value
        }
      }
    }

    # Cool down
    temperature <- temp_start * (1 - i / iterations)
  }

  list(roster = best_roster, value = best_value)
}

# Run optimization
result <- optimize_roster(players, salary_cap, roster_size)

optimal_roster <- players[result$roster, ]

cat("Quantum-Inspired Roster Optimization Results:\n")
cat("Total value:", round(result$value, 1), "\n")
cat("Total salary: $", round(sum(optimal_roster$salary) / 1e6, 2), "M\n")
cat("Salary cap space: $", round((salary_cap - sum(optimal_roster$salary)) / 1e6, 2), "M\n\n")

cat("Optimal Roster:\n")
optimal_roster %>%
  select(player_id, position, value, salary) %>%
  mutate(salary = scales::dollar(salary, scale = 1e-6, suffix = "M")) %>%
  arrange(desc(value)) %>%
  print()