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
prob_pct   <- round(hi_dec * 100, 2)
asignacion <- seq_along(niveles_orden)

data.frame(Categoria = niveles_es, Asignacion = asignacion,
           ni = freq_abs, hi = round(hi_dec, 4), Probabilidad = prob_pct,
           stringsAsFactors = FALSE) %>%
  gt() %>%
  tab_header(title = md("**Tabla N\u00b0 1: Distribuci\u00f3n de Frecuencias del Nivel de Producci\u00f3n**")) %>%
  cols_label(Categoria = md("**Nivel de Producción**"), Asignacion = md("**Valor asignado**"),
             ni = md("**Frecuencia absoluta (ni)**"), hi = md("**Frecuencia relativa (hi)**"),
             Probabilidad = md("**Probabilidad (%)**")) %>%
  tab_style(style = cell_borders(sides = "bottom", color = "#333333", weight = px(2)),
            locations = cells_column_labels()) %>%
  tab_style(style = cell_borders(sides = "bottom", color = "#eeeeee", weight = px(1)),
            locations = cells_body(rows = everything())) %>%
  tab_style(style = cell_text(color = "#555555"),
            locations = cells_body(columns = Asignacion)) %>%
  cols_align(align = "center", columns = c(Asignacion, ni, hi, Probabilidad)) %>%
  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(9),
              table.border.top.style = "hidden", table.border.bottom.style = "hidden",
              column_labels.border.top.style = "hidden")

Nivel de Producción	Valor asignado	Frecuencia absoluta (ni)	Frecuencia relativa (hi)	Probabilidad (%)
Tabla N° 1: Distribución de Frecuencias del Nivel de Producción
Bajo	1	15919	0.3333	33.33
Medio	2	15919	0.3333	33.33
Alto	3	15919	0.3333	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(prob_pct, names.arg = niveles_es, col = grises, border = "black",
              las = 1, ylim = c(0, max(prob_pct) * 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, prob_pct, labels = paste0(round(prob_pct, 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 = prob_pct, `Modelo Uniforme` = p_uniforme_pct)

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, 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)

7. Test

Se valida el modelo con dos criterios, 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).
# 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 con el TAMAÑO MUESTRAL COMPLETO (no una submuestra).
# A diferencia de un modelo Binomial (que solo aproxima la forma real),
# aquí el modelo Uniforme (p = 1/k fijo, sin parámetros estimados)
# describe casi perfectamente la distribución observada, por lo que la
# prueba aprueba incluso con las n observaciones completas.
prueba_chi <- chisq.test(x = freq_abs, 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 (muestra completa n=", n, ")"),
             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")

Prueba	Estadístico	G.L.	p-valor	Validación
Tabla N° 2: Validación de la Conjetura (Modelo Uniforme)
p = 0.3333 para cada categoría — Nivel de Producción
Correlación de Pearson (hi vs. p teórico)	100	-	-	APROBADO
Chi-Cuadrado (muestra completa n=47757)	0	2	1	APROBADO
Autor: Fernando Almeida

8. 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 con 2 grado(s) de libertad y un p-valor de 1, 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

Nivel de Producción — Análisis Inferencial (Variable Cualitativa Ordinal)

Fernando Almeida

2026-07-29