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
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 Profundidad**")) %>%
  cols_label(Categoria = md("**Nivel de Profundidad**"), 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")
Tabla N° 1: Distribución de Frecuencias del Nivel de Profundidad
Nivel de Profundidad Valor asignado Frecuencia absoluta (ni) Frecuencia relativa (hi) Probabilidad (%)
Superficial 1 15986 0.3347 33.47
Medio 2 15852 0.3319 33.19
Profundo 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 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, prob_pct, labels = paste0(round(prob_pct, 2), "%"), pos = 3, cex = 0.9)

6. Conjetura

Con base en el gráfico, se propone un modelo de distribución uniforme discreta, ya que las tres categorías presentan frecuencias muy similares. Ninguna destaca claramente sobre las demás, lo que indica que todas tienen aproximadamente la misma probabilidad de ocurrir.

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 = 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 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, 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 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.000 - - APROBADO
Chi-Cuadrado (muestra completa n=47757) 0.564 2 0.7543 APROBADO
Autor: Fernando Almeida

8. Intervalo de Confianza

Para esta variable cualitativa, el parámetro de interés es una proporción. Estimamos la proporción de pozos en nivel DEEP (Profundo), por ser la categoría de mayor relevancia operativa al corresponder a los pozos con mayor profundidad de perforación.

\[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_Poblacional**"),
    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_Poblacional 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 0.564 con 2 grado(s) de libertad y un p-valor de 0.7543, 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