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

2. Extracción y Limpieza de la Variable

La variable REGION registra la región administrativa donde se ubica el pozo. Se analizan todos los valores individuales registrados en la base de datos sin omitir ni agrupar ninguna categoría.

tabla_frec <- datos_originales %>%
  select(Region = REGION) %>%
  filter(!is.na(Region)) %>%
  mutate(REGION = as.character(Region)) %>%
  count(REGION, 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(
  REGION = "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(Región = REGION, `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
Región ni (Absoluta) hi % (Relativa)
9 39894 84.21
8 5206 10.99
7 1684 3.55
2 247 0.52
6 114 0.24
3 112 0.24
4 96 0.20
5 19 0.04
1 4 0.01
Total 47376 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(REGION, -Frecuencia_Absoluta), y = Frecuencia_Absoluta, fill = REGION)) +
  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 Región",
    x = "Región",
    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(REGION, -Porcentaje), y = Porcentaje, fill = REGION)) +
  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 Región",
    x = "Región",
    y = "Porcentaje (%)",
    caption = "Fuente: Oil, Gas & Other Regulated Wells - NY State"
  )

6. Conjetura de Modelo Geométrico Estricto

conteo_modelo <- tabla_frec %>%
  mutate(REGION = as.character(REGION)) %>%
  arrange(desc(Frecuencia_Absoluta))

conteo_modelo$ID <- 1:nrow(conteo_modelo)

total_reales <- sum(conteo_modelo$Frecuencia_Absoluta)
conteo_modelo$hi_recurso <- conteo_modelo$Frecuencia_Absoluta / total_reales

# Estimación del parámetro p de la distribución geométrica basada en la media observada
media_obs <- sum(conteo_modelo$ID * conteo_modelo$hi_recurso)
p_geom <- 1 / media_obs

# Cálculo de probabilidades teóricas geométricas discretas (x = 0, 1, 2...)
x_vals <- conteo_modelo$ID - 1
prob_teorica <- dgeom(x_vals, prob = 0.65) 
prob_teorica <- prob_teorica / sum(prob_teorica)

conteo_modelo$hi_modelo     <- round(prob_teorica, 4)
conteo_modelo$hi_modelo_pct <- round(prob_teorica * 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(REGION, 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$REGION <- factor(df_comparativo$REGION, levels = conteo_modelo$REGION)

ggplot(df_comparativo, aes(x = REGION, 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        = "Región (orden por frecuencia descendente)",
    y        = "Probabilidad (%)",
    fill     = "Origen"
  )

7. Test de Bondad

7.1 Test de Pearson

df_pearson <- tibble(Fo = Fo, Fe = Fe)

ggplot(df_pearson, aes(x = Fo, y = Fe)) +
  geom_point(color = "#1D4E73", size = 3) +
  geom_smooth(method = "lm", formula = y ~ 0 + x, color = "red", se = FALSE, linetype = "dashed") +
  theme_minimal() +
  theme(
    plot.title = element_text(face = "bold", color = "#1D4E73", size = 12, hjust = 0.5),
    axis.text = element_text(face = "bold")
  ) +
  labs(
    title = "Gráfica N°4: Correlación Modelo Observado y Esperado",
    x = "Frecuencia Observada (hi %)",
    y = "Frecuencia Esperada (hi modelo %)",
    subtitle = paste0("r = ", round(r_pearson, 2), "%")
  )

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

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

Tabla Resumen del Test

resultado_test <- ifelse(chi2_calc < chi2_crit, "Modelo Aceptado", "Modelo Rechazado")

tabla_test <- data.frame(
  Variable          = "Región (REGION)",
  `Test Pearson (%)`= round(r_pearson, 2),
  `Chi Cuadrado`    = round(chi2_calc, 2),
  `Umbral de Aceptación` = round(chi2_crit, 2),
  Resultado         = resultado_test,
  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
Región (REGION) 97.56 16.68 12.59 Modelo Rechazado
Autor: Jennifer Cordones

8. Cálculo de Probabilidades

prob_principal <- (conteo_modelo$Frecuencia_Absoluta[1] / sum(tabla_frec$Frecuencia_Absoluta)) * 100
region_principal <- as.character(conteo_modelo$REGION[1])

pozos_top2 <- sum(conteo_modelo$Frecuencia_Absoluta[1:min(2, nrow(conteo_modelo))])
regiones_top2 <- paste(conteo_modelo$REGION[1:min(2, nrow(conteo_modelo))], collapse = " y ")

¿Cuál es la probabilidad de que un pozo seleccionado al azar se encuentre en la región con mayor concentración (9)? La probabilidad estimada indica que aproximadamente el 84.21% de los pozos regulados se concentran en la región 9.

¿Cuántos pozos se encuentran ubicados entre las principales concentraciones territoriales (9 y 8)? 45100 pozos

9. Conclusión

Tras procesar la totalidad de los valores individuales de la variable REGION sin omitir ninguna categoría, se constata que la región 9 concentra el 84.21% de los pozos registrados en el estado de Nueva York.

Mediante la implementación del Modelo Geométrico Estricto, se evaluó el decaimiento exponencial de las frecuencias a lo largo de las demarcaciones territoriales. El contraste mediante la prueba Chi-Cuadrado arrojó un estadístico de 16.6812 frente al umbral crítico de 12.5916, validando formalmente el modelo rechazado del modelo con una correlación de Pearson del 97.56%.


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