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

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

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 — REGION (ni y hi %)",
        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 — REGION (ni y hi %)
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

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

5. 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) # Parámetro optimizado para convergencia de bondad
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 Estricto comparado con la Realidad",
    subtitle = "Evaluación de ajuste por decaimiento exponencial",
    x        = "Región (orden por frecuencia descendente)",
    y        = "Probabilidad (%)",
    fill     = "Origen"
  )

6. Test de Bondad

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

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

7. 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)? 84.21% 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

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

res_ic <- tibble(
  `Región 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 de la Región 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 de la Región Principal
Región Más Frecuente Proporción (p_hat) Límite Inferior (95%) Límite Superior (95%)
9 0.8421 83.88 % 84.54 %
Autor: Jennifer Cordones

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

Finalmente, mediante la aproximación normal, se establece con un 95% de confianza que la verdadera proporción de pozos pertenecientes a la región principal se encuentra acotada entre el 83.88% y el 84.54%.

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