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: DEPTH_LEVEL tiene un orden natural (SHALLOW < MEDIUM < DEEP) pero no es numérica. Se le asigna un código de orden (Asignación) 1, 2, 3.

niveles_orden <- c("SHALLOW", "MEDIUM", "DEEP")

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_orden,
           ni = freq_abs, hi_pct = round(hi_dec * 100, 2)) %>%
  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 = "gray20", weight = "bold"),
            locations = cells_body(columns = c(Asignacion, Categoria))) %>%
  cols_align(align = "center", columns = c(Asignacion, ni, hi_pct)) %>%
  tab_source_note(source_note = md("*Autor: Fernando Almeida*"))

Asignación	Nivel de Profundidad	ni	hi (%)
TABLA N° 1: DISTRIBUCIÓN DE FRECUENCIAS DEL NIVEL DE PROFUNDIDAD
1	SHALLOW	15986	33.47
2	MEDIUM	15852	33.19
3	DEEP	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 = etiquetas_grafico, 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)

comparacion <- rbind(Observado = hi_dec, `Uniforme Discreto` = p_uniforme)

par(mar = c(5, 6, 6, 2))
bp2 <- barplot(comparacion, beside = TRUE,
               col = c("#555555", "#B0B0B0"),
               border = "black", las = 1,
               names.arg = etiquetas_grafico,
               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", "Uniforme Discreto"),
       fill = c("#555555", "#B0B0B0"), 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 Discreto. Entre más parecidas las alturas de cada par, mejor el ajuste.

6. Conjetura

Al observar el gráfico, las tres categorías presentan prácticamente la misma frecuencia (cerca de 33% cada una), por lo que se conjetura un modelo Uniforme Discreto, donde cada categoría tiene la misma probabilidad:

\[P(X = k) = \frac{1}{k\_niveles} \,, \quad k = 1, 2, 3\]

data.frame(Categoria = niveles_orden,
           p_H0        = round(p_uniforme, 4),
           p_observada = round(hi_dec, 4))

##         Categoria   p_H0 p_observada
## SHALLOW   SHALLOW 0.3333      0.3347
## MEDIUM     MEDIUM 0.3333      0.3319
## DEEP         DEEP 0.3333      0.3333

7. Validación: Índice de Similitud y Prueba Chi-Cuadrado

Como el modelo Uniforme Discreto tiene varianza cero (todas las probabilidades teóricas son idénticas), la correlación de Pearson queda matemáticamente indefinida. En su lugar se usa el índice de similitud (\(1 - \tfrac{1}{2}\sum|h_i - p_i|\)), que mide qué tan parecidas son las frecuencias observadas y teóricas. También se aplica la prueba Chi-Cuadrado de Bondad de Ajuste sobre una submuestra aleatoria, dado el tamaño muestral tan grande.

# Índice de Similitud (complemento de la distancia de variación total)
indice_similitud <- (1 - 0.5 * sum(abs(hi_dec - p_uniforme))) * 100

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_similitud <- ifelse(indice_similitud > 70, "APROBADO", "RECHAZADO")
val_chi       <- ifelse(chi_pval > 0.05, "APROBADO", "RECHAZADO")

bind_rows(
  data.frame(Prueba = "Índice de Similitud (hi vs. p teórico)",
             Estadistico = round(indice_similitud, 2), GL = NA_integer_,
             p_valor = NA_real_, Validacion = val_similitud),
  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)
) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N\u00b0 2: Validación de la Conjetura (Modelo Uniforme Discreto)**"),
    subtitle = md("*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 = "gray25"), cell_text(color = "white", weight = "bold")),
            locations = cells_column_labels()) %>%
  tab_style(style = cell_text(weight = "bold"),
            locations = cells_body(columns = Validacion, rows = Validacion == "APROBADO")) %>%
  tab_style(style = cell_text(color = "gray55", style = "italic"),
            locations = cells_body(columns = Validacion, rows = Validacion == "RECHAZADO")) %>%
  cols_align(align = "center", columns = c(Estadistico, GL, p_valor, Validacion)) %>%
  fmt_missing(columns = everything(), missing_text = "-") %>%
  tab_source_note(source_note = md("*Autor: Fernando Almeida*"))

Prueba	Estadístico	G.L.	p-valor	Validación
Tabla N° 2: Validación de la Conjetura (Modelo Uniforme Discreto)
Nivel de Profundidad
Índice de Similitud (hi vs. p teórico)	99.86	-	-	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 con nivel de profundidad DEEP, por ser la categoría de mayor relevancia operativa:

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

\[E = z \sqrt{\frac{\hat{p}(1-\hat{p})}{n}}\]

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 '", 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)"
) %>%
  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 = "gray25"), cell_text(color = "white", weight = "bold")),
            locations = cells_column_labels()) %>%
  tab_style(style = list(cell_fill(color = "gray90"), cell_text(weight = "bold")),
            locations = cells_body(columns = Proporcion_Muestral)) %>%
  cols_align(align = "center", columns = c(Lim_Inferior, Proporcion_Muestral, Lim_Superior, Error_Estandar, Confianza)) %>%
  tab_source_note(source_note = md("*Autor: Fernando Almeida*"))

Parámetro	Lim_Inferior	Proporción_Muestral	Lim_Superior	Error_Estándar	Confianza
TABLA N° 3: ESTIMACIÓN DE LA PROPORCIÓN POBLACIONAL
Inferencia Estadística para el Nivel de Profundidad
Proporción Nivel 'DEEP'	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 categorías SHALLOW < MEDIUM < DEEP codificadas como Asignación 1, 2, 3, sobre 47,757 observaciones. Se conjeturó un modelo Uniforme Discreto, ya que las tres categorías presentan una frecuencia prácticamente idéntica (33.47%, 33.19%, 33.33%). El índice de similitud obtuvo 99.86% (APROBADO) y la prueba Chi-Cuadrado sobre una submuestra (n=100) obtuvo un estadístico de 3.02 con 2 grado(s) de libertad y un p-valor de 0.2209 (APROBADO); el modelo Uniforme Discreto fue aprobado. El intervalo de confianza al 95% para la proporción poblacional de pozos con nivel DEEP fue [32.91%, 33.76%], con proporción muestral 33.33% y margen de error +/- 0.42%.

Autor: Fernando Almeida — Análisis Estadístico, Kansas Hydrocarbon Leases Dataset

Nivel de Profundidad — Análisis Inferencial (Variable Cualitativa Ordinal)

Fernando Almeida

2026-07-21