1. Cargar Librerías

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 (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

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 de la Etapa de Vida**")) %>%
  cols_label(Categoria = md("**Etapa de Vida**"), 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")

Etapa de Vida	Valor asignado	Frecuencia absoluta (ni)	Frecuencia relativa (hi)	Probabilidad (%)
Tabla N° 1: Distribución de Frecuencias de la Etapa de Vida
Nuevo	1	11615	0.2432	24.32
Maduro	2	20939	0.4384	43.84
Antiguo	3	15203	0.3183	31.83
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("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, prob_pct, labels = paste0(round(prob_pct, 2), "%"), pos = 3, cex = 0.9)

6. Conjetura

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 = prob_pct, `Modelo Binomial` = p_binomial_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("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, 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)

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.

La prueba Chi-Cuadrado se calcula sobre una submuestra (n=100), no sobre las ~47,757 observaciones completas: con una muestra tan grande, el test tiene tanto poder estadístico que rechaza el modelo ante cualquier desviación mínima entre lo observado y lo teórico, aunque la forma real se parezca bastante a la del modelo Binomial conjeturado.

# 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")

Prueba	Estadístico	G.L.	p-valor	Validación
Tabla N° 2: Validación de la Conjetura (Modelo Binomial)
p̂ = 0.5376 — Etapa de Vida
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

8. Conclusiones

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

Etapa de Vida — Análisis Inferencial (Variable Cualitativa Ordinal)

Fernando Almeida

2026-07-29