Estadística Inferencial — Modelo de Probabilidad Discreto aplicado a la Finalización de Perforación (NY)
Eduardo Loayza
2026-07-18
1 Introducción y Metodología
Se retoma la variable Década de Finalización de perforación (Completion Year/Month/Day) de los pozos de petróleo y gas de Nueva York, ahora desde la estadística inferencial: se propone y valida un modelo de probabilidad discreto mediante la prueba de bondad de ajuste de Pearson (Chi-cuadrado).
Variable redefinida:
X = N° de pozos cuya perforación fue completada por semana calendario, periodo 2020-01-01 – 2025-12-31.
Se usa escala semanal y se acota a 2020-2025 por ser el tramo más reciente y estable, evitando heterogeneidad de periodos anteriores (auges/caídas históricas del sector).
Selección del modelo: en lugar de asumir a priori una única distribución (Poisson), el modelo de probabilidad se elige a partir de la forma real de los datos, usando la razón Varianza/Media como criterio, y comparando candidatos por su ajuste real (menor Chi-cuadrado) cuando hay más de uno plausible. Este es el mismo algoritmo de selección y contraste usado en el análisis de Fecha de Estado — Tres Agrupaciones:
- Razón Varianza/Media < 0.85 → Binomial (dispersión menor a la esperada bajo aleatoriedad pura).
- Razón Varianza/Media entre 0.85 y 1.15 → Poisson (equidispersión: varianza ≈ media).
- Razón Varianza/Media > 1.15 → sobredispersión: se ajustan Geométrica y Binomial Negativa por método de momentos y se elige la de menor discrepancia observada-esperada.
Además del Chi-cuadrado clásico, se reporta el tamaño del efecto (W de Cohen), que permite interpretar si una discrepancia estadísticamente significativa es también relevante en la práctica (relevante cuando N es grande, como puede ocurrir aquí con datos semanales de 6 años).
2 Carga de Librerías
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).csvcat("Columnas detectadas:", ncol(Datos_Brutos), "| Registros totales cargados:", nrow(Datos_Brutos), "\n")## Columnas detectadas: 55 | Registros totales cargados: 474074 Extracción y Preparación de la Variable
El dataset puede traer la fecha de finalización de dos formas según
la versión de descarga: (A) separada en tres columnas
Completion Year / Completion Month /
Completion Day, o (B) en un solo campo de fecha tipo
Date Well Completed. Se detectan las columnas por
patrón (no por nombre fijo) para que el script funcione sin
importar pequeñas diferencias de nombre (espacios extra, mayúsculas,
etc.).
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.Dayif (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## Periodo: 2019-12-29 a 2025-12-28## Número de semanas observadas (n): 314## Media (x̄): 1.2006## Varianza: 1.5539## Razón varianza/media: 1.294## Asimetría: 1.46 | Curtosis: 6.44585 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
Al tratarse de una variable discreta de conteo (no de intervalos de clase), se usa un gráfico de barras —el análogo discreto del histograma— para observar la forma de la distribución semanal.
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
En vez de fijar la Poisson como único modelo posible, se aplica el mismo algoritmo de selección usado en el análisis de Fecha de Estado — Tres Agrupaciones: el modelo se elige según la razón Varianza/Media de los datos, y en caso de sobredispersión fuerte se comparan Geométrica y Binomial Negativa por su ajuste real. Para la prueba de Chi-cuadrado, las clases se agrupan cuando FEi < 5 (regla de Cochran), tanto en la cola derecha como en la izquierda si corresponde.
# --- 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** porque la dispersión observada es menor a la esperada bajo un ",
"proceso puramente aleatorio (razón Varianza/Media = ", round(razon, 3), " < 1). Esto es ",
"típico de un número acotado de \"intentos\" por semana con una probabilidad de ocurrencia ",
"relativamente estable."),
"Poisson" = paste0(
"Se eligió **Poisson** porque la varianza y la media de la variable son similares (razón ",
"Varianza/Media = ", round(razon, 3), " ≈ 1), lo cual es característico de un conteo de ",
"eventos independientes (finalizaciones) que ocurren a una tasa aproximadamente constante ",
"en el tiempo."),
"Geometrica" = paste0(
"Se eligió **Geométrica** porque la dispersión observada supera claramente a la esperada ",
"bajo un proceso Poisson (razón Varianza/Media = ", round(razon, 3), " > 1), lo cual sugiere ",
"que la tasa semanal no es constante en el periodo."),
"BinomialNegativa" = paste0(
"Se eligió **Binomial Negativa** porque, ante la sobredispersión detectada (razón ",
"Varianza/Media = ", round(razon, 3), " > 1), este modelo permite un parámetro adicional de ",
"forma (size) que absorbe mejor los saltos irregulares entre semanas que la Geométrica ",
"(comparadas ambas por su ajuste real, se seleccionó la de menor discrepancia observada-",
"esperada). Es consistente con un proceso de conteo donde la tasa de finalización no es ",
"constante, sino que varía por episodios (auges/caídas de actividad de perforación).")
)
}
# --- 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 porque, ante la sobredispersión detectada (razón Varianza/Media = 1.294 > 1), este modelo permite un parámetro adicional de forma (size) que absorbe mejor los saltos irregulares entre semanas que la Geométrica (comparadas ambas por su ajuste real, se seleccionó la de menor discrepancia observada-esperada). Es consistente con un proceso de conteo donde la tasa de finalización no es constante, sino que varía por episodios (auges/caídas de actividad de perforación).
## 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.0310367.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
El siguiente gráfico compara la función de probabilidad acumulada empírica de los datos con la CDF teórica del modelo BinomialNegativa seleccionado. Cuanto más se superpongan ambas curvas escalonadas, mejor es el ajuste del modelo.
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)
## Correlación de Pearson (%) = 99.889 Test de Chi-Cuadrado y Tamaño del Efecto (W de Cohen)
Se contrasta:
- H0: X se distribuye según el modelo BinomialNegativa seleccionado — el modelo propuesto es adecuado.
- Ha: X no se distribuye según ese modelo — el modelo propuesto no es adecuado.
\[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}\]
donde k es el número de clases y m el número de parámetros estimados a partir de los datos (2 en este caso, para el modelo BinomialNegativa). El W de Cohen mide el tamaño del efecto de la discrepancia observado-esperado, de forma independiente al tamaño muestral n — relevante aquí porque n = 314 semanas es un N considerable y el Chi-cuadrado clásico gana potencia estadística 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## Chi-cuadrado calculado (X² calc): 1.0024## Número de clases (k): 6 | Parámetros estimados (m): 2## Grados de libertad (gl = k - 1 - m): 3## Chi-cuadrado crítico (alpha = 0.05): 7.8147## p-value = 0.8007## 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 observados ",
"(X² = ", round(res$chi2_stat, 3), " frente a un crítico de ", round(res$chi2_crit, 3),
"; p = ", format.pval(res$p_value, digits = 4), "). Con n = ", res$n, " semanas observadas, ",
"el test de Chi-cuadrado conserva una potencia estadística alta: incluso desviaciones ",
"pequeñas entre lo observado y lo esperado producen un p-value muy bajo. El rechazo no se ",
"interpreta aquí de forma aislada, sino junto con el **tamaño del efecto (W de Cohen = ",
round(res$w_cohen, 3), ")**, que es de magnitud **", magnitud_w, "**. Esto ayuda a distinguir ",
"si la discrepancia observado-esperado es sustantiva o si es un rechazo esperable dado el ",
"volumen de datos."
))
} else {
cat(paste0(
"El modelo **", res$modelo, "** se ajusta adecuadamente a los datos observados ",
"(X² = ", round(res$chi2_stat, 3), ", p = ", format.pval(res$p_value, digits = 4), " > 0.05). ",
"El tamaño del efecto (W de Cohen = ", round(res$w_cohen, 3), ") es **", magnitud_w, "**, lo ",
"que confirma que la discrepancia observado-esperado es mínima también en términos prácticos."
))
}El modelo BinomialNegativa se ajusta adecuadamente a los datos observados (X² = 1.002, p = 0.8007 > 0.05). El tamaño del efecto (W de Cohen = 0.057) es trivial, lo que confirma que la discrepancia observado-esperado es 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), "** | ",
"**W de Cohen = ", round(res$w_cohen, 4), "** | ",
"**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
- Selección del modelo: con razón Varianza/Media = 1.294, el algoritmo de selección (el mismo usado en Fecha de Estado — Tres Agrupaciones) eligió BinomialNegativa como distribución de X (size = 4.081, mu = 1.2006).
- Se eligió Binomial Negativa porque, ante la sobredispersión detectada (razón Varianza/Media = 1.294 > 1), este modelo permite un parámetro adicional de forma (size) que absorbe mejor los saltos irregulares entre semanas que la Geométrica (comparadas ambas por su ajuste real, se seleccionó la de menor discrepancia observada-esperada). Es consistente con un proceso de conteo donde la tasa de finalización no es constante, sino que varía por episodios (auges/caídas de actividad de perforación).
- Prueba de Pearson (Chi-cuadrado): X² calc = 1.0024 vs. X² 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 (magnitud trivial), lo que permite juzgar la discrepancia observado-esperado más allá del veredicto binario del Chi-cuadrado, especialmente con n = 314 semanas.
- En la práctica: ~1.2 pozos/semana en promedio; P(X = 0) ≈ 34.91%; P(X ≥ 4) ≈ 5.39%.