1 Introducción y Metodología

Análisis inferencial de la variable Década de Finalización de perforación en pozos de NY, validando un modelo de probabilidad discreto con la prueba de Chi-cuadrado de Pearson.

Variable: X = N° de pozos completados por semana, periodo 2020-2025 (tramo más reciente y estable).

Selección del modelo (según razón Varianza/Media, mismo algoritmo de Fecha de Estado — Tres Agrupaciones):

  • < 0.85 → Binomial
  • 0.85 – 1.15 → Poisson (equidispersión)
  • > 1.15 → sobredispersión: se comparan Geométrica y Binomial Negativa, se elige la de menor Chi-cuadrado

También se reporta el tamaño del efecto (W de Cohen), útil cuando N es grande (aquí, 6 años de datos semanales).

2 Carga de Librerías

library(dplyr)
library(tidyr)
library(ggplot2)
library(gt)
library(moments)
library(scales)
library(lubridate)

col_principal <- "#0E6655"
col_barras    <- "#16A085"
col_acento    <- "#E67E22"
col_teorico   <- "#2E4053"
col_grid      <- "#D7DBDD"

3 Carga de Datos

ruta_archivo <- "Oil__Gas____Other_Regulated_Wells__Beginning_1860 (1).csv"

if (!file.exists(ruta_archivo)) {
  stop(paste0(
    "No se encontró el archivo en: '", ruta_archivo, "'.\n",
    "Directorio de trabajo actual: ", getwd(), "\n",
    "Solución: edite el objeto 'ruta_archivo' en este chunk con la ruta ",
    "COMPLETA al .csv en su computador, o mueva el .csv a la carpeta: ", getwd()
  ))
}

datos <- read.csv(ruta_archivo, sep = ";", stringsAsFactors = FALSE)

Datos_Brutos <- read.csv(
  ruta_archivo,
  header = TRUE, sep = ";", fileEncoding = "latin1"
)

if (ncol(Datos_Brutos) <= 1) {
  Datos_Brutos <- read.csv(
    ruta_archivo,
    header = TRUE, sep = ",", fileEncoding = "latin1"
  )
}
if (ncol(Datos_Brutos) <= 1) {
  Datos_Brutos <- read.csv(ruta_archivo, header = TRUE, sep = ";")
}
if (ncol(Datos_Brutos) <= 1) {
  Datos_Brutos <- read.csv(ruta_archivo, header = TRUE, sep = ",")
}
if (ncol(Datos_Brutos) <= 1) {
  stop("No se pudo separar el archivo en columnas. Verifique el delimitador manualmente.")
}

cat("Archivo leído desde:", normalizePath(ruta_archivo), "\n")
## Archivo leído desde: C:\Users\ASUS\Downloads\Oil__Gas____Other_Regulated_Wells__Beginning_1860 (1).csv
cat("Columnas detectadas:", ncol(Datos_Brutos), "| Registros totales cargados:", nrow(Datos_Brutos), "\n")
## Columnas detectadas: 55 | Registros totales cargados: 47407

4 Extracción y Preparación de la Variable

El dataset puede traer la fecha de finalización en dos formatos: (A) columnas separadas Completion Year/Month/Day, o (B) un solo campo Date Well Completed. Las columnas se detectan por patrón para tolerar variaciones de nombre.

nombres_disp <- names(Datos_Brutos)

col_y <- nombres_disp[grepl("completion", nombres_disp, ignore.case = TRUE) &
                       grepl("year",       nombres_disp, ignore.case = TRUE)]
col_m <- nombres_disp[grepl("completion", nombres_disp, ignore.case = TRUE) &
                       grepl("month",      nombres_disp, ignore.case = TRUE)]
col_d <- nombres_disp[grepl("completion", nombres_disp, ignore.case = TRUE) &
                       grepl("day",        nombres_disp, ignore.case = TRUE) &
                       !grepl("decade",    nombres_disp, ignore.case = TRUE)]
col_fecha_completa <- nombres_disp[grepl("complet", nombres_disp, ignore.case = TRUE) &
                                    grepl("date",    nombres_disp, ignore.case = TRUE)]

if (length(col_y) > 0 && length(col_m) > 0 && length(col_d) > 0) {
  modo_fecha_fin <- "ymd"
  cat("Modo detectado: columnas separadas Year/Month/Day\n")
  cat("  Year :", col_y[1], "\n  Month:", col_m[1], "\n  Day  :", col_d[1], "\n")
} else if (length(col_fecha_completa) > 0) {
  modo_fecha_fin <- "fecha_texto"
  cat("Modo detectado: campo de fecha único\n")
  cat("  Columna:", col_fecha_completa[1], "\n")
} else {
  stop(paste0(
    "No se encontró ninguna columna de finalización (se buscaron patrones ",
    "'Completion'+'Year'/'Month'/'Day' y 'Complet*'+'Date').\n",
    "COLUMNAS ENCONTRADAS EN EL ARCHIVO:\n", paste(nombres_disp, collapse = " | ")
  ))
}
## Modo detectado: columnas separadas Year/Month/Day
##   Year : Completion.Year 
##   Month: Completion.Month 
##   Day  : Completion.Day
if (modo_fecha_fin == "ymd") {
  Datos_Brutos <- Datos_Brutos %>%
    mutate(
      Anio_c  = suppressWarnings(as.integer(.data[[col_y[1]]])),
      Mes_c   = suppressWarnings(as.integer(.data[[col_m[1]]])),
      Dia_c   = suppressWarnings(as.integer(.data[[col_d[1]]])),
      Fecha_Completado = suppressWarnings(as.Date(
        paste(Anio_c, Mes_c, Dia_c, sep = "-"), format = "%Y-%m-%d"
      ))
    )
} else {
  Datos_Brutos <- Datos_Brutos %>%
    mutate(
      Fecha_Completado = suppressWarnings(as.Date(
        .data[[col_fecha_completa[1]]], format = "%m/%d/%Y"
      ))
    )
}

# --- Filtro al periodo 2020-01-01 a 2025-12-31 (ver justificación arriba) ---
Datos_Validos <- Datos_Brutos %>%
  filter(
    !is.na(Fecha_Completado),
    Fecha_Completado >= as.Date("2020-01-01"),
    Fecha_Completado <= as.Date("2025-12-31")
  )

# Conteo de pozos por día (paso intermedio, para no perder ningún día sin actividad)
conteo_diario <- Datos_Validos %>%
  count(Fecha_Completado, name = "pozos_dia")

rango_fechas <- seq(as.Date("2020-01-01"), as.Date("2025-12-31"), by = "day")

Serie_Diaria <- data.frame(Fecha_Completado = rango_fechas) %>%
  left_join(conteo_diario, by = "Fecha_Completado") %>%
  mutate(pozos_dia = ifelse(is.na(pozos_dia), 0, pozos_dia))

# --- Agregación a nivel SEMANAL: esta es la variable X del análisis ---
Serie_Semanal <- Serie_Diaria %>%
  mutate(Semana = floor_date(Fecha_Completado, unit = "week")) %>%
  group_by(Semana) %>%
  summarise(pozos_semana = sum(pozos_dia), .groups = "drop")

# Completar TODAS las semanas del rango, incluidas las que tuvieron 0 pozos
rango_semanas <- seq(min(Serie_Semanal$Semana), max(Serie_Semanal$Semana), by = "week")
Serie_Semanal <- data.frame(Semana = rango_semanas) %>%
  left_join(Serie_Semanal, by = "Semana") %>%
  mutate(pozos_semana = ifelse(is.na(pozos_semana), 0, pozos_semana))

# X y n representan la escala SEMANAL en todo el resto del documento
X <- Serie_Semanal$pozos_semana
n <- length(X)
if (n == 0) stop("ERROR: No hay datos válidos.")

media_X <- mean(X)
var_X   <- var(X)

cat("Variable analizada: N° de pozos con finalización de perforación por SEMANA\n")
## Variable analizada: N° de pozos con finalización de perforación por SEMANA
cat("Periodo:", format(min(rango_semanas)), "a", format(max(rango_semanas)), "\n")
## Periodo: 2019-12-29 a 2025-12-28
cat("Número de semanas observadas (n):", n, "\n")
## Número de semanas observadas (n): 314
cat("Media (x̄):", round(media_X, 4), "\n")
## Media (x̄): 1.2006
cat("Varianza:", round(var_X, 4), "\n")
## Varianza: 1.5539
cat("Razón varianza/media:", round(var_X / media_X, 3), "\n")
## Razón varianza/media: 1.294
cat("Asimetría:", round(skewness(X), 4), "| Curtosis:", round(kurtosis(X), 4), "\n")
## Asimetría: 1.46 | Curtosis: 6.4458

5 Tabla de Distribución de Frecuencias

tabla_FO <- as.data.frame(table(X))
names(tabla_FO) <- c("x", "FOi")
tabla_FO$x <- as.numeric(as.character(tabla_FO$x))

tabla_FO <- tabla_FO %>%
  arrange(x) %>%
  mutate(
    fi     = FOi / n,
    Fi_asc = cumsum(fi)
  )

tabla_FO %>%
  gt() %>%
  tab_header(
    title = md("**DISTRIBUCIÓN DE FRECUENCIAS SEMANALES**"),
    subtitle = md("Variable: **N° de pozos con finalización de perforación por semana (X)** · Nueva York · 2020-2025")
  ) %>%
  fmt_number(columns = c(fi, Fi_asc), decimals = 4) %>%
  cols_label(
    x = "N° de pozos por semana (x)", FOi = "Frec. Observada (FOi)",
    fi = "Frec. Relativa (fi)", Fi_asc = "Frec. Relativa Acum. (Fi)"
  ) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = list(cell_fill(color = col_principal), cell_text(color = "white", weight = "bold")),
    locations = cells_title()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#148F77"), cell_text(color = "white", weight = "bold")),
    locations = cells_column_labels()
  ) %>%
  opt_row_striping() %>%
  opt_table_font(font = google_font("Roboto")) %>%
  tab_options(
    table.font.size = px(13),
    heading.align = "left",
    data_row.padding = px(6),
    table.border.top.color = col_principal,
    table.border.bottom.color = col_principal,
    column_labels.border.bottom.color = col_principal
  ) %>%
  tab_source_note(md("*Fuente: NYS DEC — Oil, Gas & Other Regulated Wells. Elaboración: EDUARDO.*"))
DISTRIBUCIÓN DE FRECUENCIAS SEMANALES
Variable: N° de pozos con finalización de perforación por semana (X) · Nueva York · 2020-2025
N° de pozos por semana (x) Frec. Observada (FOi) Frec. Relativa (fi) Frec. Relativa Acum. (Fi)
0 107 0.3408 0.3408
1 104 0.3312 0.6720
2 61 0.1943 0.8662
3 28 0.0892 0.9554
4 8 0.0255 0.9809
5 3 0.0096 0.9904
6 2 0.0064 0.9968
8 1 0.0032 1.0000
Fuente: NYS DEC — Oil, Gas & Other Regulated Wells. Elaboración: EDUARDO.

6 Gráfico de Barras — Frecuencia Relativa Observada

Variable discreta de conteo → se usa gráfico de barras (análogo discreto del histograma).

ggplot(tabla_FO, aes(x = factor(x), y = fi * 100)) +
  geom_col(fill = col_barras, width = 0.7) +
  labs(
    title = "Gráfico N°1: Frecuencia relativa observada — pozos finalizados por semana",
    x = "N° de pozos finalizados por semana (x)", y = "Frecuencia relativa (%)"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(color = col_principal, face = "bold", size = 12),
    axis.title = element_text(color = col_principal),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),
    axis.text.x = element_text(angle = 90, vjust = 0.5, size = 7)
  )

7 Selección y Ajuste del Modelo de Probabilidad

Se aplica el mismo algoritmo de selección de Fecha de Estado — Tres Agrupaciones: modelo según razón Varianza/Media, comparando Geométrica vs. Binomial Negativa en sobredispersión. Para Chi-cuadrado, clases con FEi < 5 se agrupan (regla de Cochran).

# --- Texto de justificación por modelo (idéntico criterio al usado en
#     "Fecha de Estado — Tres Agrupaciones") ---
justificar_modelo <- function(modelo, razon) {
  switch(modelo,
    "Binomial" = paste0(
      "Se eligió **Binomial**: dispersión menor a la esperada bajo aleatoriedad pura ",
      "(razón Var/Media = ", round(razon, 3), " < 1), típico de intentos acotados con ",
      "probabilidad estable."),
    "Poisson" = paste0(
      "Se eligió **Poisson**: varianza ≈ media (razón = ", round(razon, 3), "), propio de ",
      "eventos independientes a tasa constante."),
    "Geometrica" = paste0(
      "Se eligió **Geométrica**: sobredispersión clara (razón = ", round(razon, 3), " > 1), ",
      "sugiriendo tasa semanal no constante."),
    "BinomialNegativa" = paste0(
      "Se eligió **Binomial Negativa**: sobredispersión (razón = ", round(razon, 3), " > 1) ",
      "con mejor ajuste que Geométrica; consistente con una tasa de finalización variable por ",
      "episodios (auges/caídas de actividad).")
  )
}

# --- Construye clases agrupando colas con FEi < 5 (regla de Cochran) para
#     una distribución candidata dada por sus funciones dfun/pfun ---
construir_clases <- function(x, dfun, pfun, ...) {
  n_obs <- length(x)

  # Cola izquierda: agrupa x = 0..(k_ini-1) si su FEi < 5
  k_ini <- 0
  while (n_obs * dfun(k_ini, ...) < 5 && k_ini <= 500) k_ini <- k_ini + 1

  FOi <- c(); Pi <- c(); etiquetas <- c()
  if (k_ini > 0) {
    FOi <- c(FOi, sum(x < k_ini))
    Pi  <- c(Pi, pfun(k_ini - 1, ...))
    etiquetas <- c(etiquetas, paste0(k_ini - 1, " o menos"))
  }

  # Clases individuales mientras FEi >= 5
  k <- k_ini
  repeat {
    p_k  <- dfun(k, ...)
    FE_k <- n_obs * p_k
    if (FE_k < 5) break
    FOi <- c(FOi, sum(x == k))
    Pi  <- c(Pi, p_k)
    etiquetas <- c(etiquetas, as.character(k))
    k <- k + 1
    if (k > 500) break
  }

  # Cola derecha: agrupa x >= k
  FOi <- c(FOi, sum(x >= k))
  Pi  <- c(Pi, 1 - pfun(k - 1, ...))
  etiquetas <- c(etiquetas, paste0(k, " o más"))

  data.frame(clase = etiquetas, FOi = FOi, Pi = Pi, FEi = n_obs * Pi)
}

# --- Algoritmo principal: elige el modelo por razón Varianza/Media, arma la
#     tabla de clases y calcula chi2, gl, p-value y W de Cohen ---
ajustar_y_probar_conteo <- function(x) {
  n_obs <- length(x)
  media <- mean(x)
  var_x <- var(x)
  razon <- var_x / media

  evaluar_candidato <- function(dfun, pfun, ...) {
    tabla <- construir_clases(x, dfun, pfun, ...)
    chi2  <- sum((tabla$FOi - tabla$FEi)^2 / tabla$FEi)
    list(tabla = tabla, chi2 = chi2)
  }

  if (razon < 0.85) {
    modelo <- "Binomial"
    size_hat <- max(x)
    p_hat <- min(max(media / size_hat, 1e-6), 1 - 1e-6)
    cand <- evaluar_candidato(dbinom, pbinom, size = size_hat, prob = p_hat)
    tabla_clases <- cand$tabla
    params <- paste0("n = ", size_hat, ", p = ", round(p_hat, 4))
    m_parametros <- 1
    pmf_fn <- function(k) dbinom(k, size_hat, p_hat)
    cdf_fn <- function(k) pbinom(k, size_hat, p_hat)

  } else if (razon >= 0.85 & razon <= 1.15) {
    modelo <- "Poisson"
    lambda_hat <- media
    cand <- evaluar_candidato(dpois, ppois, lambda = lambda_hat)
    tabla_clases <- cand$tabla
    params <- paste0("lambda = ", round(lambda_hat, 4))
    m_parametros <- 1
    pmf_fn <- function(k) dpois(k, lambda_hat)
    cdf_fn <- function(k) ppois(k, lambda_hat)

  } else {
    # Sobredispersión (razón > 1.15): se ajustan Geométrica y Binomial
    # Negativa por método de momentos y se elige la de menor chi2 real.
    p_geom <- 1 / (media + 1)
    cand_geom <- evaluar_candidato(dgeom, pgeom, prob = p_geom)

    if (var_x > media) {
      size_nb <- media^2 / (var_x - media)
      size_nb <- max(size_nb, 1e-3)
      cand_nb <- evaluar_candidato(dnbinom, pnbinom, size = size_nb, mu = media)
    } else {
      cand_nb <- list(tabla = cand_geom$tabla, chi2 = Inf)  # no aplica, descarta
    }

    if (cand_nb$chi2 < cand_geom$chi2) {
      modelo <- "BinomialNegativa"; tabla_clases <- cand_nb$tabla
      params <- paste0("size = ", round(size_nb, 4), ", mu = ", round(media, 4))
      m_parametros <- 2
      pmf_fn <- function(k) dnbinom(k, size = size_nb, mu = media)
      cdf_fn <- function(k) pnbinom(k, size = size_nb, mu = media)
    } else {
      modelo <- "Geometrica"; tabla_clases <- cand_geom$tabla
      params <- paste0("p = ", round(p_geom, 4))
      m_parametros <- 1
      pmf_fn <- function(k) dgeom(k, p_geom)
      cdf_fn <- function(k) pgeom(k, p_geom)
    }
  }

  k_clases  <- nrow(tabla_clases)
  gl        <- max(k_clases - 1 - m_parametros, 1)
  chi2_stat <- sum((tabla_clases$FOi - tabla_clases$FEi)^2 / tabla_clases$FEi)
  chi2_crit <- qchisq(0.95, df = gl)
  p_value   <- pchisq(chi2_stat, df = gl, lower.tail = FALSE)
  aprobado  <- p_value > 0.05

  # Tamaño del efecto (W de Cohen): qué tan grande es la discrepancia en
  # términos prácticos, sin la inflación que produce un N grande.
  w_cohen <- sqrt(chi2_stat / n_obs)

  hi_obs <- tabla_clases$FOi / n_obs
  hi_esp <- tabla_clases$FEi / n_obs
  cor_pearson <- cor(hi_obs, hi_esp) * 100

  list(tabla = tabla_clases, n = n_obs, media = media, var = var_x, razon = razon,
       modelo = modelo, params = params, m_parametros = m_parametros, k_clases = k_clases,
       gl = gl, chi2_stat = chi2_stat, chi2_crit = chi2_crit, p_value = p_value,
       aprobado = aprobado, w_cohen = w_cohen, hi_obs = hi_obs, hi_esp = hi_esp,
       cor_pearson = cor_pearson, pmf_fn = pmf_fn, cdf_fn = cdf_fn)
}

res <- ajustar_y_probar_conteo(X)

7.1 Conjetura del Modelo

Razón Varianza/Media = 1.294 → modelo elegido: BinomialNegativa (size = 4.081, mu = 1.2006).

Se eligió Binomial Negativa: sobredispersión (razón = 1.294 > 1) con mejor ajuste que Geométrica; consistente con una tasa de finalización variable por episodios (auges/caídas de actividad).

res$tabla
##     clase FOi         Pi        FEi
## 1       0 107 0.34907593 109.609842
## 2       1 104 0.32383957 101.685624
## 3       2  61 0.18702183  58.724854
## 4       3  28 0.08617655  27.059436
## 5       4   8 0.03467901  10.889208
## 6 5 o más   6 0.01920712   6.031036

7.2 Frecuencias Observadas vs. Esperadas

plot_df <- res$tabla %>%
  select(clase, FOi, FEi) %>%
  pivot_longer(cols = c(FOi, FEi), names_to = "Tipo", values_to = "Frecuencia") %>%
  mutate(clase = factor(clase, levels = res$tabla$clase))

ggplot(plot_df, aes(x = clase, y = Frecuencia, fill = Tipo)) +
  geom_col(position = position_dodge(width = 0.75), width = 0.65) +
  scale_fill_manual(
    values = c(FOi = col_barras, FEi = col_acento),
    labels = c(FOi = "Observada (FOi)", FEi = paste0("Esperada · ", res$modelo, " (FEi)"))
  ) +
  labs(
    title = paste0("Gráfico N°2: Frecuencias observadas vs. esperadas — Modelo ", res$modelo),
    subtitle = paste0(res$params, " · razón Varianza/Media = ", round(res$razon, 3)),
    x = "N° de pozos por semana", y = "Frecuencia (semanas)", fill = ""
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(color = col_principal, face = "bold", size = 12),
    legend.position = "top",
    axis.text.x = element_text(angle = 90, vjust = 0.5, size = 7)
  )

7.3 Función de Probabilidad Acumulada (CDF): Empírica vs. Teórica

Comparación de la CDF empírica vs. la CDF teórica del modelo BinomialNegativa: a mayor superposición de curvas, mejor el ajuste.

x_max_plot <- max(X)
x_seq <- 0:x_max_plot

cdf_empirica_fn <- ecdf(X)
cdf_emp_vals <- cdf_empirica_fn(x_seq)
cdf_teo_vals <- res$cdf_fn(x_seq)

df_cdf <- data.frame(
  x = rep(x_seq, 2),
  F = c(cdf_emp_vals, cdf_teo_vals),
  Tipo = rep(c("Empírica (datos)", paste0("Teórica (", res$modelo, ")")), each = length(x_seq))
)

ggplot(df_cdf, aes(x = x, y = F, color = Tipo)) +
  geom_step(linewidth = 1) +
  geom_point(size = 1.6) +
  scale_color_manual(values = setNames(
    c(col_barras, col_acento),
    c("Empírica (datos)", paste0("Teórica (", res$modelo, ")"))
  )) +
  scale_y_continuous(labels = scales::percent) +
  labs(
    title = paste0("Gráfico N°3: Función de Probabilidad Acumulada (CDF) — Empírica vs. ", res$modelo),
    subtitle = paste0("X ~ ", res$modelo, "(", res$params, ")"),
    x = "N° de pozos finalizados por semana (x)", y = "P(X ≤ x)", color = ""
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(color = col_principal, face = "bold", size = 12),
    legend.position = "top"
  )

8 Test de Pearson

plot(res$hi_obs, res$hi_esp, pch = 19, col = col_principal,
     xlab = "Frecuencia Observada", ylab = "Frecuencia Esperada",
     main = paste0("Gráfica: Correlación Observado vs. Esperado — Modelo ", res$modelo))
abline(0, 1, col = "red", lwd = 2)

cat("Correlación de Pearson (%) =", round(res$cor_pearson, 2), "\n")
## Correlación de Pearson (%) = 99.88

9 Test de Chi-Cuadrado y Tamaño del Efecto (W de Cohen)

Se contrasta:

  • H0: X sigue el modelo BinomialNegativa (ajuste adecuado).
  • Ha: X no sigue ese modelo.

\[X^2 = \sum \frac{(FO_i - FE_i)^2}{FE_i} \qquad FE_i = P_i \times n \qquad gl = k - 1 - m \qquad W = \sqrt{X^2 / n}\]

k = clases, m = parámetros estimados (2). El W de Cohen mide el tamaño del efecto independientemente de n — relevante aquí con n = 314 semanas, ya que el Chi-cuadrado gana potencia con N grande.

Tabla_Chi <- res$tabla %>%
  mutate(Aporte_Chi2 = (FOi - FEi)^2 / FEi)

alpha <- 0.05

decision <- if (res$aprobado) {
  paste0("No se rechaza H0 (el modelo ", res$modelo, " es un ajuste adecuado)")
} else {
  paste0("Se rechaza H0 (el modelo ", res$modelo, " no se ajusta adecuadamente)")
}

cat("N                            =", res$n, "\n")
## N                            = 314
cat("Chi-cuadrado calculado (X² calc):", round(res$chi2_stat, 4), "\n")
## Chi-cuadrado calculado (X² calc): 1.0024
cat("Número de clases (k):", res$k_clases, "| Parámetros estimados (m):", res$m_parametros, "\n")
## Número de clases (k): 6 | Parámetros estimados (m): 2
cat("Grados de libertad (gl = k - 1 - m):", res$gl, "\n")
## Grados de libertad (gl = k - 1 - m): 3
cat("Chi-cuadrado crítico (alpha = 0.05):", round(res$chi2_crit, 4), "\n")
## Chi-cuadrado crítico (alpha = 0.05): 7.8147
cat("p-value                      =", format.pval(res$p_value, digits = 4), "\n")
## p-value                      = 0.8007
cat("Decisión:", decision, "\n")
## Decisión: No se rechaza H0 (el modelo BinomialNegativa es un ajuste adecuado)
cat("W de Cohen (tamaño del efecto) =", round(res$w_cohen, 4),
    ifelse(res$w_cohen < 0.1, "(trivial)",
    ifelse(res$w_cohen < 0.3, "(pequeño)",
    ifelse(res$w_cohen < 0.5, "(mediano)", "(grande)"))), "\n")
## W de Cohen (tamaño del efecto) = 0.0565 (trivial)
magnitud_w <- ifelse(res$w_cohen < 0.1, "trivial", ifelse(res$w_cohen < 0.3, "pequeña",
                ifelse(res$w_cohen < 0.5, "mediana", "grande")))

cat("**Interpretación del Resultado**\n\n")

Interpretación del Resultado

if (!res$aprobado) {
  cat(paste0(
    "El modelo **", res$modelo, "** **no se ajusta** a los datos ",
    "(X² = ", round(res$chi2_stat, 3), " vs. crítico ", round(res$chi2_crit, 3),
    "; p = ", format.pval(res$p_value, digits = 4), "). Con n = ", res$n, " semanas, el test ",
    "tiene alta potencia (desviaciones pequeñas ya dan p bajo). Por eso se complementa con el ",
    "**W de Cohen = ", round(res$w_cohen, 3), "** (magnitud **", magnitud_w, "**), que indica si ",
    "la discrepancia es sustantiva o solo efecto del volumen de datos."
  ))
} else {
  cat(paste0(
    "El modelo **", res$modelo, "** se ajusta adecuadamente ",
    "(X² = ", round(res$chi2_stat, 3), ", p = ", format.pval(res$p_value, digits = 4), " > 0.05). ",
    "W de Cohen = ", round(res$w_cohen, 3), " (**", magnitud_w, "**), confirmando discrepancia mínima ",
    "también en términos prácticos."
  ))
}

El modelo BinomialNegativa se ajusta adecuadamente (X² = 1.002, p = 0.8007 > 0.05). W de Cohen = 0.057 (trivial), confirmando discrepancia mínima también en términos prácticos.

10 Tabla Resumen de Validación del Modelo

fila_max_aporte <- which.max(Tabla_Chi$Aporte_Chi2)

Tabla_Chi %>%
  gt() %>%
  tab_header(
    title = md(paste0("**VALIDACIÓN DEL MODELO ", toupper(res$modelo), "**")),
    subtitle = md(paste0(res$params, " · n = ", res$n, " semanas · 2020-2025"))
  ) %>%
  fmt_number(columns = c(Pi, FEi, Aporte_Chi2), decimals = 4) %>%
  cols_label(
    clase = "Clase (x)", FOi = "FOi", Pi = "Pi (teórica)",
    FEi = "FEi", Aporte_Chi2 = "Aporte a X²"
  ) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = list(cell_fill(color = col_principal), cell_text(color = "white", weight = "bold")),
    locations = cells_title()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#148F77"), cell_text(color = "white", weight = "bold")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#FDEBD0"), cell_text(weight = "bold")),
    locations = cells_body(rows = fila_max_aporte)
  ) %>%
  opt_row_striping() %>%
  opt_table_font(font = google_font("Roboto")) %>%
  tab_options(
    table.font.size = px(13),
    heading.align = "left",
    data_row.padding = px(7),
    table.border.top.color = col_principal,
    table.border.bottom.color = col_principal,
    column_labels.border.bottom.color = col_principal
  ) %>%
  tab_source_note(md(paste0(
    "**X² calculado = ", round(res$chi2_stat, 4),
    "** vs. **X² crítico (α = 0.05, gl = ", res$gl, ") = ", round(res$chi2_crit, 4), "** &nbsp;|&nbsp; ",
    "**W de Cohen = ", round(res$w_cohen, 4), "** &nbsp;|&nbsp; ",
    "**Decisión:** ", decision
  )))
VALIDACIÓN DEL MODELO BINOMIALNEGATIVA
size = 4.081, mu = 1.2006 · n = 314 semanas · 2020-2025
Clase (x) FOi Pi (teórica) FEi Aporte a X²
0 107 0.3491 109.6098 0.0621
1 104 0.3238 101.6856 0.0527
2 61 0.1870 58.7249 0.0881
3 28 0.0862 27.0594 0.0327
4 8 0.0347 10.8892 0.7666
5 o más 6 0.0192 6.0310 0.0002
X² calculado = 1.0024 vs. X² crítico (α = 0.05, gl = 3) = 7.8147  |  W de Cohen = 0.0565  |  Decisión: No se rechaza H0 (el modelo BinomialNegativa es un ajuste adecuado)

11 Conclusiones

  • Modelo elegido: razón Var/Media = 1.294 → BinomialNegativa (size = 4.081, mu = 1.2006).
  • Se eligió Binomial Negativa: sobredispersión (razón = 1.294 > 1) con mejor ajuste que Geométrica; consistente con una tasa de finalización variable por episodios (auges/caídas de actividad).
  • Chi-cuadrado: X² calc = 1.0024 vs. crítico = 7.8147 (α = 0.05, gl = 3, p = 0.8007) → el modelo BinomialNegativa se acepta.
  • Tamaño del efecto: W de Cohen = 0.057 (trivial), útil más allá del veredicto binario, dado n = 314 semanas.
  • En la práctica: ~1.2 pozos/semana; P(X = 0) ≈ 34.91%; P(X ≥ 4) ≈ 5.39%.