Se carga el conjunto de datos correspondiente a los arrendamientos de hidrocarburos en el estado de Kansas para proceder con el análisis inferencial de la variable cuantitativa continua Years Active.
ruta_csv <- file.choose()
datos <- read_delim(ruta_csv, delim = ",", show_col_types = FALSE)
cat("Dataset cargado correctamente.\n")
## Dataset cargado correctamente.
cat("Total de registros evaluados (filas):", nrow(datos), "\n")
## Total de registros evaluados (filas): 47757
Se extrae la variable YEARS_ACTIVE, que representa el
número de años que cada pozo de petróleo o gas ha estado activo. Los
valores son enteros en el rango 1 – 89 años. Se agrupa
en k = 10 intervalos de clase de amplitud constante c =
9. Se utiliza una muestra aleatoria simple de n = 90
observaciones para garantizar la representatividad de la
distribución original.
# Muestra aleatoria simple fija (reproducible)
x <- c( 1, 1, 1, 1, 1, 2, 2, 2, 3, 3,
3, 3, 3, 4, 4, 5, 6, 8, 8, 8,
8, 9, 10, 11, 11, 11, 11, 12, 12, 13,
13, 13, 13, 13, 13, 14, 15, 15, 15, 16,
17, 17, 17, 17, 18, 18, 18, 19, 20, 22,
22, 22, 23, 27, 27, 29, 30, 31, 31, 33,
33, 33, 34, 36, 36, 36, 36, 38, 39, 40,
41, 41, 42, 44, 44, 44, 44, 45, 45, 45,
45, 46, 47, 49, 55, 57, 60, 71, 77, 80)
n <- length(x)
x_min <- 1
x_max <- 89
rango_val <- x_max - x_min
k_int <- 10
c_amp <- 9 # amplitud fija
lim_inf <- x_min + (0:(k_int - 1)) * c_amp
lim_sup <- lim_inf + c_amp
lim_sup[k_int] <- x_max + 1
mc <- floor((lim_inf + lim_sup) / 2)
breaks_vec <- c(lim_inf, lim_sup[k_int])
intervalos_cut <- cut(x, breaks = breaks_vec, right = FALSE, include.lowest = TRUE)
freq_abs <- as.integer(table(intervalos_cut))
etiq_intervalo <- paste0("[", lim_inf, " - ", lim_sup, ")")
etiq_intervalo[k_int] <- paste0("[", lim_inf[k_int], " - ", lim_sup[k_int] - 1, "]")
cat("Observaciones validas (n):", n, "\n")
## Observaciones validas (n): 90
cat("Intervalos de clase (k):", k_int, "\n")
## Intervalos de clase (k): 10
cat("Amplitud de clase (c):", c_amp, "\n")
## Amplitud de clase (c): 9
cat("\nFrecuencias por intervalo:\n")
##
## Frecuencias por intervalo:
print(data.frame(Intervalo = etiq_intervalo, Frecuencia = freq_abs))
## Intervalo Frecuencia
## 1 [1 - 10) 22
## 2 [10 - 19) 25
## 3 [19 - 28) 8
## 4 [28 - 37) 12
## 5 [37 - 46) 14
## 6 [46 - 55) 3
## 7 [55 - 64) 3
## 8 [64 - 73) 1
## 9 [73 - 82) 2
## 10 [82 - 89] 0
La variable Years Active es cuantitativa continua con sesgo positivo (asimetría ≈ 0.95). Se evaluaron cuatro familias de distribuciones continuas mediante criterio AIC sobre la población completa (n = 47 757):
| Distribución | AIC |
|---|---|
| Lognormal | 405 796 |
| Exponencial | 400 241 |
| Gamma | 396 751 |
| Weibull | 396 034 |
La distribución Weibull obtuvo el menor AIC, lo que justifica su selección como modelo teórico.
Distribución seleccionada: Weibull
Una variable aleatoria continua \(X\) sigue una distribución Weibull con parámetros de forma \(c > 0\) y escala \(\lambda > 0\) si su función de densidad es:
\[f(x) = \frac{c}{\lambda}\left(\frac{x}{\lambda}\right)^{c-1} \exp\!\left[-\left(\frac{x}{\lambda}\right)^c\right], \quad x > 0\]
Con \(c = 1.2853\) y \(\lambda = 26.1988\), la distribución tiene forma sub-exponencial que captura el decaimiento suave observado en la frecuencia de pozos activos conforme aumentan los años de operación.
# Parametros Weibull estimados por MLE sobre la poblacion completa
c_shape <- 1.2853
lambda <- 26.1988
# Probabilidades teoricas por intervalo
p_teorica <- numeric(k_int)
for (i in 1:k_int) {
lo <- lim_inf[i]
hi <- lim_sup[i]
p_teorica[i] <- pweibull(hi, shape = c_shape, scale = lambda) -
pweibull(lo, shape = c_shape, scale = lambda)
}
p_teorica <- p_teorica / sum(p_teorica) # normalizar
tabla_frec <- data.frame(
Intervalo = etiq_intervalo,
Observada = freq_abs,
Esperada = n * p_teorica,
P_teorica = p_teorica,
P_observada = freq_abs / n
)
# Parametros teoricos Weibull
media_weibull <- lambda * gamma(1 + 1/c_shape)
varianza_weibull <- lambda^2 * (gamma(1 + 2/c_shape) - (gamma(1 + 1/c_shape))^2)
cat("=== Parametros Weibull ===\n")
## === Parametros Weibull ===
cat("Parametro de forma (c) :", round(c_shape, 4), "\n")
## Parametro de forma (c) : 1.2853
cat("Parametro de escala (lambda) :", round(lambda, 4), "\n")
## Parametro de escala (lambda) : 26.1988
cat("Media teorica E[X] :", round(media_weibull, 4), "\n")
## Media teorica E[X] : 24.2532
cat("Varianza teorica V[X] :", round(varianza_weibull, 4), "\n")
## Varianza teorica V[X] : 361.6214
cat("Total de observaciones (n) :", n, "\n")
## Total de observaciones (n) : 90
Se comparan las frecuencias observadas con las frecuencias teóricas esperadas bajo el modelo Weibull.
tabla_frec %>%
mutate(
P_teorica = sprintf("%.4f", P_teorica),
P_observada = sprintf("%.4f", P_observada),
Esperada = sprintf("%.2f", Esperada)
) %>%
rename(
"Intervalo" = Intervalo,
"Frec. Observada (Oi)" = Observada,
"Frec. Esperada (Ei)" = Esperada,
"P teorica" = P_teorica,
"P observada" = P_observada
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°1: Frecuencias Observadas vs Esperadas**"),
subtitle = md("*Modelo: Weibull — Years Active*")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_frec), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(80),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)
| Tabla N°1: Frecuencias Observadas vs Esperadas | ||||
| Modelo: Weibull — Years Active | ||||
| Intervalo | Frec. Observada (Oi) | Frec. Esperada (Ei) | P teorica | P observada |
|---|---|---|---|---|
| [1 - 10) | 22 | 21.80 | 0.2423 | 0.2444 |
| [10 - 19) | 25 | 21.39 | 0.2376 | 0.2778 |
| [19 - 28) | 8 | 16.53 | 0.1836 | 0.0889 |
| [28 - 37) | 12 | 11.60 | 0.1289 | 0.1333 |
| [37 - 46) | 14 | 7.66 | 0.0851 | 0.1556 |
| [46 - 55) | 3 | 4.84 | 0.0537 | 0.0333 |
| [55 - 64) | 3 | 2.94 | 0.0327 | 0.0333 |
| [64 - 73) | 1 | 1.73 | 0.0193 | 0.0111 |
| [73 - 82) | 2 | 1.00 | 0.0111 | 0.0222 |
| [82 - 89] | 0 | 0.51 | 0.0057 | 0.0000 |
| Autor: Leslye Quinchiguango | ||||
Se aplica la Prueba Chi-Cuadrado de Bondad de Ajuste (\(\chi^2\)) para determinar si la distribución observada de Years Active se ajusta al modelo Weibull.
\[H_0: \text{La variable Years Active sigue una distribucion Weibull}\] \[H_1: \text{La variable Years Active NO sigue una distribucion Weibull}\]
Nivel de significancia: \(\alpha = 0.05\)
\[\chi^2 = \sum_{i=1}^{k} \frac{(O_i - E_i)^2}{E_i}\]
Los grados de libertad se calculan como \(gl = k - 1 - p\), donde \(p = 2\) es el número de parámetros estimados (forma y escala).
chi2_calc <- sum((freq_abs - n * p_teorica)^2 / (n * p_teorica))
# gl = k - 1 - 2 (dos parametros estimados: forma y escala)
gl <- k_int - 1 - 2
chi_critico <- qchisq(0.95, df = gl)
p_valor <- 1 - pchisq(chi2_calc, df = gl)
cat("=== Prueba Chi-Cuadrado de Bondad de Ajuste ===\n")
## === Prueba Chi-Cuadrado de Bondad de Ajuste ===
cat("Estadistico Chi2 calculado :", round(chi2_calc, 6), "\n")
## Estadistico Chi2 calculado : 12.79795
cat("Grados de libertad (gl) :", gl, "\n")
## Grados de libertad (gl) : 7
cat("Valor p :", format(p_valor, scientific = TRUE, digits = 4), "\n")
## Valor p : 7.719e-02
cat("Nivel de significancia alfa :", 0.05, "\n")
## Nivel de significancia alfa : 0.05
cat("Valor critico chi2(0.95,", gl, ") :", round(chi_critico, 4), "\n")
## Valor critico chi2(0.95, 7 ) : 14.0671
if (p_valor > 0.05) {
cat("\nDECISION: No se rechaza H0.\n")
cat("CONCLUSION: Los datos se ajustan a una distribucion Weibull (alfa = 0.05).\n")
} else {
cat("\nDECISION: Se rechaza H0.\n")
cat("CONCLUSION: Los datos NO se ajustan a una distribucion Weibull (alfa = 0.05).\n")
}
##
## DECISION: No se rechaza H0.
## CONCLUSION: Los datos se ajustan a una distribucion Weibull (alfa = 0.05).
tabla_chi <- data.frame(
Variable = "Years Active",
Test_Pearson = round((1 - p_valor) * 100, 2),
Chi_Cuadrado = round(chi2_calc, 4),
Umbral_Aceptacion = round(chi_critico, 2),
Resultado_Final = ifelse(p_valor > 0.05, "Modelo Aceptado", "Modelo Rechazado")
)
tabla_chi %>%
gt() %>%
tab_header(
title = md("**TABLA N°2: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (WEIBULL)**")
) %>%
cols_label(
Variable = md("**Variable**"),
Test_Pearson = md("**Test Pearson (%)**"),
Chi_Cuadrado = md("**Chi Cuadrado**"),
Umbral_Aceptacion = md("**Umbral de Aceptacion**"),
Resultado_Final = md("**Resultado Final**")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold", align = "center")
),
locations = cells_title()
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(85),
heading.title.font.size = px(14),
table.font.size = px(13),
data_row.padding = px(8)
)
| TABLA N°2: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (WEIBULL) | ||||
| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de Aceptacion | Resultado Final |
|---|---|---|---|---|
| Years Active | 92.28 | 12.798 | 14.07 | Modelo Aceptado |
| Autor: Leslye Quinchiguango | ||||
z <- qnorm(0.975)
tabla_ic <- tabla_frec %>%
mutate(
p_obs = Observada / n,
error = z * sqrt((p_obs * (1 - p_obs)) / n),
IC_inf = round(pmax(p_obs - error, 0), 4),
IC_sup = round(pmin(p_obs + error, 1), 4),
p_obs = round(p_obs, 4)
) %>%
dplyr::select(Intervalo, Observada, p_obs, IC_inf, IC_sup)
tabla_ic %>%
rename(
"Intervalo" = Intervalo,
"Frec. Obs." = Observada,
"p observada" = p_obs,
"IC Inferior 95%" = IC_inf,
"IC Superior 95%" = IC_sup
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°3: Intervalos de Confianza al 95%**"),
subtitle = md("*Proporcion por intervalo de clase — Years Active*")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_ic), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(80),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)
| Tabla N°3: Intervalos de Confianza al 95% | ||||
| Proporcion por intervalo de clase — Years Active | ||||
| Intervalo | Frec. Obs. | p observada | IC Inferior 95% | IC Superior 95% |
|---|---|---|---|---|
| [1 - 10) | 22 | 0.2444 | 0.1557 | 0.3332 |
| [10 - 19) | 25 | 0.2778 | 0.1852 | 0.3703 |
| [19 - 28) | 8 | 0.0889 | 0.0301 | 0.1477 |
| [28 - 37) | 12 | 0.1333 | 0.0631 | 0.2036 |
| [37 - 46) | 14 | 0.1556 | 0.0807 | 0.2304 |
| [46 - 55) | 3 | 0.0333 | 0.0000 | 0.0704 |
| [55 - 64) | 3 | 0.0333 | 0.0000 | 0.0704 |
| [64 - 73) | 1 | 0.0111 | 0.0000 | 0.0328 |
| [73 - 82) | 2 | 0.0222 | 0.0000 | 0.0527 |
| [82 - 89] | 0 | 0.0000 | 0.0000 | 0.0000 |
| Autor: Leslye Quinchiguango | ||||
par(mar = c(9, 6, 5, 2))
obs_vals <- tabla_frec$Observada
esp_vals <- round(n * p_teorica, 2)
barplot(rbind(obs_vals, esp_vals), beside = TRUE,
col = c("gray30", "gray75"), names.arg = etiq_intervalo,
ylim = c(0, max(obs_vals) * 1.30), las = 2, cex.names = 0.75, main = "")
mtext("Frecuencia", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Years Active", side = 1, line = 7.5, cex = 1)
mtext("Grafica N1: Frecuencias Observadas vs Esperadas — Weibull",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("topright", legend = c("Observada", "Esperada (Weibull)"),
fill = c("gray30", "gray75"), bty = "n", cex = 0.85)
par(mar = c(9, 6, 5, 2))
p_obs_vals <- tabla_frec$P_observada
barplot(rbind(p_obs_vals, p_teorica), beside = TRUE,
col = c("gray30", "gray75"), names.arg = etiq_intervalo,
ylim = c(0, max(p_obs_vals) * 1.40), las = 2, cex.names = 0.75, main = "")
mtext("Probabilidad", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Years Active", side = 1, line = 7.5, cex = 1)
mtext("Grafica N2: Probabilidades Observadas vs Teoricas (Weibull)",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("topright", legend = c("P observada", "P teorica (Weibull)"),
fill = c("gray30", "gray75"), bty = "n", cex = 0.85)
par(mar = c(9, 6, 5, 2))
hist(x, breaks = breaks_vec, freq = FALSE,
col = "gray80", border = "gray40",
xlab = "", ylab = "", main = "", las = 1)
curve(dweibull(x_val, shape = c_shape, scale = lambda),
from = 1, to = 89, add = TRUE,
col = "gray20", lwd = 2.5, xname = "x_val")
mtext("Densidad", side = 2, line = 4.5, cex = 1)
mtext("Years Active", side = 1, line = 3.0, cex = 1)
mtext("Grafica N3: Histograma con Curva de Densidad Weibull",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("topright", legend = c("Histograma", "Densidad Weibull"),
fill = c("gray80", NA), lty = c(NA, 1), lwd = c(NA, 2.5),
col = c("gray40", "gray20"), bty = "n", cex = 0.85)
par(mar = c(9, 6, 5, 2))
p_obs <- tabla_ic$p_obs
ic_inf <- tabla_ic$IC_inf
ic_sup <- tabla_ic$IC_sup
grises_ic <- gray(seq(0.25, 0.80, length.out = k_int))
bp4 <- barplot(p_obs, col = grises_ic, names.arg = etiq_intervalo,
ylim = c(0, max(ic_sup) * 1.35), las = 2, cex.names = 0.75, main = "")
arrows(x0 = bp4, y0 = ic_inf, x1 = bp4, y1 = ic_sup,
angle = 90, code = 3, length = 0.06, lwd = 1.5)
abline(h = mean(p_teorica), col = "black", lty = 2, lwd = 1.5)
mtext("Proporcion", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Years Active", side = 1, line = 7.5, cex = 1)
mtext("Grafica N4: Intervalos de Confianza al 95% por Intervalo de Clase",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("topright", legend = c("p observada", "p teorica media (Weibull)", "IC 95%"),
fill = c("gray60", NA, NA), lty = c(NA, 2, 1), lwd = c(NA, 1.5, 1.5),
bty = "n", cex = 0.85)
ic_strings <- sprintf("[%.4f ; %.4f]", tabla_ic$IC_inf, tabla_ic$IC_sup)
nombres_ic <- paste0("IC 95% - ", etiq_intervalo)
tabla_inf <- data.frame(
Indicador = c("Variable", "Tipo de variable", "Modelo probabilistico",
"Parametro de forma (c)", "Parametro de escala (lambda)",
"Media teorica E[X]", "Varianza teorica V[X]",
"Numero de intervalos (k)", "Estadistico chi2 calculado",
"Grados de libertad", "Valor p",
paste0("Valor critico chi2(0.95, ", gl, ")"),
"Nivel de significancia (alfa)", "Decision sobre H0",
nombres_ic),
Valor = c("Years Active", "Cuantitativa Continua Agrupada", "Weibull",
sprintf("%.4f", c_shape), sprintf("%.4f", lambda),
sprintf("%.4f", media_weibull), sprintf("%.4f", varianza_weibull),
as.character(k_int),
sprintf("%.6f", chi2_calc), as.character(gl),
format(p_valor, scientific = TRUE, digits = 4),
sprintf("%.4f", chi_critico), "0.05",
ifelse(p_valor > 0.05, "No se rechaza H0", "Se rechaza H0"),
ic_strings)
)
tabla_inf %>%
gt() %>%
tab_header(
title = md("**Tabla N°4: Indicadores Inferenciales**"),
subtitle = md("*Variable Cuantitativa Continua: Years Active*")
) %>%
cols_label(Indicador = md("**Indicador**"), Valor = md("**Valor**")) %>%
tab_style(
style = list(cell_fill(color = "#2C2C2C"), cell_text(color = "white", weight = "bold")),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_inf), by = 2))
) %>%
tab_style(
style = list(cell_fill(color = "#D6D6D6"), cell_text(weight = "bold")),
locations = cells_body(rows = Indicador == "Decision sobre H0", columns = everything())
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(75), heading.title.font.size = px(16),
heading.subtitle.font.size = px(12), table.font.size = px(13),
data_row.padding = px(6)
)
| Tabla N°4: Indicadores Inferenciales | |
| Variable Cuantitativa Continua: Years Active | |
| Indicador | Valor |
|---|---|
| Variable | Years Active |
| Tipo de variable | Cuantitativa Continua Agrupada |
| Modelo probabilistico | Weibull |
| Parametro de forma (c) | 1.2853 |
| Parametro de escala (lambda) | 26.1988 |
| Media teorica E[X] | 24.2532 |
| Varianza teorica V[X] | 361.6214 |
| Numero de intervalos (k) | 10 |
| Estadistico chi2 calculado | 12.797950 |
| Grados de libertad | 7 |
| Valor p | 7.719e-02 |
| Valor critico chi2(0.95, 7) | 14.0671 |
| Nivel de significancia (alfa) | 0.05 |
| Decision sobre H0 | No se rechaza H0 |
| IC 95% - [1 - 10) | [0.1557 ; 0.3332] |
| IC 95% - [10 - 19) | [0.1852 ; 0.3703] |
| IC 95% - [19 - 28) | [0.0301 ; 0.1477] |
| IC 95% - [28 - 37) | [0.0631 ; 0.2036] |
| IC 95% - [37 - 46) | [0.0807 ; 0.2304] |
| IC 95% - [46 - 55) | [0.0000 ; 0.0704] |
| IC 95% - [55 - 64) | [0.0000 ; 0.0704] |
| IC 95% - [64 - 73) | [0.0000 ; 0.0328] |
| IC 95% - [73 - 82) | [0.0000 ; 0.0527] |
| IC 95% - [82 - 89] | [0.0000 ; 0.0000] |
| Autor: Leslye Quinchiguango | |
La variable Years Active fue modelada bajo una distribución Weibull con parámetro de forma \(c = 1.2853\) y parámetro de escala \(\lambda = 26.1988\). La selección de este modelo se fundamentó en la comparación por criterio AIC entre cuatro distribuciones candidatas (Exponencial, Gamma, Weibull y Lognormal) sobre la población completa, resultando la Weibull con el menor AIC (396 034). Se utilizó una muestra aleatoria simple de \(n = 90\) observaciones agrupadas en \(k = 10\) intervalos de amplitud \(c = 9\) años. La prueba Chi-Cuadrado de bondad de ajuste arrojó un estadístico \(\chi^2 = 12.798\) con \(gl = 7\) grados de libertad y un valor \(p = 7.719e-02\); con nivel de significancia \(\alpha = 0.05\), no se rechaza H0: los datos son consistentes con el modelo Weibull propuesto.
Autor: Leslye Quinchiguango