1. Carga de Librerías

library(tidyverse)
library(knitr)
library(kableExtra)
library(scales)

2. Carga de Data Set

datos_originales <- read_csv2("C:/Users/cordo/OneDrive/Desktop/ESTADISITCA/Oil__Gas____Other_Regulated_Wells__Beginning_1860.csv")

names(datos_originales) <- trimws(toupper(names(datos_originales)))

3. Extracción y Limpieza de la Variable

La variable TOWN registra el municipio donde se ubica el pozo. Debido a la alta cantidad de categorías en la variable, aquellas que no se encuentran entre las 8 más frecuentes se agruparán en la categoría “Otros” para optimizar la representación gráfica y el análisis de tendencias principales.

df_clean <- datos_originales %>%
  select(Town = TOWN) %>%
  filter(!is.na(Town)) %>%
  mutate(Town = as.character(Town))

top_8 <- df_clean %>% count(Town, sort = TRUE) %>% head(8) %>% pull(Town)

tabla_frec <- df_clean %>%
  mutate(TOWN = ifelse(Town %in% top_8, Town, "Otros")) %>%
  count(TOWN, name = "Frecuencia_Absoluta") %>%
  mutate(
    Frecuencia_Relativa = Frecuencia_Absoluta / sum(Frecuencia_Absoluta),
    Porcentaje = Frecuencia_Relativa * 100,
    Frecuencia_Acumulada = cumsum(Frecuencia_Absoluta)
  ) %>%
  arrange(desc(Frecuencia_Absoluta))

4. Tabla de Distribución de Frecuencias

fila_total <- tibble(
  TOWN = "Total",
  Frecuencia_Absoluta = sum(tabla_frec$Frecuencia_Absoluta),
  Porcentaje = sum(tabla_frec$Porcentaje)
)

tabla_frec_con_total <- bind_rows(
  tabla_frec %>% mutate(Porcentaje = Porcentaje),
  fila_total
)

tabla_frec_con_total %>%
  mutate(Porcentaje = round(Porcentaje, 2)) %>%
  select(Municipio = TOWN, `ni (Absoluta)` = Frecuencia_Absoluta, `hi % (Relativa)` = Porcentaje) %>%
  kable(caption = "Tabla N°1: Tabla de Distribución de Frecuencias",
        align = c("l", "c", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
                full_width = FALSE, 
                position = "center") %>%
  row_spec(0, background = "#1D4E73", color = "white", bold = TRUE) %>%
  row_spec(nrow(tabla_frec_con_total), bold = TRUE, background = "#EAF4FD") %>%
  footnote(general = "Fuente: Oil, Gas & Other Regulated Wells - NY State",
           general_title = "",
           footnote_as_chunk = TRUE)
Tabla N°1: Tabla de Distribución de Frecuencias
Municipio ni (Absoluta) hi % (Relativa)
Otros 23131 49.46
Allegany 6088 13.02
Bolivar 5422 11.59
Alma 3621 7.74
Carrollton 2724 5.82
Wirt 1537 3.29
Olean 1498 3.20
Genesee 1405 3.00
Scio 1341 2.87
Total 46767 100.00
Fuente: Oil, Gas & Other Regulated Wells - NY State

5. Análisis Gráfico

tema_vertical <- theme_minimal() + 
  theme(
    plot.title = element_text(face = "bold", color = "#1D4E73", size = 13, hjust = 0.5),
    panel.grid.major.x = element_blank(), 
    panel.grid.minor.x = element_blank(),
    axis.text.x = element_text(angle = 45, hjust = 1, face = "bold")
  )

colores_usados <- colorRampPalette(paleta_colores)(nrow(tabla_frec))

5.1 Diagrama de Barras — Frecuencia Absoluta

ggplot(tabla_frec, aes(x = reorder(TOWN, -Frecuencia_Absoluta), y = Frecuencia_Absoluta, fill = TOWN)) +
  geom_col(show.legend = FALSE) +
  scale_fill_manual(values = colores_usados) +
  geom_text(aes(label = Frecuencia_Absoluta), vjust = -0.5, size = 3.5, fontface = "bold") +
  tema_vertical +
  labs(
    title = "Gráfica N°1: Frecuencia Absoluta por Municipio",
    x = "Municipio",
    y = "Frecuencia Absoluta (ni)",
    caption = "Fuente: Oil, Gas & Other Regulated Wells - NY State"
  )

5.2 Diagrama de Barras — Frecuencia Relativa / Porcentajes

ggplot(tabla_frec, aes(x = reorder(TOWN, -Porcentaje), y = Porcentaje, fill = TOWN)) +
  geom_col(show.legend = FALSE) +
  scale_fill_manual(values = colores_usados) +
  geom_text(aes(label = paste0(round(Porcentaje, 1), "%")), vjust = -0.5, size = 3.5, fontface = "bold") +
  tema_vertical +
  labs(
    title = "Gráfica N°2: Porcentaje por Municipio",
    x = "Municipio",
    y = "Porcentaje (%)",
    caption = "Fuente: Oil, Gas & Other Regulated Wells - NY State"
  )

6. Conjetura de Modelo Geométrico

# Excluimos "Otros" para el modelo geométrico y análisis de modas reales
tabla_modelo <- tabla_frec %>% filter(TOWN != "Otros")

conteo_modelo <- tabla_modelo %>%
  mutate(TOWN = as.character(TOWN)) %>%
  arrange(desc(Frecuencia_Absoluta))

conteo_modelo$ID <- 1:nrow(conteo_modelo)

# Recalcular proporciones relativas internas solo entre las categorías reales para el modelo
total_reales <- sum(conteo_modelo$Frecuencia_Absoluta)
conteo_modelo$hi_recurso <- conteo_modelo$Frecuencia_Absoluta / total_reales

# Estimación del parámetro p por método de momentos
media_observada <- sum(conteo_modelo$ID * conteo_modelo$hi_recurso)
p_estimado <- 1 / media_observada

cat("Parámetro estimado p =", round(p_estimado, 4), "\n")
## Parámetro estimado p = 0.3113
# Probabilidades del modelo geométrico
prob_geom <- p_estimado * (1 - p_estimado)^(conteo_modelo$ID - 1)
prob_geom <- prob_geom / sum(prob_geom)

conteo_modelo$hi_modelo     <- round(prob_geom, 4)
conteo_modelo$hi_modelo_pct <- round(prob_geom * 100, 2)
conteo_modelo$hi_pct        <- round(conteo_modelo$hi_recurso * 100, 2)

Gráfica comparativa de los valores observados y estimados

df_comparativo <- conteo_modelo %>%
  select(TOWN, hi_pct, hi_modelo_pct) %>%
  pivot_longer(cols = c(hi_pct, hi_modelo_pct),
               names_to = "Origen", values_to = "Valor") %>%
  mutate(Origen = ifelse(Origen == "hi_pct", "Realidad", "Modelo"))

df_comparativo$TOWN <- factor(df_comparativo$TOWN, levels = conteo_modelo$TOWN)

ggplot(df_comparativo, aes(x = TOWN, y = Valor, fill = Origen)) +
  geom_bar(stat = "identity", position = "dodge", color = "white") +
  scale_fill_manual(values = c("Modelo" = "skyblue", "Realidad" = "#1D4E73")) +
  theme_minimal() +
  theme(
    plot.title = element_text(face = "bold", color = "#1D4E73", size = 13, hjust = 0.5),
    plot.subtitle = element_text(hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1, face = "bold")
  ) +
  labs(
    title    = "Gráfica N°3: Modelo Geométrico comparado con la Realidad",
    x        = "Municipio",
    y        = "Probabilidad (%)",
    fill     = "Origen"
  )

7. Test de Bondad

7.1 Test de Pearson

cat("Correlación de Pearson (%):", round(r_pearson, 4), "\n")
## Correlación de Pearson (%): 97.9984
plot(Fo, Fe,
     xlab = "Frecuencia Observada (hi %)",
     ylab = "Frecuencia Esperada (hi modelo %)",
     pch  = 19,
     col  = "#1D4E73",
     cex.main = 1.1,
     font.main = 2,
     col.main = "#1D4E73")
title(main = "Gráfica N°4: Correlación Modelo Observado y Esperado", line = 2.5, adj = 0.5)
abline(lm(Fe ~ 0 + Fo), col = "red", lwd = 2)
legend("topleft",
       legend = paste0("r = ", round(r_pearson, 2), "%"),
       bty    = "n")

7.2 Test Chi-Cuadrado (\(\chi^2\))

cat("Chi-Cuadrado:", round(chi2_calc, 4), "\n")
## Chi-Cuadrado: 8.1059
cat("Valor Crítico:", round(chi2_crit, 4), "\n")
## Valor Crítico: 12.5916
cat("¿El modelo geométrico es aceptado?:", chi2_calc < chi2_crit, "\n")
## ¿El modelo geométrico es aceptado?: TRUE

Tabla Resumen del Test

tabla_test <- data.frame(
  Variable          = "Municipio (TOWN)",
  `Test Pearson (%)`= round(r_pearson, 2),
  `Chi Cuadrado`    = round(chi2_calc, 2),
  `Umbral de Aceptación` = round(chi2_crit, 2),
  Resultado         = ifelse(chi2_calc < chi2_crit, "Modelo Aceptado", "Modelo Rechazado"),
  check.names = FALSE
)

tabla_test %>%
  kable(caption = "Tabla N°2: Resumen del Test de Bondad al Modelo de Probabilidad",
        align = c("c", "c", "c", "c", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
                full_width = FALSE, 
                position = "center") %>%
  row_spec(0, background = "#1D4E73", color = "white", bold = TRUE) %>%
  footnote(general = "Autor: Jennifer Cordones",
           general_title = "",
           footnote_as_chunk = TRUE)
Tabla N°2: Resumen del Test de Bondad al Modelo de Probabilidad
Variable Test Pearson (%) Chi Cuadrado Umbral de Aceptación Resultado
Municipio (TOWN) 98 8.11 12.59 Modelo Aceptado
Autor: Jennifer Cordones

8. Cálculo de Probabilidades

# Probabilidad del municipio real más frecuente (primer elemento de conteo_modelo)
prob_principal <- (conteo_modelo$Frecuencia_Absoluta[1] / sum(tabla_frec$Frecuencia_Absoluta)) * 100
municipio_principal <- as.character(conteo_modelo$TOWN[1])

cat("Probabilidad de estar en el municipio más frecuente (", municipio_principal, "):",
    round(prob_principal, 2), "%\n")
## Probabilidad de estar en el municipio más frecuente ( Allegany ): 13.02 %
# Pozos acumulados en los dos municipios reales principales
pozos_top2 <- sum(conteo_modelo$Frecuencia_Absoluta[1:min(2, nrow(conteo_modelo))])
municipios_top2 <- paste(conteo_modelo$TOWN[1:min(2, nrow(conteo_modelo))], collapse = " y ")

cat("Pozos en las principales concentraciones territoriales (", municipios_top2, "):", pozos_top2, "\n")
## Pozos en las principales concentraciones territoriales ( Allegany y Bolivar ): 11510

¿Cuál es la probabilidad de que un pozo seleccionado al azar se encuentre en el municipio con mayor concentración (Allegany)? La probabilidad estimada indica que aproximadamente el 13.02% de los pozos regulados se concentran en el municipio Allegany, siendo la demarcación territorial real con mayor actividad e inventario registrado.

¿Cuántos pozos se encuentran ubicados entre las principales concentraciones territoriales (Allegany y Bolivar)? En la base de datos analizada, un total de 11510 pozos se concentran en estas demarcaciones principales, lo que representa una porción sumamente relevante del inventario total.

9. Conclusión

Tras filtrar los registros nulos de la variable TOWN y agrupar las categorías menores fuera del Top 8 en la categoría “Otros” (excluyendo a esta última del análisis de modas por tratarse de una acumulación artificial), se determinó que el municipio real Allegany concentra el 13.02% de los yacimientos registrados en el estado de Nueva York.

Al ordenar las categorías reales por frecuencia descendente para evaluar el comportamiento estocástico, el Modelo Geométrico obtuvo un estadístico Chi-Cuadrado de 8.1059 frente a un valor crítico de 12.5916, por lo que el modelo es aceptado (\(\chi^2_{calc} < \chi^2_{crit}\)), respaldado por una fuerte correlación de Pearson del 98%.

Autor: Jennifer Cordones | Análisis Estadístico — Oil, Gas & Other Regulated Wells - NY State