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.csv.csv | Filas: 47757

3. Conteo

Es una variable cualitativa nominal con muchísimas categorías distintas (miles de nombres de operadores), sin ningún orden natural entre ellas. Para poder analizarla, se agrupan las 5 categorías más frecuentes y el resto se agrupa en una categoría “Otros” — una práctica estándar cuando una nominal tiene demasiadas categorías para tratarlas una por una.

x_raw_completo <- datos %>%
  filter(!is.na(OPERATOR_NAME)) %>%
  pull(OPERATOR_NAME)

n_conteo <- length(x_raw_completo)

top5 <- names(sort(table(x_raw_completo), decreasing = TRUE))[1:5]

x_raw <- ifelse(x_raw_completo %in% top5, x_raw_completo, "OTROS")
niveles_orden <- c(top5, "OTROS")
niveles_es    <- niveles_orden   # los nombres de operador se muestran tal cual (propios)
niveles_es[length(niveles_es)] <- "Otros"

x_raw <- factor(x_raw, levels = niveles_orden)

k_niveles <- length(niveles_orden)

cat("Observaciones válidas:", n_conteo, "\n")
## Observaciones válidas: 47757
cat("Categorías originales:", length(unique(x_raw_completo)), " -> agrupadas en:", k_niveles, "\n")
## Categorías originales: 3362  -> agrupadas en: 6
cat("Top 5 operadores:\n"); print(top5)
## Top 5 operadores:
## [1] "River Rock Operating, LLC"       "Scout Energy Management LLC"    
## [3] "Merit Energy Company, LLC"       "RedBud Oil & Gas Operating, LLC"
## [5] "American Warrior, Inc."

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

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 Nombre del Operador (Top 5 + Otros)**")) %>%
  cols_label(Categoria = md("**Operador**"), 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 Nombre del Operador (Top 5 + Otros)
Operador Valor asignado Frecuencia absoluta (ni) Frecuencia relativa (hi) Probabilidad (%)
River Rock Operating, LLC 0 2083 0.0436 4.36
Scout Energy Management LLC 1 1903 0.0398 3.98
Merit Energy Company, LLC 2 1711 0.0358 3.58
RedBud Oil & Gas Operating, LLC 3 1306 0.0273 2.73
American Warrior, Inc. 4 1044 0.0219 2.19
Otros 5 39710 0.8315 83.15
Autor: Fernando Almeida

5. Gráficos

grises <- gray(seq(0.25, 0.80, length.out = k_niveles))

par(mar = c(9, 6, 6, 2))
bp <- barplot(prob_pct, names.arg = niveles_es, col = grises, border = "black",
              las = 2, cex.names = 0.75, ylim = c(0, max(prob_pct) * 1.2), ylab = "", xlab = "")
mtext("Probabilidad (%)",  side = 2, line = 4.2, cex = 1)
mtext("Distribución del Nombre del Operador (Top 5 + Otros)", side = 3, line = 1.5, cex = 1, font = 2)
text(bp, prob_pct, labels = paste0(round(prob_pct, 1), "%"), pos = 3, cex = 0.8)

6. Conjetura

Basado en el gráfico se conjetura un modelo Uniforme Discreto como hipótesis nula: si el mercado estuviera repartido parejo, cada operador (incluyendo “Otros”) tendría probabilidad 1/6. El gráfico muestra que “Otros” domina ampliamente (concentra a todos los operadores fuera del top 5), lo que sugiere una fuerte concentración, no una distribución uniforme.

cat("p teórico (Uniforme, 1/k):", round(1 / k_niveles, 4), "\n")
## p teórico (Uniforme, 1/k): 0.1667
data.frame(Categoria = niveles_es,
           p_H0        = round(p_uniforme, 4),
           p_observada = round(hi_dec, 4))
##                                                       Categoria   p_H0
## River Rock Operating, LLC             River Rock Operating, LLC 0.1667
## Scout Energy Management LLC         Scout Energy Management LLC 0.1667
## Merit Energy Company, LLC             Merit Energy Company, LLC 0.1667
## RedBud Oil & Gas Operating, LLC RedBud Oil & Gas Operating, LLC 0.1667
## American Warrior, Inc.                   American Warrior, Inc. 0.1667
## OTROS                                                     Otros 0.1667
##                                 p_observada
## River Rock Operating, LLC            0.0436
## Scout Energy Management LLC          0.0398
## Merit Energy Company, LLC            0.0358
## RedBud Oil & Gas Operating, LLC      0.0273
## American Warrior, Inc.               0.0219
## OTROS                                0.8315
comparacion <- rbind(Observado = prob_pct, `Modelo Uniforme` = p_uniforme_pct)

par(mar = c(9, 6, 6, 2))
bp2 <- barplot(comparacion, beside = TRUE,
               col = c(gray(0.35), gray(0.75)),
               border = "black", las = 2, cex.names = 0.75,
               names.arg = niveles_es,
               ylim = c(0, max(comparacion) * 1.25),
               ylab = "", xlab = "")
mtext("Probabilidad (%)", side = 2, line = 4.2, 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.7)
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 (1/6 cada una). Entre más distintas las alturas de cada par, mayor evidencia de concentración de mercado.

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 el tamaño muestral completo (n = 47757), porque aquí se espera precisamente que el test detecte la concentración real del mercado frente a un reparto uniforme teórico.

pearson_r <- cor(cumsum(hi_dec), cumsum(p_uniforme)) * 100

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("*Nombre del Operador (Top 5 + Otros)*")
  ) %>%
  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)
Nombre del Operador (Top 5 + Otros)
Prueba Estadístico G.L. p-valor Validación
Correlación de Pearson (hi vs. p teórico) 74.14 - - APROBADO
Chi-Cuadrado (muestra completa n=47757) 152075.59 5 0 RECHAZADO
Autor: Fernando Almeida

8. Conclusiones

Se trabajó con la variable cualitativa nominal Nombre del Operador (OPERATOR_NAME), agrupada en sus 5 categorías más frecuentes más “Otros” (3362 operadores distintos en total). Se conjeturó un modelo Uniforme Discreto; al realizar una prueba de Pearson se obtuvo 74.14% y la prueba Chi-Cuadrado sobre la muestra completa (n=47757) obtuvo un valor estadístico de 1.5207559^{5} con 5 grado(s) de libertad y un p-valor de 0, lo que demuestra que no hay un reparto uniforme entre operadores (el mercado está concentrado en pocos operadores).


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