library(readr); library(dplyr); library(gt)
cat("Librerías cargadas correctamente.\n")
## Librerías cargadas correctamente.
ruta_csv <- file.choose()
datos <- read_csv(ruta_csv, show_col_types = FALSE)
cat("Archivo:", basename(ruta_csv), "| Filas:", nrow(datos), "\n")
## Archivo: oil_and_gas_leases_data (2).csv | Filas: 47757
Es una variable cualitativa ordinal: sus categorías
tienen un orden natural (NEW (Nuevo) <
MATURE (Maduro) < OLD (Antiguo)) pero no
son numéricas. Se les asigna un código de orden (Asignación) 1, 2,
3.
niveles_orden <- c("NEW", "MATURE", "OLD")
niveles_es <- c("Nuevo", "Maduro", "Antiguo") # etiquetas en español para mostrar
x_raw <- datos %>%
mutate(ESTADO = factor(LIFE_STAGE, levels = niveles_orden, ordered = TRUE)) %>%
filter(!is.na(ESTADO)) %>%
pull(ESTADO)
n_conteo <- length(x_raw)
k_niveles <- length(niveles_orden)
cat("Observaciones válidas:", n_conteo, "\n")
## Observaciones válidas: 47757
cat("Categorías (orden natural):", k_niveles, "\n")
## Categorías (orden natural): 3
cat("Niveles:", paste(niveles_orden, collapse = " < "), "\n")
## Niveles: NEW < MATURE < OLD
x <- x_raw
n <- length(x)
freq_abs <- as.integer(table(x))
hi_dec <- freq_abs / n
asignacion <- seq_along(niveles_orden)
data.frame(Asignacion = asignacion, Categoria = niveles_es,
ni = freq_abs, hi_pct = round(hi_dec * 100, 2),
stringsAsFactors = FALSE) %>%
gt() %>%
tab_header(title = md("**TABLA N\u00b0 1: DISTRIBUCIÓN DE FRECUENCIAS DE LA ETAPA DE VIDA**")) %>%
cols_label(Asignacion = md("**Asignación**"), Categoria = md("**Etapa de Vida**"),
ni = md("**ni**"), hi_pct = md("**hi (%)**")) %>%
tab_style(style = cell_text(color = "#333333", weight = "bold"),
locations = cells_body(columns = Asignacion)) %>%
tab_style(style = cell_text(color = "#666666", weight = "bold"),
locations = cells_body(columns = Categoria)) %>%
cols_align(align = "center", columns = c(Asignacion, ni, hi_pct)) %>%
cols_align(align = "left", columns = Categoria) %>%
tab_source_note(source_note = md("*Autor: Fernando Almeida*")) %>%
tab_options(table.width = pct(100), table.font.size = px(13), data_row.padding = px(6))
| TABLA N° 1: DISTRIBUCIÓN DE FRECUENCIAS DE LA ETAPA DE VIDA | |||
| Asignación | Etapa de Vida | ni | hi (%) |
|---|---|---|---|
| 1 | Nuevo | 11615 | 24.32 |
| 2 | Maduro | 20939 | 43.84 |
| 3 | Antiguo | 15203 | 31.83 |
| Autor: Fernando Almeida | |||
grises <- gray(seq(0.30, 0.75, length.out = k_niveles))
par(mar = c(5, 6, 6, 2))
bp <- barplot(hi_dec, names.arg = niveles_es, col = grises, border = "black",
las = 1, ylim = c(0, max(hi_dec) * 1.2), ylab = "", xlab = "")
mtext("Probabilidad", side = 2, line = 4.2, cex = 1)
mtext("Etapa de Vida", side = 1, line = 3, cex = 1)
mtext("Distribución de la Etapa de Vida", side = 3, line = 1.5, cex = 1, font = 2)
text(bp, hi_dec, labels = paste0(round(hi_dec * 100, 2), "%"), pos = 3, cex = 0.9)
Basado en el gráfico se conjetura un modelo Binomial, interpretando que se ve un pico más grande siendo el carácter maduro y 2 picos adyacentes más bajos siendo nuevo y antiguo.
cat("Código promedio (k_barra):", round(k_media, 4), "\n")
## Código promedio (k_barra): 1.0751
cat("p estimado (MLE):", round(p_hat, 4), "\n")
## p estimado (MLE): 0.5376
data.frame(Categoria = niveles_es,
p_H0 = round(p_binomial, 4),
p_observada = round(hi_dec, 4))
## Categoria p_H0 p_observada
## NEW Nuevo 0.2138 0.2432
## MATURE Maduro 0.4972 0.4384
## OLD Antiguo 0.2890 0.3183
comparacion <- rbind(Observado = hi_dec, `Modelo Binomial` = p_binomial)
par(mar = c(5, 6, 6, 2))
bp2 <- barplot(comparacion, beside = TRUE,
col = c(gray(0.35), gray(0.75)),
border = "black", las = 1,
names.arg = niveles_es,
ylim = c(0, max(comparacion) * 1.25),
ylab = "", xlab = "")
mtext("Probabilidad", side = 2, line = 4.2, cex = 1)
mtext("Etapa de Vida", side = 1, line = 3, cex = 1)
mtext("Frecuencia Observada en función del Modelo Binomial Teórico", side = 3, line = 1.5, cex = 1, font = 2)
text(bp2, comparacion, labels = paste0(round(comparacion * 100, 1), "%"), pos = 3, cex = 0.8)
legend("topright", legend = c("Observado", "Modelo Binomial"),
fill = c(gray(0.35), gray(0.75)), bty = "n", cex = 0.9)
Nota: en el segundo gráfico, barras grises oscuras = frecuencia real observada; barras grises claras = probabilidad teórica del modelo Binomial (\(\hat{p}=\) 0.5376). Entre más parecidas las alturas de cada par, mejor el ajuste.
Se valida el modelo con dos criterios, igual que en los archivos de zonas geográficas: la correlación de Pearson entre las frecuencias observadas y las teóricas, y una prueba Chi-Cuadrado de Bondad de Ajuste. Dado el tamaño muestral
# Correlación de Pearson entre hi observado y p teórico (modelo Binomial)
pearson_r <- cor(hi_dec, p_binomial) * 100
# Chi-Cuadrado sobre submuestra (p_hat ya estimado con la población completa,
# por lo que no se resta grado de libertad adicional: GL = k - 1)
set.seed(42)
n_samp <- 100
muestra <- sample(x, size = n_samp, replace = FALSE)
freq_samp <- as.integer(table(factor(muestra, levels = niveles_orden)))
prueba_chi <- chisq.test(x = freq_samp, p = p_binomial)
chi_stat <- unname(prueba_chi$statistic)
chi_gl <- unname(prueba_chi$parameter)
chi_pval <- prueba_chi$p.value
val_pearson <- ifelse(pearson_r > 70, "APROBADO", "RECHAZADO")
val_chi <- ifelse(chi_pval > 0.05, "APROBADO", "RECHAZADO")
bind_rows(
data.frame(Prueba = "Correlación de Pearson (hi vs. p teórico)",
Estadistico = round(pearson_r, 2), GL = NA_integer_,
p_valor = NA_real_, Validacion = val_pearson, stringsAsFactors = FALSE),
data.frame(Prueba = paste0("Chi-Cuadrado (submuestra n=", n_samp, ")"),
Estadistico = round(chi_stat, 4), GL = chi_gl,
p_valor = round(chi_pval, 4), Validacion = val_chi, stringsAsFactors = FALSE)
) %>%
gt() %>%
tab_header(
title = md("**Tabla N\u00b0 2: Validación de la Conjetura (Modelo Binomial)**"),
subtitle = md(paste0("*p\u0302 = ", round(p_hat, 4), " — Etapa de Vida*"))
) %>%
cols_label(Prueba = md("**Prueba**"), Estadistico = md("**Estadístico**"),
GL = md("**G.L.**"), p_valor = md("**p-valor**"), Validacion = md("**Validación**")) %>%
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")),
locations = cells_title(groups = "title")) %>%
tab_style(style = cell_text(color = "#000000", weight = "bold"),
locations = cells_body(columns = Validacion, rows = Validacion == "APROBADO")) %>%
tab_style(style = cell_text(color = "#8A8A8A", weight = "bold"),
locations = cells_body(columns = Validacion, rows = Validacion == "RECHAZADO")) %>%
cols_align(align = "center", columns = c(Estadistico, GL, p_valor, Validacion)) %>%
cols_align(align = "left", columns = Prueba) %>%
fmt_missing(columns = everything(), missing_text = "-") %>%
tab_source_note(source_note = md("*Autor: Fernando Almeida*")) %>%
tab_options(table.width = pct(90), table.font.size = px(13),
heading.title.font.size = px(16), heading.subtitle.font.size = px(12),
data_row.padding = px(6),
column_labels.border.top.width = px(2),
column_labels.border.bottom.width = px(2),
table_body.border.bottom.width = px(2),
table.border.top.style = "hidden", table.border.bottom.style = "hidden")
| Tabla N° 2: Validación de la Conjetura (Modelo Binomial) | ||||
| p̂ = 0.5376 — Etapa de Vida | ||||
| Prueba | Estadístico | G.L. | p-valor | Validación |
|---|---|---|---|---|
| Correlación de Pearson (hi vs. p teórico) | 99.1200 | - | - | APROBADO |
| Chi-Cuadrado (submuestra n=100) | 1.2686 | 2 | 0.5303 | APROBADO |
| Autor: Fernando Almeida | ||||
En una variable cualitativa el parámetro poblacional de interés es
una proporción. Se estima la proporción de pozos en
estado OLD (Antiguo), por ser la categoría de mayor
relevancia (pozos al final de su vida útil):
\[P(\hat{p} - E < p < \hat{p} + E) \approx 95\%\]
categoria_interes <- "OLD"
p_hat_ic <- hi_dec[niveles_orden == categoria_interes]
n_total <- n
z_95 <- 1.96
error_est <- sqrt(p_hat_ic * (1 - p_hat_ic) / n_total)
margen <- z_95 * error_est
lim_inf_ic <- max(0, p_hat_ic - margen)
lim_sup_ic <- min(1, p_hat_ic + margen)
data.frame(
Parametro = paste0("Proporción Estado '", niveles_es[niveles_orden == categoria_interes], "'"),
Lim_Inferior = round(lim_inf_ic, 4),
Proporcion_Muestral = round(p_hat_ic, 4),
Lim_Superior = round(lim_sup_ic, 4),
Error_Estandar = paste0("+/- ", round(margen, 4)),
Confianza = "95% (Z=1.96)",
stringsAsFactors = FALSE
) %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00b0 3: ESTIMACIÓN DE LA PROPORCIÓN POBLACIONAL**"),
subtitle = md("*Inferencia Estadística para la Etapa de Vida*")
) %>%
cols_label(
Parametro = md("**Parámetro**"),
Lim_Inferior = md("**Lim_Inferior**"),
Proporcion_Muestral = md("**Proporción_Muestral**"),
Lim_Superior = md("**Lim_Superior**"),
Error_Estandar = md("**Error_Estándar**"),
Confianza = md("**Confianza**")
) %>%
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")),
locations = cells_title(groups = "title")) %>%
tab_style(style = list(cell_fill(color = "#E8E8E8"), cell_text(weight = "bold")),
locations = cells_body(columns = Proporcion_Muestral)) %>%
tab_style(style = cell_borders(sides = "bottom", color = "#E0E0E0", weight = px(1)),
locations = cells_body(rows = everything())) %>%
cols_align(align = "center", columns = c(Lim_Inferior, Proporcion_Muestral, Lim_Superior, Error_Estandar, Confianza)) %>%
cols_align(align = "left", columns = Parametro) %>%
tab_source_note(source_note = md("*Autor: Fernando Almeida*")) %>%
tab_options(table.width = pct(100), table.font.size = px(13),
heading.title.font.size = px(16), heading.subtitle.font.size = px(12),
data_row.padding = px(6),
column_labels.border.top.width = px(2),
column_labels.border.bottom.width = px(2),
table_body.border.bottom.width = px(2),
table.border.top.style = "hidden", table.border.bottom.style = "hidden")
| TABLA N° 3: ESTIMACIÓN DE LA PROPORCIÓN POBLACIONAL | |||||
| Inferencia Estadística para la Etapa de Vida | |||||
| Parámetro | Lim_Inferior | Proporción_Muestral | Lim_Superior | Error_Estándar | Confianza |
|---|---|---|---|---|---|
| Proporción Estado 'Antiguo' | 0.3142 | 0.3183 | 0.3225 | +/- 0.0042 | 95% (Z=1.96) |
| Autor: Fernando Almeida | |||||
Se trabajó con la variable cualitativa ordinal Etapa de
Vida (LIFE_STAGE), con un rango que fluctúa entre
Nuevo < Maduro < Antiguo. Se aplicó un modelo
Binomial; al realizar una prueba de Pearson se obtuvo
99.12% y la prueba Chi-Cuadrado sobre una submuestra (n=100) obtuvo un
valor estadístico de 1.2686 con 2 grado(s) de libertad y un p-valor de
0.5303, lo que demuestra que el modelo infiere correctamente la muestra
en la población.
Autor: Fernando Almeida — Análisis Estadístico, Kansas Hydrocarbon Leases Dataset