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 FIELD_NAME.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 FIELD_NAME, que indica el nombre del campo petrolífero al que pertenece 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 FIELD_NAME.Rmd.

# Valores reales tomados del Cuadro N°1 de FIELD_NAME.Rmd
n_total  <- 84454                      # registros válidos totales (TOTAL del Cuadro N°1)
moda_val <- "HUGOTON GAS AREA"                   # categoría modal (Top 1 del Cuadro N°1)
ni_moda  <- 8113                      # frecuencia (ni) de la categoría modal

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

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): HUGOTON GAS AREA
cat("n total:                ", n_total, "\n")
## n total:                 84454
cat("ni categoría modal:      ", ni_moda, "\n")
## ni categoría modal:       8113
cat("p_hat:                   ", round(p_hat, 4), "\n")
## p_hat:                    0.0961

La categoría de éxito es Es “HUGOTON GAS AREA” y la de fracaso es Otro campo.

4. Tabla de Distribución de Frecuencias

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

tabla_top10 <- data.frame(
  Categoria = c("HUGOTON GAS AREA", "CHEROKEE BASIN COAL AREA", "PANOMA GAS AREA", "Spivey-Grabs-Basil", "UNKNOWN", "Chase-Silica", "PAOLA-RANTOUL", "HUMBOLDT-CHANUTE", "TRAPP", "Aetna Gas Area"),
  ni        = c(8113, 4549, 2703, 1613, 1301, 1224, 994, 799, 741, 707),
  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("*FIELD NAME, Kansas \u2014 Top 10 Campos Petrolíferos*")
  ) %>%
  cols_label(Categoria = md("**FIELD NAME**"), 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")
Tabla N°1: Distribución de Frecuencias
FIELD NAME, Kansas — Top 10 Campos Petrolíferos
FIELD NAME Frecuencia (ni) Frecuencia relativa (hi) Probabilidad (%)
HUGOTON GAS AREA 8113 0.0961 9.61
CHEROKEE BASIN COAL AREA 4549 0.0539 5.39
PANOMA GAS AREA 2703 0.0320 3.20
Spivey-Grabs-Basil 1613 0.0191 1.91
UNKNOWN 1301 0.0154 1.54
Chase-Silica 1224 0.0145 1.45
PAOLA-RANTOUL 994 0.0118 1.18
HUMBOLDT-CHANUTE 799 0.0095 0.95
TRAPP 741 0.0088 0.88
Aetna Gas Area 707 0.0084 0.84
TOTAL 22744 0.2693 26.93
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 FIELD NAME (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 FIELD_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”HUGOTON GAS AREA”“. 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.096 (valor conjeturado a partir de la proporción observada).
H1: p ≠ 0.096.

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")
Tabla N°2: Parámetros del modelo Bernoulli(p) conjeturado
Parámetro Valor
n (registros válidos) 84454.0000
p̂ (proporción muestral) 0.0961
p0 (proporción bajo H0) 0.0960
Error estándar de p̂ 0.0010
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")
Tabla N°3: Frecuencias observadas frente al modelo Geométrico(p = 0.313)
Top 10 categorías completas
Categoría Rango (k) ni observada hi observada P bajo modelo ni esperada bajo modelo
HUGOTON GAS AREA 1 8113 0.3567 0.3203 7,285.53
CHEROKEE BASIN COAL AREA 2 4549 0.2000 0.2201 5,006.58
PANOMA GAS AREA 3 2703 0.1188 0.1513 3,440.50
Spivey-Grabs-Basil 4 1613 0.0709 0.1040 2,364.30
UNKNOWN 5 1301 0.0572 0.0714 1,624.74
Chase-Silica 6 1224 0.0538 0.0491 1,116.51
PAOLA-RANTOUL 7 994 0.0437 0.0337 767.26
HUMBOLDT-CHANUTE 8 799 0.0351 0.0232 527.26
TRAPP 9 741 0.0326 0.0159 362.33
Aetna Gas Area 10 707 0.0311 0.0109 248.99
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.0961\), 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")
Tabla N°5: Probabilidades bajo el modelo Binomial(30, p̂ = 0.0961)
Para una muestra futura
Evento Valor
E[Y] esperado en n = 30 pozos 2.8819
P(Y ≥ mitad de la muestra) 0.0000
P(Y ≤ 25% de la muestra) 0.9939
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.0961\) y \(n = 8.4454\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")
Tabla N°6: Intervalo de Confianza al 95% para p
Método Límite inferior Límite superior
Wald 0.0941 0.0981
Wilson 0.0941 0.0981
Autor: GRUPO

9. Conclusiones

De los 84.454 registros válidos, la proporción estimada de Es “HUGOTON GAS AREA” es \(\hat p = 0.0961\) (9.61%). La prueba Z para una proporción, contrastada contra el valor conjeturado \(p_0 = 0.096\), arrojó un estadístico de 0.0633 con valor p de 0.9496, 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.0941, 0.0981].

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