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

Nivel de Profundidad	Valor asignado	Frecuencia absoluta (ni)	Frecuencia relativa (hi)	Probabilidad (%)
Tabla N° 1: Distribución de Frecuencias del Nivel de Profundidad
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

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

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. Test

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

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 Profundidad
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. 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

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

Fernando Almeida

2026-07-27