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

df_clean <- datos_originales %>%
  select(Quad_Section = `QUAD SECTION`) %>%
  filter(!is.na(Quad_Section)) %>%
  mutate(Quad_Section = as.character(Quad_Section))

tabla_frec <- df_clean %>%
  count(QUAD_SECTION = Quad_Section, 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(
  QUAD_SECTION = "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(Sección = QUAD_SECTION, `ni (Absoluta)` = Frecuencia_Absoluta, `hi % (Relativa)` = Porcentaje) %>%
  kable(caption = "Tabla N°1: Tabla Completa 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 Completa de Distribución de Frecuencias
Sección ni (Absoluta) hi % (Relativa)
G 6723 14.45
E 6156 13.23
I 6093 13.10
D 5772 12.41
H 5546 11.92
F 4933 10.60
B 4831 10.39
C 3264 7.02
A 3201 6.88
Total 46519 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 = 12, hjust = 0.5),
    panel.grid.major.x = element_blank(), 
    panel.grid.minor.x = element_blank(),
    axis.text.x = element_text(angle = 0, hjust = 0.5, vjust = 0.5, size = 10, face = "bold")
  )

4.1 Diagrama de Barras — Frecuencia Absoluta

ggplot(tabla_frec, aes(x = reorder(QUAD_SECTION, -Frecuencia_Absoluta), y = Frecuencia_Absoluta, fill = QUAD_SECTION)) +
  geom_col(show.legend = FALSE) +
  scale_fill_manual(values = paleta_colores_9) +
  geom_text(aes(label = Frecuencia_Absoluta), vjust = -0.5, size = 3.5, fontface = "bold") +
  tema_vertical +
  labs(
    title = "Diagrama de Frecuencia Absoluta por Sección del Cuadrante",
    x = "Sección del Cuadrante",
    y = "Frecuencia Absoluta (ni)",
    caption = "Fuente: Oil, Gas & Other Regulated Wells - NY State"
  ) +
  ylim(0, max(tabla_frec$Frecuencia_Absoluta) * 1.15)

4.2 Diagrama de Barras — Frecuencia Relativa / Porcentajes

ggplot(tabla_frec, aes(x = reorder(QUAD_SECTION, -Porcentaje), y = Porcentaje, fill = QUAD_SECTION)) +
  geom_col(show.legend = FALSE) +
  scale_fill_manual(values = paleta_colores_9) +
  geom_text(aes(label = paste0(round(Porcentaje, 1), "%")), vjust = -0.5, size = 3.5, fontface = "bold") +
  tema_vertical +
  labs(
    title = "Diagrama de Porcentajes por Sección del Cuadrante",
    x = "Sección del Cuadrante",
    y = "Porcentaje (%)",
    caption = "Fuente: Oil, Gas & Other Regulated Wells - NY State"
  ) +
  ylim(0, max(tabla_frec$Porcentaje) * 1.15)

5. Conjetura de Modelo Geométrico

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

p_est <- conteo_modelo$Porcentaje[1] / 100
k_categorias <- nrow(conteo_modelo) # 9 secciones
x_vals <- 1:k_categorias

prob_geom <- p_est * ((1 - p_est)^(x_vals - 1))
prob_geom_norm <- prob_geom / sum(prob_geom)

conteo_modelo$hi_pct <- round(conteo_modelo$Porcentaje, 2)
conteo_modelo$hi_modelo_pct <- round(prob_geom_norm * 100, 2)

Gráfica comparativa de los valores observados y estimados

df_comparativo <- conteo_modelo %>%
  select(QUAD_SECTION, 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 Geométrico"))

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

ggplot(df_comparativo, aes(x = QUAD_SECTION, y = Valor, fill = Origen)) +
  geom_bar(stat = "identity", position = "dodge", color = "white") +
  scale_fill_manual(values = c("Modelo Geométrico" = "#7ABDEF", "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 = 0, hjust = 0.5, vjust = 0.5, size = 10, face = "bold")
  ) +
  labs(
    title    = "Gráfica N°3: Modelo Geométrico comparado con la Realidad",
    subtitle = paste0("Parámetro p estimado = ", round(p_est, 4)),
    x        = "Sección del Cuadrante",
    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 (%): 91.0078
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 (Pearson)", line = 2.5, adj = 0.5)
abline(lm(Fe ~ 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 calculado:", round(chi2_calc, 4), "\n")
## Chi-Cuadrado calculado: 3.9927
cat("Valor Crítico (95% confianza):", round(chi2_crit, 4), "\n")
## Valor Crítico (95% confianza): 15.5073
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          = "Sección del Cuadrante (9 Secciones)",
  `Modelo Teórico`  = "Modelo Geométrico",
  `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 Geométrico",
        align = c("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 Geométrico
Variable Modelo Teórico Test Pearson (%) Chi Cuadrado Umbral de Aceptación Resultado
Sección del Cuadrante (9 Secciones) Modelo Geométrico 91.01 3.99 15.51 Modelo Aceptado
Autor: Jennifer Cordones

7. Cálculo de Probabilidades

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

cat("Probabilidad de estar en el cuadrante más frecuente (", cuadrante_principal, "):",
    round(prob_principal, 2), "%\n")
## Probabilidad de estar en el cuadrante más frecuente ( G ): 14.45 %
# Pozos acumulados en los dos cuadrantes reales principales
pozos_top2 <- sum(conteo_modelo$Frecuencia_Absoluta[1:min(2, nrow(conteo_modelo))])
cuadrantes_top2 <- paste(conteo_modelo$QUAD_SECTION[1:min(2, nrow(conteo_modelo))], collapse = " y ")

cat("Pozos en las principales concentraciones territoriales (", cuadrantes_top2, "):", pozos_top2, "\n")
## Pozos en las principales concentraciones territoriales ( G y E ): 12879

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

¿Cuántos pozos se encuentran ubicados entre las principales concentraciones territoriales (G y E)? 12879 pozos En la base de datos analizada, un total de 12879 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)

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(
  `Sección Más Frecuente` = cuadrante_principal,
  `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 Secció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 Sección Principal
Sección Más Frecuente Proporción (p_hat) Límite Inferior (95%) Límite Superior (95%)
G 0.1445 14.13 % 14.77 %
Autor: Jennifer Cordones

9. Conclusión

Utilizando las 9 secciones originales del dataset, se evaluó la conjetura del Modelo Geométrico junto con el Test de Pearson (91.01%) y la prueba de Chi-cuadrado.

Las gráficas de barras se estructuraron de forma independiente para la frecuencia absoluta y el porcentaje, manteniendo las etiquetas orientadas horizontalmente. Mediante el cálculo de probabilidades, se identificó la sección con mayor incidencia (G), y a través de la estimación por intervalos con un 95% de confianza, se determina que su verdadera proporción poblacional se encuentra comprendida entre el 14.13% y el 14.77%.

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