1. Preparación del Entorno y Datos

En este apartado se presentan los datos de la prueba piloto para cada jugador. Se asume que los tiros fuera del ducto no tienen coordenadas medibles (NA).

library(ggplot2)
library(dplyr)
library(tidyr)
library(purrr)
library(knitr)

datos_jugadores <- list(
  "Jugador 1" = data.frame(
    X = c(25, -20, 0, -20, -15, -15, 20, -15, -30, 20, -7.5, 10, NA, 2.5, 0, 5, 30, 15, 0, NA, 15, -10, 0, -17.5, -10, 0, 10, 15, -5, 10),
    Y = c(-52.5, -30, 0, -30, -5, -85, -25, -15, -25, 52.5, -70, -10, NA, -30, 17.5, -25, 22.5, 0, 25, NA, -15, -17.5, 0, -12.5, 0, -22.5, -7.5, -20, 10, 25)
  ),
  "Jugador 2" = data.frame(
    X = c(-15, -27.5, 5, 0, 22.5, 10, 10, -10, -5, -5, -5, 0, -5, -10, 0, 2.5, -25, 5, -10, -5, 2.5, -12.5, -5, 5, 7.5, -10, 10, 12.5, -12.5, 17.5),
    Y = c(-80, 35, -5, -30, 57.5, 10, -30, 20, 45, 57.5, 0, 0, -25, -20, 22.5, -60, -25, -22.5, -5, 17.5, -5, -35, 0, 25, -10, -40, -15, 10, 0, 10)
  ),
  "Jugador 3" = data.frame(
    X = c(-17.5, 0, -10, 0, 2.5, NA, 0, 10, -20, 15, -27.5, 2.5, -2.5, 25, -10, -20, 0, -2.5, -5, -17.5, -10, 25, -5, 0, -15, -10, 25, 2.5, 32.5, -22.5),
    Y = c(-20, -25, 0, -30, 32.5, NA, -85, 0, -45, 0, -45, -85, -10, -75, -45, -5, -35, -45, 12.5, -17.5, 0, -40, -60, -60, -17.5, -40, -20, -35, -30, -65)
  ),
  "Jugador 4" = data.frame(
    X = c(2.5, 15, 15, -5, 5, 0, 0, -5, -32.5, -5, -2.5, 20, -5, 5, 32.5, 0, 32.5, -20, 7.5, 12.5, 10, NA, 5, 0, -27.5, 15, -15, 5, -25, 17.5),
    Y = c(-95, -30, -22.5, -50, -80, -10, -50, -25, 15, 10, 85, -32.5, -70, 0, 25, -25, -10, -25, 20, -5, 45, NA, 5, -10, 20, -5, -40, -35, 0, -25)
  )
)

2. Parámetros Estadísticos y Prueba de Normalidad

Se calcula la media y la desviación estándar de los datos (en el eje x y en el eje y). Asimismo, se calcula la probabilidad de fallo (Bernoulli) de cada jugador, y se valida el supuesto de normalidad con la prueba Shapiro-Wilk.

# Calcular Parámetros
calcular_parametros <- function(df, nombre) {
  data.frame(
    Jugador = nombre,
    media_x = mean(df$X, na.rm = TRUE),
    sd_x    = sd(df$X,   na.rm = TRUE),
    media_y = mean(df$Y, na.rm = TRUE),
    sd_y    = sd(df$Y,   na.rm = TRUE),
    p_fuera = sum(is.na(df$X) | is.na(df$Y)) / nrow(df)
  )
}
params <- imap_dfr(datos_jugadores, calcular_parametros)

# Prueba de Shapiro-Wilk
prueba_normalidad <- imap_dfr(datos_jugadores, function(df, nombre) {
  x_valid <- df$X[!is.na(df$X)]
  y_valid <- df$Y[!is.na(df$Y)]
  
  p_val_x <- shapiro.test(x_valid)$p.value
  p_val_y <- shapiro.test(y_valid)$p.value
  
  data.frame(
    Jugador = nombre,
    P_Value_X = p_val_x,
    Normal_X = ifelse(p_val_x > 0.05, "Sí", "No"),
    P_Value_Y = p_val_y,
    Normal_Y = ifelse(p_val_y > 0.05, "Sí", "No")
  )
})

3. Ejecución de la Simulación Monte Carlo

Se configura un marco estocástico de 40,000 iteraciones por escenario (200 réplicas de 200 lanzamientos), evaluado bajo la métrica de distancia euclidiana radial.

# Función de codificación de puntos
asignar_puntos <- function(distancia) {
  case_when(
    distancia <= 15 ~ 100,
    distancia <= 30 ~  75,
    distancia <= 45 ~  50,
    TRUE            ~   0
  )
}

# Parámetros de Monte Carlo
set.seed(2026)
N_LANZ   <- 200   
N_REP    <- 200   

resultados_ind <- list()
replica1_ind   <- list()

# 3.1. Escenarios Individuales
for (i in seq_len(nrow(params))) {
  p <- params[i, ]
  pts_rep <- numeric(N_REP)
  
  for (r in seq_len(N_REP)) {
    # Generación de variables normales y transformación de fallo
    x_sim <- rnorm(N_LANZ, p$media_x, p$sd_x)
    y_sim <- rnorm(N_LANZ, p$media_y, p$sd_y)
    fuera      <- runif(N_LANZ) < p$p_fuera
    
    # Cálculo de distancia euclidiana
    dist_sim   <- sqrt(x_sim^2 + y_sim^2)
    dist_sim[fuera] <- Inf 
    
    puntos        <- asignar_puntos(dist_sim)
    pts_rep[r]    <- sum(puntos)
    
    # Guardar réplica 1 para visualización
    if (r == 1) {
      replica1_ind[[p$Jugador]] <- data.frame(
        Jugador   = p$Jugador, X = x_sim, Y = y_sim, 
        Distancia = dist_sim, Puntos = factor(puntos, levels = c(0, 50, 75, 100))
      )
    }
  }
  resultados_ind[[p$Jugador]] <- pts_rep
}

# 3.2. Escenario Equipo Conjunto
pts_equipo  <- numeric(N_REP)
replica1_eq <- NULL
lanz_x_jugador <- N_LANZ / nrow(params)

for (r in seq_len(N_REP)) {
  # Muestreo aleatorio uniforme para la asignación de turnos 
  idx <- sample(rep(seq_len(nrow(params)), each = lanz_x_jugador))
  
  x_eq <- numeric(N_LANZ)
  y_eq <- numeric(N_LANZ)
  dist_eq <- numeric(N_LANZ)
  
  for (j in seq_len(N_LANZ)) {
    p <- params[idx[j], ]
    x_eq[j] <- rnorm(1, p$media_x, p$sd_x)
    y_eq[j] <- rnorm(1, p$media_y, p$sd_y)
    dist_eq[j] <- if (runif(1) < p$p_fuera) Inf else sqrt(x_eq[j]^2 + y_eq[j]^2)
  }
  
  puntos_eq     <- asignar_puntos(dist_eq)
  pts_equipo[r] <- sum(puntos_eq)
  
  if (r == 1) {
    replica1_eq <- data.frame(
      Jugador   = "Equipo Juntos", X = x_eq, Y = y_eq, 
      Distancia = dist_eq, Puntos = factor(puntos_eq, levels = c(0, 50, 75, 100))
    )
  }
}

# Consolidación de Resultados
todos_resultados <- c(resultados_ind, list("Equipo Juntos" = pts_equipo))

resumen <- imap_dfr(todos_resultados, function(pts, nombre) {
  data.frame(
    Jugador = nombre, 
    Media = mean(pts), 
    Desv_Std = sd(pts),
    Minimo = min(pts), 
    P5 = quantile(pts, 0.05),
    Mediana = median(pts), 
    P95 = quantile(pts, 0.95),
    Maximo = max(pts)
  )
}) %>% arrange(desc(Media))

4. Tablas de Resultados

# Formato de tablas
tabla_1_medidas <- params %>%
  mutate(
    `Media X (cm)` = round(media_x, 2),
    `Desv. Est. X` = round(sd_x, 2),
    `Media Y (cm)` = round(media_y, 2),
    `Desv. Est. Y` = round(sd_y, 2),
    `Prob. de Fallo` = paste0(round(p_fuera * 100, 1), "%")
  ) %>% select(-media_x, -sd_x, -media_y, -sd_y, -p_fuera)

tabla_2_normalidad <- prueba_normalidad %>%
  mutate(
    `P-Value X` = round(P_Value_X, 4),
    `Normalidad X` = Normal_X,
    `P-Value Y` = round(P_Value_Y, 4),
    `Normalidad Y` = Normal_Y,
    `Conclusión General` = ifelse(Normal_X == "Sí" & Normal_Y == "Sí", "Aceptada", "Rechazada")
  ) %>% select(Jugador, `P-Value X`, `Normalidad X`, `P-Value Y`, `Normalidad Y`, `Conclusión General`)

tabla_3_resultados <- resumen %>%
  mutate(
    Rango = row_number(),
    `Puntuación Media Esperada` = paste0(format(round(Media, 0), big.mark = ","), " pts"),
    `Desviación Estándar` = round(Desv_Std, 1),
    `Mínimo` = format(Minimo, big.mark = ","),
    `Percentil 5` = format(round(P5, 0), big.mark = ","),
    `Mediana` = format(Mediana, big.mark = ","),
    `Percentil 95` = format(round(P95, 0), big.mark = ","),
    `Máximo` = format(Maximo, big.mark = ",")
  ) %>%
  select(Rango, Jugador, `Puntuación Media Esperada`, `Desviación Estándar`, 
         Mínimo, `Percentil 5`, Mediana, `Percentil 95`, Máximo)

# Exportación a CSV
write.csv(tabla_1_medidas, "Tabla_1_Medidas_Descriptivas.csv", row.names = FALSE, fileEncoding = "UTF-8")
write.csv(tabla_2_normalidad, "Tabla_2_Prueba_Normalidad.csv", row.names = FALSE, fileEncoding = "UTF-8")
write.csv(tabla_3_resultados, "Tabla_3_Resultados_Montecarlo.csv", row.names = FALSE, fileEncoding = "UTF-8")

# Impresión HTML interactiva
kable(tabla_1_medidas, caption = "Tabla 1. Medidas Estadísticas Descriptivas (Prueba Piloto)")
Tabla 1. Medidas Estadísticas Descriptivas (Prueba Piloto)
Jugador Media X (cm) Desv. Est. X Media Y (cm) Desv. Est. Y Prob. de Fallo
Jugador 1 0.45 15.26 -12.32 28.63 6.7%
Jugador 2 -1.75 11.43 -3.25 31.55 0%
Jugador 3 -1.90 15.28 -30.69 28.73 3.3%
Jugador 4 1.98 15.77 -14.48 37.04 3.3% 
kable(tabla_2_normalidad, caption = "Tabla 2. Prueba de Normalidad (Shapiro-Wilk)")
Tabla 2. Prueba de Normalidad (Shapiro-Wilk)
Jugador P-Value X Normalidad X P-Value Y Normalidad Y Conclusión General
Jugador 1 0.7920 Sí 0.3596 Sí Aceptada
Jugador 2 0.8345 Sí 0.8703 Sí Aceptada
Jugador 3 0.1100 Sí 0.8461 Sí Aceptada
Jugador 4 0.3924 Sí 0.7479 Sí Aceptada 
kable(tabla_3_resultados, caption = "Tabla 3. Resultados Simulación Montecarlo (N = 40,000 lanzamientos)")
Tabla 3. Resultados Simulación Montecarlo (N = 40,000 lanzamientos)
Rango Jugador Puntuación Media Esperada Desviación Estándar Mínimo Percentil 5 Mediana Percentil 95 Máximo
5%…1 1 Jugador 2 12,574 pts 465.8 11,050 11,824 12,625.0 13,325 13,675
5%…2 2 Jugador 1 11,190 pts 462.1 9,825 10,449 11,162.5 11,876 12,400
5%…3 3 Equipo Juntos 10,601 pts 483.1 9,300 9,872 10,612.5 11,350 11,850
5%…4 4 Jugador 4 9,737 pts 569.6 8,400 8,774 9,700.0 10,676 11,300
5%…5 5 Jugador 3 8,808 pts 512.3 7,550 8,024 8,750.0 9,702 10,225

5. Visualización del Comportamiento Espacial

Se generaron gráficos de dispersión a partir de una sola réplica (\(N=200\) lanzamientos) para visualizar la distribución espacial frente a las zonas de puntuación.

colores_pts <- c("0" = "#D62828", "50" = "#F77F00", "75" = "#003049", "100" = "#2A9D8F")
colores_jug <- c("Jugador 1" = "#D62828", "Jugador 2" = "#003049", 
                 "Jugador 3" = "#2A9D8F", "Jugador 4" = "#F77F00", "Equipo Juntos"= "#6A0572")

hacer_circulo <- function(radio, n = 300) {
  theta <- seq(0, 2 * pi, length.out = n)
  data.frame(x = radio * cos(theta), y = radio * sin(theta), radio = as.factor(radio))
}
circ_45 <- hacer_circulo(45)
circ_30 <- hacer_circulo(30)
circ_15 <- hacer_circulo(15)

graficar_diana_mejorada <- function(datos_jugador, titulo) {
  ggplot() +
    geom_polygon(data = circ_45, aes(x=x, y=y), fill="#F77F00", alpha=0.1, color="grey50", linetype="dotdash") +
    geom_polygon(data = circ_30, aes(x=x, y=y), fill="#003049", alpha=0.15, color="grey50", linetype="dashed") +
    geom_polygon(data = circ_15, aes(x=x, y=y), fill="#2A9D8F", alpha=0.25, color="grey50", linetype="solid") +
    geom_hline(yintercept = 0, color = "grey60", linetype = "dashed", linewidth=0.5) +
    geom_vline(xintercept = 0, color = "grey60", linetype = "dashed", linewidth=0.5) +
    geom_point(data = datos_jugador %>% filter(is.finite(Distancia)),
               aes(x = X, y = Y, fill = Puntos),
               shape = 21, color = "white", size = 2.5, alpha = 0.85, stroke=0.2) +
    geom_point(data = datos_jugador %>% filter(!is.finite(Distancia)),
               aes(x = X, y = Y),
               shape = 4, color = "black", size = 3, stroke=1.2) +
    coord_fixed(xlim = c(-100, 100), ylim = c(-100, 100)) +
    scale_fill_manual(values = colores_pts, drop=FALSE,
                      labels = c("0 pts  (>45 cm)", "50 pts (30–45 cm)", 
                                 "75 pts (15–30 cm)", "100 pts (<=15 cm)")) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "right",
          panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
          plot.title = element_text(face = "bold", size = 14),
          plot.background = element_rect(fill = "white", color = NA)) +
    labs(title = titulo,
         subtitle = "X negras = NA (tiros fuera de rango)",
         x = "Desviación Lateral X (cm)", y = "Desviación Vertical Y (cm)", fill = "Puntaje")
}

# Impresión de gráficos individuales
nombres_jugadores <- names(replica1_ind)
for (nombre in nombres_jugadores) {
  print(graficar_diana_mejorada(replica1_ind[[nombre]], paste0("Distribución de Impactos - ", nombre)))
}

print(graficar_diana_mejorada(replica1_eq, "Distribución de Impactos - Equipo Conjunto"))

6. Distribución General del Sistema (Boxplot)

Se diseñó u gráfico comparativo, utilizando diagramas de caja y bigote, utilizando las 200 réplicas.

datos_long <- imap_dfr(todos_resultados, function(pts, nombre) {
  data.frame(Jugador = nombre, Puntos = pts)
}) %>% mutate(Jugador = factor(Jugador, levels = rev(resumen$Jugador)))

media_eq <- mean(pts_equipo)

grafico_boxplot <- ggplot(datos_long, aes(x = Jugador, y = Puntos, fill = Jugador)) +
  geom_boxplot(alpha = 0.5, outlier.shape = NA, width=0.6) + 
  geom_jitter(color="black", size=0.4, alpha=0.15, width = 0.15) +
  geom_hline(yintercept = media_eq, color = "#6A0572", linetype = "dashed", linewidth = 1) +
  annotate("label", x = Inf, y = media_eq, 
           label = paste0("Media Equipo: ", round(media_eq, 0)), 
           color = "white", fill = "#6A0572", 
           fontface = "bold", hjust = 1.05, vjust = -0.5, size = 3.5) +
  coord_flip() +
  scale_fill_manual(values = colores_jug) +
  theme_classic(base_size = 12) +
  theme(legend.position = "none", plot.title = element_text(face = "bold")) +
  labs(title = "Comparación de Rendimiento por Jugador y Conjunto",
       subtitle = "Simulación de 40,000 lanzamientos", x = NULL, y = "Puntaje Total por Réplica")

print(grafico_boxplot)