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 (SHALLOW (Superficial) < MEDIUM (Medio) < DEEP (Profundo)) pero no son numéricas. Se les asigna un código de orden (Asignación) 1, 2, 3.

niveles_orden <- c("SHALLOW", "MEDIUM", "DEEP")
niveles_es    <- c("Superficial", "Medio", "Profundo")   # etiquetas en español para mostrar

x_raw <- datos %>%
  mutate(ESTADO = factor(DEPTH_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: SHALLOW < MEDIUM < DEEP

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 PROFUNDIDAD**")) %>%
  cols_label(Asignacion = md("**Asignación**"), Categoria = md("**Nivel de Profundidad**"),
             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 PROFUNDIDAD
Asignación Nivel de Profundidad ni hi (%)
1 Superficial 15986 33.47
2 Medio 15852 33.19
3 Profundo 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 Profundidad",        side = 1, line = 3, cex = 1)
mtext("Distribución del Nivel de Profundidad", 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
## SHALLOW Superficial 0.3333      0.3347
## MEDIUM        Medio 0.3333      0.3319
## DEEP       Profundo 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 Profundidad",       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 Profundidad*"))
  ) %>%
  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 Profundidad
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) 3.02 2 0.2209 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 DEEP (Profundo), por ser la categoría de mayor relevancia operativa (pozos con perforación más profunda):

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

categoria_interes <- "DEEP"
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 Profundidad*")
  ) %>%
  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 Profundidad
Parámetro Lim_Inferior Proporción_Muestral Lim_Superior Error_Estándar Confianza
Proporción Nivel 'Profundo' 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 Profundidad (DEPTH_LEVEL), con un rango que fluctúa entre Superficial < Medio < Profundo. 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 3.02 con 2 grado(s) de libertad y un p-valor de 0.2209, 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