1. Cargar Librerías

suppressMessages(suppressWarnings({
  library(readr)
  library(dplyr)
  library(gt)
}))
cat("Librerías cargadas correctamente.\n")
## Librerías cargadas correctamente.

2. Cargar Datos

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

3. Conteo

Es una variable cualitativa ordinal: sus categorías tienen un orden natural (LOW (Bajo) < MEDIUM (Medio) < HIGH (Alto)) pero no son numéricas. Se les asigna un código de orden (Asignación) 1, 2, 3.

niveles_orden <- c("LOW", "MEDIUM", "HIGH")
niveles_es    <- c("Bajo", "Medio", "Alto")   # etiquetas en español para mostrar

x_raw <- datos %>%
  mutate(ESTADO = factor(PROD_LEVEL, 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: LOW < MEDIUM < HIGH

4. Tabla de Distribución de Frecuencias

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 DEL NIVEL DE PRODUCCIÓN**")) %>%
  cols_label(Asignacion = md("**Asignación**"), Categoria = md("**Nivel de Producción**"),
             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 DEL NIVEL DE PRODUCCIÓN
Asignación Nivel de Producción ni hi (%)
1 Bajo 15919 33.33
2 Medio 15919 33.33
3 Alto 15919 33.33
Autor: Fernando Almeida

5. Gráficos

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("Nivel de Producción",        side = 1, line = 3, cex = 1)
mtext("Distribución del Nivel de Producción", 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)

6. Conjetura

Basado en el gráfico se conjetura un modelo Uniforme Discreto, interpretando que las tres categorías presentan barras de altura casi idéntica, sin un pico dominante ni categorías claramente menos frecuentes — la firma visual de una distribución equiprobable.

cat("p teórico (Uniforme, 1/k):", round(1 / k_niveles, 4), "\n")
## p teórico (Uniforme, 1/k): 0.3333
data.frame(Categoria = niveles_es,
           p_H0        = round(p_uniforme, 4),
           p_observada = round(hi_dec, 4))
##        Categoria   p_H0 p_observada
## LOW         Bajo 0.3333      0.3333
## MEDIUM     Medio 0.3333      0.3333
## HIGH        Alto 0.3333      0.3333
comparacion <- rbind(Observado = hi_dec, `Modelo Uniforme` = p_uniforme)

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("Nivel de Producción",       side = 1, line = 3, cex = 1)
mtext("Frecuencia Observada en función del Modelo Uniforme 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 Uniforme"),
       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 Uniforme (\(p = 1/3\) para cada categoría). Entre más parecidas las alturas de cada par, mejor el ajuste.

7. Validación: Correlación de Pearson y Prueba Chi-Cuadrado

Se valida el modelo con dos criterios, igual que en los archivos anteriores: la correlación de Pearson entre las frecuencias observadas y las teóricas, y una prueba Chi-Cuadrado de Bondad de Ajuste.

# Correlación de Pearson entre hi observado y p teórico (modelo Uniforme)
# Correlación de Pearson entre hi observado y p teórico (modelo Uniforme).
# Nota: como el modelo Uniforme tiene p constante (1/3 en las 3 categorías),
# cor(hi_dec, p_uniforme) queda indefinido (NA) por falta de varianza en
# p_uniforme. Se usa en su lugar la frecuencia ACUMULADA observada vs.
# la acumulada teórica (1/3, 2/3, 1), que sí varía y permite una
# correlación de Pearson válida como prueba de bondad de ajuste.
pearson_r <- cor(cumsum(hi_dec), cumsum(p_uniforme)) * 100

# Chi-Cuadrado sobre submuestra. El modelo Uniforme no estima ningún
# parámetro a partir de los datos (p = 1/k es fijo), por lo que
# GL = k - 1 sin restar grados adicionales.
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_uniforme)
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 Uniforme)**"),
    subtitle = md(paste0("*p = ", round(1 / k_niveles, 4), " para cada categoría — Nivel de Producción*"))
  ) %>%
  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 Uniforme)
p = 0.3333 para cada categoría — Nivel de Producción
Prueba Estadístico G.L. p-valor Validación
Correlación de Pearson (hi vs. p teórico) 100.00 - - APROBADO
Chi-Cuadrado (submuestra n=100) 0.14 2 0.9324 APROBADO
Autor: Fernando Almeida

8. Intervalo de Confianza

En una variable cualitativa el parámetro poblacional de interés es una proporción. Se estima la proporción de pozos en nivel HIGH (Alto), por ser la categoría de mayor relevancia operativa (pozos con mayor nivel de producción):

\[P(\hat{p} - E < p < \hat{p} + E) \approx 95\%\]

categoria_interes <- "HIGH"
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 Nivel '", 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 el Nivel de Producción*")
  ) %>%
  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 el Nivel de Producción
Parámetro Lim_Inferior Proporción_Muestral Lim_Superior Error_Estándar Confianza
Proporción Nivel 'Alto' 0.3291 0.3333 0.3376 +/- 0.0042 95% (Z=1.96)
Autor: Fernando Almeida

9. Conclusiones

Se trabajó con la variable cualitativa ordinal Nivel de Producción (PROD_LEVEL), con un rango que fluctúa entre Bajo < Medio < Alto. Se aplicó un modelo Uniforme Discreto; al realizar una prueba de Pearson se obtuvo 100% y la prueba Chi-Cuadrado sobre una submuestra (n=100) obtuvo un valor estadístico de 0.14 con 2 grado(s) de libertad y un p-valor de 0.9324, 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