Quad (Cuadrante) — Estadística Inferencial

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 QUAD registra el cuadrante cartográfico 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(Quad = QUAD) %>%
  filter(!is.na(Quad)) %>%
  mutate(Quad = as.character(Quad))

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

tabla_frec <- df_clean %>%
  mutate(QUAD = ifelse(Quad %in% top_8, Quad, "Otros")) %>%
  count(QUAD, 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(
  QUAD = "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(Cuadrante = QUAD, `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

Cuadrante	ni (Absoluta)	hi % (Relativa)
Otros	20212	43.52
Knapp Creek	6622	14.26
Allentown	6154	13.25
Bolivar	5960	12.83
Olean	2966	6.39
Whitesville	1457	3.14
Wellsville South	1220	2.63
Rexville	982	2.11
Lakewood	871	1.88
Total	46444	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(QUAD, -Frecuencia_Absoluta), y = Frecuencia_Absoluta, fill = QUAD)) +
  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 Cuadrante",
    x = "Cuadrante",
    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(QUAD, -Porcentaje), y = Porcentaje, fill = QUAD)) +
  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 Cuadrante",
    x = "Cuadrante",
    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(QUAD != "Otros")

conteo_modelo <- tabla_modelo %>%
  mutate(QUAD = as.character(QUAD)) %>%
  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.3401

# 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(QUAD, 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$QUAD <- factor(df_comparativo$QUAD, levels = conteo_modelo$QUAD)

ggplot(df_comparativo, aes(x = QUAD, 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 — Cuadrante",
    subtitle = paste0("p estimado = ", round(p_estimado, 4)),
    x        = "Cuadrante (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 (%): 91.5705

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: 7.9851

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          = "Cuadrante (QUAD)",
  `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
Cuadrante (QUAD)	91.57	7.99	12.59	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[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 ( Knapp Creek ): 14.26 %

# 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[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 ( Knapp Creek y Allentown ): 12776

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

¿Cuántos pozos se encuentran ubicados entre las principales concentraciones territoriales (Knapp Creek y Allentown)? 12776 pozos En la base de datos analizada, un total de 12776 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 <- cuadrante_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("Cuadrante más frecuente:", categoria_frecuente, "\n")

## Cuadrante más frecuente: Knapp Creek

cat("Intervalo de confianza al 95%: (",
    round(ic_inf * 100, 2), "% ,", round(ic_sup * 100, 2), "% )\n")

## Intervalo de confianza al 95%: ( 13.94 % , 14.58 % )

res_ic <- tibble(
  `Cuadrante 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 Cuadrante 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 Cuadrante Principal

Cuadrante Más Frecuente	Proporción (p_hat)	Límite Inferior (95%)	Límite Superior (95%)
Knapp Creek	0.1426	13.94 %	14.58 %
Autor: Jennifer Cordones

9. Conclusión

Tras filtrar los registros nulos de la variable QUAD 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 cuadrante real Knapp Creek concentra el 14.26% 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 7.9851 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 91.57%.

Finalmente, mediante la aproximación normal, se establece con un 95% de confianza que la verdadera proporción de pozos pertenecientes al cuadrante principal (Knapp Creek) se encuentra acotada entre el 13.94% y el 14.58%.

---

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