1. Cargar Librerías

library(readr); library(dplyr); library(gt)
cat("Librerías cargadas correctamente.\n")

## Librerías cargadas correctamente.

2. Cargar Datos

Se utiliza el conjunto de datos de arrendamientos de hidrocarburos del estado de Kansas, EE.UU., registrado por el Kansas Geological Survey. (Este paso se conserva por trazabilidad; los conteos usados desde la Sección 3 en adelante son los ya registrados en el documento OPERADOR_NOMBRE.Rmd — Cuadro N°1 — para no depender de recalcular contra el CSV.)

ruta_archivo <- "C:/Users/thann/OneDrive/Escritorio/ESTADISTICA.LOL/daataset/datos_vale.csv"

if (file.exists(ruta_archivo)) {
  datos_vale <- read_delim(ruta_archivo, delim = ";", show_col_types = FALSE)
  cat("Base de datos cargada correctamente.\n")
  cat("Total de registros:", nrow(datos_vale), "\n")
} else {
  cat("Archivo no encontrado en la ruta indicada; se continúa con los valores ya registrados.\n")
}

## Base de datos cargada correctamente.
## Total de registros: 104173

3. Conteo

La variable de estudio es OPERATOR_NAME, que indica el nombre del operador responsable de cada arrendamiento. Es una variable cualitativa nominal policotómica (múltiples categorías). Para poder aplicar el modelo Bernoulli/Z de una proporción (secciones 6 en adelante) se dicotomiza comparando la categoría modal (la más frecuente) frente a todas las demás; sin embargo, la tabla y el gráfico de las secciones 4 y 5 muestran las 10 categorías completas, tal como quedaron registradas en OPERADOR_NOMBRE.Rmd.

# Valores reales tomados del Cuadro N°1 de OPERADOR_NOMBRE.Rmd
n_total  <- 90317                      # registros válidos totales (TOTAL del Cuadro N°1)
moda_val <- "Scout Energy Management LLC"                   # categoría modal (Top 1 del Cuadro N°1)
ni_moda  <- 5662                      # frecuencia (ni) de la categoría modal

etiqueta_si <- paste0("Es \"", moda_val, "\"")
etiqueta_no <- "Otro operador"

p_hat <- ni_moda / n_total             # proporción muestral de la categoría modal
exito <- c(rep(1, ni_moda), rep(0, n_total - ni_moda))

cat("Categoría modal (éxito):", moda_val, "\n")

## Categoría modal (éxito): Scout Energy Management LLC

cat("n total:                ", n_total, "\n")

## n total:                 90317

cat("ni categoría modal:      ", ni_moda, "\n")

## ni categoría modal:       5662

cat("p_hat:                   ", round(p_hat, 4), "\n")

## p_hat:                    0.0627

La categoría de éxito es Es “Scout Energy Management LLC” y la de fracaso es Otro operador.

4. Tabla de Distribución de Frecuencias

Se presentan las 10 categorías completas de OPERATOR_NAME tal como quedaron registradas en el Cuadro N°1 de OPERADOR_NOMBRE.Rmd (n total = 90.317).

tabla_top10 <- data.frame(
  Categoria = c("Scout Energy Management LLC", "Merit Energy Company, LLC", "River Rock Operating, LLC", "RedBud Oil & Gas Operating, LLC", "OXY USA Inc.", "American Warrior, Inc.", "BEREXCO LLC", "Murfin Drilling Co., Inc.", "Edison Operating Company LLC", "OPERATER NAME UNKNOWN"),
  ni        = c(5662, 3437, 2075, 1303, 1189, 1183, 919, 814, 774, 716),
  stringsAsFactors = FALSE
)
tabla_top10$hi <- tabla_top10$ni / n_total
tabla_top10$Probabilidad <- round(100 * tabla_top10$hi, 2)

total_top10 <- data.frame(Categoria = "TOTAL", ni = sum(tabla_top10$ni),
                           hi = sum(tabla_top10$ni) / n_total,
                           Probabilidad = round(100 * sum(tabla_top10$ni) / n_total, 2))

tabla_tdf <- bind_rows(tabla_top10, total_top10)
n_filas_tdf <- nrow(tabla_tdf)

tabla_tdf %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N\u00b01: Distribución de Frecuencias**"),
    subtitle = md("*OPERADOR (NOMBRE), Kansas \u2014 Top 10 Operadores*")
  ) %>%
  cols_label(Categoria = md("**OPERADOR (NOMBRE)**"), ni = md("**Frecuencia (ni)**"),
             hi = md("**Frecuencia relativa (hi)**"), Probabilidad = md("**Probabilidad (%)**")) %>%
  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_fill(color = "#F5F5F5"), locations = cells_body(rows = seq(1, n_filas_tdf, by = 2))) %>%
  tab_style(style = list(cell_fill(color = "#D6D6D6"), cell_text(weight = "bold")),
            locations = cells_body(rows = Categoria == "TOTAL")) %>%
  fmt_number(columns = hi, decimals = 4) %>%
  cols_align(align = "center", columns = c(ni, hi, Probabilidad)) %>%
  cols_align(align = "left", columns = Categoria) %>%
  tab_source_note(source_note = md("*Autor: GRUPO*")) %>%
  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")

OPERADOR (NOMBRE)	Frecuencia (ni)	Frecuencia relativa (hi)	Probabilidad (%)
Tabla N°1: Distribución de Frecuencias
OPERADOR (NOMBRE), Kansas — Top 10 Operadores
Scout Energy Management LLC	5662	0.0627	6.27
Merit Energy Company, LLC	3437	0.0381	3.81
River Rock Operating, LLC	2075	0.0230	2.30
RedBud Oil & Gas Operating, LLC	1303	0.0144	1.44
OXY USA Inc.	1189	0.0132	1.32
American Warrior, Inc.	1183	0.0131	1.31
BEREXCO LLC	919	0.0102	1.02
Murfin Drilling Co., Inc.	814	0.0090	0.90
Edison Operating Company LLC	774	0.0086	0.86
OPERATER NAME UNKNOWN	716	0.0079	0.79
TOTAL	18072	0.2001	20.01
Autor: GRUPO

5. Gráfico General

par(mar = c(10, 5, 4, 2))
bp <- barplot(tabla_top10$Probabilidad, names.arg = tabla_top10$Categoria,
              col = colorRampPalette(c("#1B9E77", "#D95F02"))(nrow(tabla_top10)),
              border = NA, las = 2, cex.names = 0.7,
              main = "Gráfica 1. Distribución empírica de OPERADOR (NOMBRE) (Top 10)",
              ylab = "Probabilidad (%)",
              ylim = c(0, max(tabla_top10$Probabilidad) * 1.18))
text(bp, tabla_top10$Probabilidad, labels = paste0(round(tabla_top10$Probabilidad, 2), "%"),
     pos = 3, cex = 0.75)

6. Conjetura

Al dicotomizar OPERATOR_NAME en “categoría modal” frente a “otra categoría”, el modelo natural es tratar cada registro como un ensayo de Bernoulli independiente,

\[X_i \sim \text{Bernoulli}(p), \quad i = 1, \dots, n\]

donde \(p\) es la proporción poblacional de “Es”Scout Energy Management LLC”“. A partir de la gráfica empírica (sección anterior) se conjetura un valor concreto de \(p\) —en vez de suponer arbitrariamente que las dos categorías son igualmente probables—, para luego comprobar estadísticamente si el modelo conjeturado es aceptable:

H0: p = 0.063 (valor conjeturado a partir de la proporción observada).
H1: p ≠ 0.063.

7. Cálculo de Parámetros y Probabilidades

7.1 Parámetros del Modelo Conjeturado

p0 <- round(p_hat, 3)                             # proporción conjeturada (sección "Conjetura")
error_estandar <- sqrt(p_hat * (1 - p_hat) / n_total)

tabla_parametros <- data.frame(
  Parametro = c("n (registros válidos)", "p\u0302 (proporción muestral)",
                "p0 (proporción bajo H0)", "Error estándar de p\u0302"),
  Valor = c(n_total, round(p_hat, 4), p0, round(error_estandar, 4))
)

tabla_parametros %>%
  gt() %>%
  tab_header(title = md("**Tabla N\u00b02: Parámetros del modelo Bernoulli(p) conjeturado**")) %>%
  cols_label(Parametro = md("**Parámetro**"), Valor = md("**Valor**")) %>%
  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_fill(color = "#F5F5F5"), locations = cells_body(rows = seq(1, nrow(tabla_parametros), by = 2))) %>%
  cols_align(align = "center", columns = Valor) %>%
  cols_align(align = "left", columns = Parametro) %>%
  tab_source_note(source_note = md("*Autor: GRUPO*")) %>%
  tab_options(table.width = pct(90), table.font.size = px(13),
              heading.title.font.size = px(16),
              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")

Parámetro	Valor
Tabla N°2: Parámetros del modelo Bernoulli(p) conjeturado
n (registros válidos)	90317.0000
p̂ (proporción muestral)	0.0627
p0 (proporción bajo H0)	0.0630
Error estándar de p̂	0.0008
Autor: GRUPO

7.2 Sobreponer la Realidad con el Modelo

Para esta comparación se usan las 10 categorías completas de la Tabla N°1 (no solo la dicotomía modal/resto), de modo que aparezcan todos los valores tanto en la tabla como en la gráfica. Como las frecuencias decrecen de forma escalonada según el orden (rango) de cada categoría, el modelo que mejor conviene aquí es el Geométrico (en lugar del Bernoulli, que se reserva para la prueba de hipótesis dicotómica de las secciones 6 a 9): se interpreta el rango \(k = 1, 2, \dots, 10\) como el número de categoría en el que “ocurre” el éxito, con

\[P(K = k) = (1-p)^{k-1}\,p\]

El parámetro \(p\) se estima por el método de los momentos, igualando el rango medio observado (ponderado por las frecuencias) al valor esperado \(E[K] = 1/p\) del modelo Geométrico.

tabla_modelo <- tabla_top10 %>%
  mutate(rango  = row_number(),
         hi_obs = ni / sum(ni))                       # frecuencia relativa dentro del Top 10

rango_medio <- sum(tabla_modelo$rango * tabla_modelo$ni) / sum(tabla_modelo$ni)
p_geo <- 1 / rango_medio                              # p estimado (método de momentos)

tabla_modelo$p_geo_bruta <- (1 - p_geo)^(tabla_modelo$rango - 1) * p_geo
tabla_modelo$p_teorica   <- tabla_modelo$p_geo_bruta / sum(tabla_modelo$p_geo_bruta)  # normalizada dentro del Top 10
tabla_modelo$ni_esperada <- tabla_modelo$p_teorica * sum(tabla_modelo$ni)

tabla_modelo %>%
  select(Categoria, rango, ni, hi_obs, p_teorica, ni_esperada) %>%
  gt() %>%
  tab_header(title = md(paste0("**Tabla N\u00b03: Frecuencias observadas frente al modelo Geom\u00e9trico(p = ", round(p_geo, 3), ")**")),
             subtitle = md("*Top 10 categor\u00edas completas*")) %>%
  cols_label(Categoria = md("**Categoría**"), rango = md("**Rango (k)**"), ni = md("**ni observada**"),
             hi_obs = md("**hi observada**"), p_teorica = md("**P bajo modelo**"),
             ni_esperada = md("**ni esperada bajo modelo**")) %>%
  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_fill(color = "#F5F5F5"), locations = cells_body(rows = seq(1, nrow(tabla_modelo), by = 2))) %>%
  fmt_number(columns = c(hi_obs, p_teorica), decimals = 4) %>%
  fmt_number(columns = ni_esperada, decimals = 2) %>%
  cols_align(align = "center", columns = c(rango, ni, hi_obs, p_teorica, ni_esperada)) %>%
  cols_align(align = "left", columns = Categoria) %>%
  tab_source_note(source_note = md("*Autor: GRUPO*")) %>%
  tab_options(table.width = pct(95), 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")

Categoría	Rango (k)	ni observada	hi observada	P bajo modelo	ni esperada bajo modelo
Tabla N°3: Frecuencias observadas frente al modelo Geométrico(p = 0.282)
Top 10 categorías completas
Scout Energy Management LLC	1	5662	0.3133	0.2926	5,288.75
Merit Energy Company, LLC	2	3437	0.1902	0.2101	3,797.37
River Rock Operating, LLC	3	2075	0.1148	0.1509	2,726.54
RedBud Oil & Gas Operating, LLC	4	1303	0.0721	0.1083	1,957.68
OXY USA Inc.	5	1189	0.0658	0.0778	1,405.63
American Warrior, Inc.	6	1183	0.0655	0.0558	1,009.25
BEREXCO LLC	7	919	0.0509	0.0401	724.65
Murfin Drilling Co., Inc.	8	814	0.0450	0.0288	520.31
Edison Operating Company LLC	9	774	0.0428	0.0207	373.58
OPERATER NAME UNKNOWN	10	716	0.0396	0.0148	268.24
Autor: GRUPO

comparacion <- rbind(Observado = tabla_modelo$hi_obs * 100,
                      `Esperado (Geométrico)` = tabla_modelo$p_teorica * 100)
colnames(comparacion) <- tabla_modelo$Categoria

par(mar = c(11, 5, 4, 2))
bp <- barplot(comparacion, beside = TRUE, col = c("#1B9E77", "#D95F02"), border = NA,
              las = 2, cex.names = 0.65,
              main = paste0("Gráfica 2. Realidad observada vs. modelo Geométrico(p = ", round(p_geo, 3), ")"),
              ylab = "Probabilidad relativa dentro del Top 10 (%)",
              ylim = c(0, max(comparacion) * 1.3),
              legend.text = TRUE, args.legend = list(x = "top", bty = "n", cex = 0.8, horiz = TRUE))
text(bp, comparacion, labels = paste0(round(comparacion, 2), "%"), pos = 3, cex = 0.6)

7.3 Cálculo de Probabilidades

Con \(\hat p = 0.0627\), se calculan probabilidades para una muestra futura de 30 pozos, \(Y \sim \text{Binomial}(30, \hat p)\):

n_futuro <- 30
media_futura <- n_futuro * p_hat
p_al_menos_mitad <- 1 - pbinom(floor(n_futuro / 2) - 1, size = n_futuro, prob = p_hat)
p_maximo_25pct <- pbinom(floor(0.25 * n_futuro), size = n_futuro, prob = p_hat)

tabla_probabilidades <- data.frame(
  Evento = c(paste0("E[Y] esperado en n = ", n_futuro, " pozos"),
             "P(Y \u2265 mitad de la muestra)",
             "P(Y \u2264 25% de la muestra)"),
  Valor = round(c(media_futura, p_al_menos_mitad, p_maximo_25pct), 4)
)

tabla_probabilidades %>%
  gt() %>%
  tab_header(title = md(paste0("**Tabla N\u00b05: Probabilidades bajo el modelo Binomial(30, p\u0302 = ", round(p_hat, 4), ")**")),
             subtitle = md("*Para una muestra futura*")) %>%
  cols_label(Evento = md("**Evento**"), Valor = md("**Valor**")) %>%
  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_fill(color = "#F5F5F5"), locations = cells_body(rows = seq(1, nrow(tabla_probabilidades), by = 2))) %>%
  cols_align(align = "center", columns = Valor) %>%
  cols_align(align = "left", columns = Evento) %>%
  tab_source_note(source_note = md("*Autor: GRUPO*")) %>%
  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")

Evento	Valor
Tabla N°5: Probabilidades bajo el modelo Binomial(30, p̂ = 0.0627)
Para una muestra futura
E[Y] esperado en n = 30 pozos	1.8807
P(Y ≥ mitad de la muestra)	0.0000
P(Y ≤ 25% de la muestra)	0.9996
Autor: GRUPO

8. Intervalo de Confianza

Intervalo de confianza al 95% para la proporción poblacional \(p\), calculado por los métodos de Wald y de Wilson, a partir de \(\hat p = 0.0627\) y \(n = 9.0317\times 10^{4}\).

z <- qnorm(0.975)

wald_li <- p_hat - z * sqrt(p_hat * (1 - p_hat) / n_total)
wald_ls <- p_hat + z * sqrt(p_hat * (1 - p_hat) / n_total)

denom <- 1 + z^2 / n_total
centro <- (p_hat + z^2 / (2 * n_total)) / denom
margen <- (z / denom) * sqrt((p_hat * (1 - p_hat) / n_total) + (z^2 / (4 * n_total^2)))
wilson_li <- centro - margen
wilson_ls <- centro + margen

tabla_ic <- data.frame(Metodo = c("Wald", "Wilson"),
                        Lim_Inferior = round(c(wald_li, wilson_li), 4),
                        Lim_Superior = round(c(wald_ls, wilson_ls), 4))

tabla_ic %>%
  gt() %>%
  tab_header(title = md("**Tabla N\u00b06: Intervalo de Confianza al 95% para p**")) %>%
  cols_label(Metodo = md("**Método**"), Lim_Inferior = md("**Límite inferior**"),
             Lim_Superior = md("**Límite superior**")) %>%
  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_fill(color = "#F5F5F5"), locations = cells_body(rows = seq(1, nrow(tabla_ic), by = 2))) %>%
  cols_align(align = "center", columns = c(Lim_Inferior, Lim_Superior)) %>%
  cols_align(align = "left", columns = Metodo) %>%
  tab_source_note(source_note = md("*Autor: GRUPO*")) %>%
  tab_options(table.width = pct(90), table.font.size = px(13),
              heading.title.font.size = px(16),
              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")

Método	Límite inferior	Límite superior
Tabla N°6: Intervalo de Confianza al 95% para p
Wald	0.0611	0.0643
Wilson	0.0611	0.0643
Autor: GRUPO

9. Conclusiones

De los 90.317 registros válidos, la proporción estimada de Es “Scout Energy Management LLC” es \(\hat p = 0.0627\) (6.27%). La prueba Z para una proporción, contrastada contra el valor conjeturado \(p_0 = 0.063\), arrojó un estadístico de -0.3831 con valor p de 0.7017, por lo que al 5% de significancia se acepta el modelo Bernoulli(p0) conjeturado. El intervalo de confianza al 95% para \(p\) (Wilson) es [0.0611, 0.0643].

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

Análisis inferencial: OPERADOR (NOMBRE)

GRUPO

2026-07-20