1. Configuración y Carga de Datos

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

2. 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))

3. Tabla de Distribución de Frecuencias (TDFS)

Tabla de distribución de frecuencias simplificada con frecuencia absoluta (\(n_i\)) y frecuencia relativa porcentual (\(h_i \%\)).

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

4. 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))

4.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 = "Diagrama de Barras: Frecuencia Absoluta por Municipio",
    x = "Municipio",
    y = "Frecuencia Absoluta (ni)",
    caption = "Fuente: Oil, Gas & Other Regulated Wells - NY State"
  )

4.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 = "Diagrama de Barras: Porcentaje por Municipio",
    x = "Municipio",
    y = "Porcentaje (%)",
    caption = "Fuente: Oil, Gas & Other Regulated Wells - NY State"
  )

5. 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 — Municipio",
    subtitle = paste0("p estimado = ", round(p_estimado, 4)),
    x        = "Municipio (orden por frecuencia descendente)",
    y        = "Probabilidad (%)",
    fill     = "Origen"
  )

6. Test de Bondad

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

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

7. 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)? 13.02% 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)? 11510 pozos 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.

8. Intervalo de Confianza

p_hat   <- conteo_modelo$Frecuencia_Absoluta[1] / sum(tabla_frec$Frecuencia_Absoluta)
n_total <- sum(tabla_frec$Frecuencia_Absoluta)
categoria_frecuente <- municipio_principal

z      <- qnorm(0.975)
margen <- z * sqrt(p_hat * (1 - p_hat) / n_total)

ic_inf <- p_hat - margen
ic_sup <- p_hat + margen

cat("Municipio más frecuente:", categoria_frecuente, "\n")
## Municipio más frecuente: Allegany
cat("Intervalo de confianza al 95%: (",
    round(ic_inf * 100, 2), "% ,", round(ic_sup * 100, 2), "% )\n")
## Intervalo de confianza al 95%: ( 12.71 % , 13.32 % )
res_ic <- tibble(
  `Municipio Más Frecuente` = categoria_frecuente,
  `Proporción (p_hat)` = round(p_hat, 4),
  `Límite Inferior (95%)` = paste0(round(ic_inf * 100, 2), " %"),
  `Límite Superior (95%)` = paste0(round(ic_sup * 100, 2), " %")
)

res_ic %>%
  kable(caption = "Tabla N°3: Intervalo de Confianza (95%) para la Proporción del Municipio Principal",
        align = 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°3: Intervalo de Confianza (95%) para la Proporción del Municipio Principal
Municipio Más Frecuente Proporción (p_hat) Límite Inferior (95%) Límite Superior (95%)
Allegany 0.1302 12.71 % 13.32 %
Autor: Jennifer Cordones

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

Finalmente, mediante la aproximación normal, se establece con un 95% de confianza que la verdadera proporción de pozos pertenecientes al municipio principal (Allegany) se encuentra acotada entre el 12.71% y el 13.32%.


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