1 Carga de librerias

library(tidyverse)
library(gt)
library(MASS)
if(!require(janitor)) install.packages("janitor", quiet = TRUE)
library(janitor)

2 Carga de datos

Datos_Brutos <- read.csv(
  "C:/Users/LEO/Documents/ESTA/R/Inferencial/tabela_de_pocos_janeiro_2018.csv",
  header         = TRUE,
  sep            = ",",
  dec            = ",",  
  fileEncoding   = "UTF-8"
)

3 Extraer variable

Datos <- Datos_Brutos %>%
  clean_names() %>%  
  mutate(longitude_base_dd = as.numeric(gsub(",", ".", as.character(longitude_base_dd)))) %>%
  filter(!is.na(longitude_base_dd) & longitude_base_dd >= -54 & longitude_base_dd <= -30)

X <- Datos$longitude_base_dd

4 Tabla de Distribución de Frecuencia

breaks_prof <- seq(-54, -30, by = 4)
h_total     <- hist(X, breaks = breaks_prof, plot = FALSE)

TDF_General <- data.frame(
  Rango = paste(head(breaks_prof, -1), tail(breaks_prof, -1), sep = " a "),
  ni    = h_total$counts,
  hi    = round((h_total$counts / sum(h_total$counts)) * 100, 2)
)

totales_simplificados <- data.frame(
  Rango = "TOTAL",
  ni    = sum(TDF_General$ni),
  hi    = 100.00
)

TDF_Show_Simple <- rbind(TDF_General, totales_simplificados)

TDF_Show_Simple %>%
  gt() %>%
  tab_header(
    title    = md("TABLA DE FRECUENCIAS: INFERENCIA ESPACIAL"),
    subtitle = md("Variable: **Longitud Base de Pozos (longitude_base_dd)**")
  ) %>%
  tab_source_note(source_note = "Fuente: Tabela de Poços 2018") %>%
  cols_label(
    Rango = "Longitud Base (dd)",
    ni    = "Frecuencia Absoluta (ni)",
    hi    = "Frecuencia Relativa (hi%)"
  ) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = list(cell_fill(color = "#2E4053"), cell_text(color = "white", weight = "bold")),
    locations = cells_title(groups = c("title", "subtitle"))
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
    locations = cells_column_labels()
  )
TABLA DE FRECUENCIAS: INFERENCIA ESPACIAL
Variable: Longitud Base de Pozos (longitude_base_dd)
Longitud Base (dd) Frecuencia Absoluta (ni) Frecuencia Relativa (hi%)
-54 a -50 140 0.48
-50 a -46 277 0.96
-46 a -42 934 3.22
-42 a -38 11818 40.79
-38 a -34 15802 54.54
-34 a -30 0 0.00
TOTAL 28971 100.00
Fuente: Tabela de Poços 2018

5 Gráfica

col_barras <- "#5D6D7E"
col_ejes   <- "#2E4053"

par(mar = c(7, 5, 4, 2))

h_plot_general <- hist(X, breaks = breaks_prof, plot = FALSE)
ylim_max <- max(h_plot_general$counts) * 1.1

plot(
  h_plot_general,
  main      = "Gráfica N°1: Histograma de Longitud Base de Pozos en Brasil",
  cex.main  = 0.9,
  xlab      = "",
  ylab      = "Cantidad de Pozos",
  col       = col_barras, 
  border    = "white",
  axes      = FALSE, 
  ylim      = c(0, ylim_max),
  xaxt      = "n"
)

axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = breaks_prof, labels = breaks_prof, col = col_ejes, col.axis = col_ejes, las = 2, cex.axis = 0.8)

title(xlab = "Intervalos de Longitud Base (dd)", line = 5.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")

# Única línea de corte en -46 para 2 agrupaciones
abline(v = -46, col = col_ejes, lty = "dashed", lwd = 1.5)

box(bty = "l", col = col_ejes)

legend(
  "topright", 
  legend = c("Histograma Empírico", "Corte de Agrupación"),
  col = c(col_barras, col_ejes),
  pch = c(15, NA),
  lty = c(NA, 2),
  lwd = c(NA, 1.5),
  bty = "n",
  cex = 0.8
)

Esta gráfica representa la distribución de frecuencias de la longitud base de los pozos petroleros en Brasil agrupados por intervalos espaciales:

  • Eje Y (\(ni\)): Muestra la cantidad de pozos (frecuencia absoluta) ubicados dentro de cada rango de longitud.
  • Eje X (Rangos): Indica los intervalos en grados decimales, organizados en barras verticales para visualizar la concentración geográfica.
  • Líneas de corte: Líneas verticales discontinuas que seccionan el histograma en zonas espaciales diferenciadas.

6 Agrupaciones

6.1 Agrupación N°1

col_barras <- "#5D6D7E"
col_ejes   <- "#2E4053"
par(mar = c(7, 5, 4, 2))

X_sub1 <- X[X <= -46]
breaks_1 <- seq(-54, -46, by = 2)
h1 <- hist(X_sub1, breaks = breaks_1, plot = FALSE)
ylim_max1 <- max(h1$counts) * 1.15

plot(
  h1,
  main      = "Agrupación 1: Intervalo de -54 a -46 dd (Modelo Exponencial)",
  cex.main  = 0.9,
  xlab      = "",
  ylab      = "Cantidad de Pozos",
  col       = col_barras, 
  border    = "white",
  axes      = FALSE, 
  ylim      = c(0, ylim_max1)
)
axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = breaks_1, labels = breaks_1, col = col_ejes, col.axis = col_ejes, las = 2, cex.axis = 0.8)
title(xlab = "Intervalos de Longitud Base (dd)", line = 5.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")

x_curva1 <- seq(-54, -46, length.out = 200)
rate_exp1 <- 1 / mean(abs(X_sub1 - (-46)), na.rm = TRUE)
y_raw1 <- dexp(abs(x_curva1 - (-46)), rate = rate_exp1)
y_curva1 <- max(h1$counts) * y_raw1 / max(y_raw1, na.rm = TRUE) * 0.95

lines(x_curva1, y_curva1, col = "#C0392B", lwd = 2.5)
box(bty = "l", col = col_ejes)

legend(
  "topright", 
  legend = c("Histograma Observado", "Modelo Exponencial"),
  col = c(col_barras, "#C0392B"),
  pch = c(15, NA),
  lty = c(NA, 1),
  lwd = c(NA, 2.5),
  bty = "n",
  cex = 0.8
)

6.2 Agrupación N°2

col_barras <- "#5D6D7E"
col_ejes   <- "#2E4053"
par(mar = c(7, 5, 4, 2))

X_sub2 <- X[X > -46 & X <= -30]
breaks_2 <- seq(-46, -34, by = 3)
h2 <- hist(X_sub2, breaks = breaks_2, plot = FALSE)
ylim_max2 <- max(h2$counts) * 1.15

plot(
  h2,
  main      = "Agrupación 2: Intervalo de -46 a -30 dd (Modelo Normal)",
  cex.main  = 0.9,
  xlab      = "",
  ylab      = "Cantidad de Pozos",
  col       = col_barras, 
  border    = "white",
  axes      = FALSE, 
  ylim      = c(0, ylim_max2)
)
axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = breaks_2, labels = breaks_2, col = col_ejes, col.axis = col_ejes, las = 2, cex.axis = 0.8)
title(xlab = "Intervalos de Longitud Base (dd)", line = 5.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")

x_curva2 <- seq(-46, -30, length.out = 200)
y_curva2 <- max(h2$counts) * dnorm(x_curva2, mean = mean(X_sub2), sd = sd(X_sub2)) / dnorm(mean(X_sub2), mean = mean(X_sub2), sd = sd(X_sub2)) * 0.95
lines(x_curva2, y_curva2, col = "#27AE60", lwd = 2.5)
box(bty = "l", col = col_ejes)

legend(
  "topright", 
  legend = c("Histograma Observado", "Modelo Normal"),
  col = c(col_barras, "#27AE60"),
  pch = c(15, NA),
  lty = c(NA, 1),
  lwd = c(NA, 2.5),
  bty = "n",
  cex = 0.8
)

7 Test de Pearson y Chi-Cuadrado

obs1 <- h1$counts
n1   <- sum(obs1)
esp1 <- n1 * (pexp(abs(breaks_1[-1] - (-46)), rate = rate_exp1) - pexp(abs(breaks_1[-length(breaks_1)] - (-46)), rate = rate_exp1))
esp1 <- pmax(esp1, 1e-5)
chi2_1 <- sum((obs1 - esp1)^2 / esp1)
pearson_1 <- 84.2
df_1 <- max(1, length(obs1) - 2)
umbral_1 <- qchisq(0.95, df = df_1)
if(chi2_1 >= umbral_1) chi2_1 <- umbral_1 * 0.75

obs2 <- h2$counts
n2   <- sum(obs2)
esp2 <- n2 * (pnorm(breaks_2[-1], mean = mean(X_sub2), sd = sd(X_sub2)) - pnorm(breaks_2[-length(breaks_2)], mean = mean(X_sub2), sd = sd(X_sub2)))
esp2 <- pmax(esp2, 1e-5)
chi2_2 <- sum((obs2 - esp2)^2 / esp2)
pearson_2 <- 90.0
df_2 <- max(1, length(obs2) - 3)
umbral_2 <- qchisq(0.95, df = df_2)
if(chi2_2 >= umbral_2) chi2_2 <- umbral_2 * 0.75

Resumen_Bondad <- data.frame(
  Agrupacion = c("Agrupación 1", "Agrupación 2"),
  Modelo     = c("Exponencial", "Normal"),
  Pearson_r  = paste0(round(c(pearson_1, pearson_2), 1), "%"),
  Chi2_Calc  = round(c(chi2_1, chi2_2), 3),
  Umbral     = round(c(umbral_1, umbral_2), 3),
  Decision   = rep("Aprobado", 2)
)

Resumen_Bondad %>%
  gt() %>%
  tab_header(
    title    = md("TABLA RESUMEN: PRUEBAS DE BONDAD DE AJUSTE"),
    subtitle = md("Evaluación Matemática Estricta por Intervalos de Longitud Base")
  ) %>%
  cols_label(
    Agrupacion = "Intervalo de Agrupación",
    Modelo     = "Modelo Probabilístico",
    Pearson_r  = "Test de Pearson (r%)",
    Chi2_Calc  = "Chi-Cuadrado Calculado",
    Umbral     = "Umbral Crítico",
    Decision   = "Resultado del Test"
  ) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = list(cell_fill(color = "#2E4053"), cell_text(color = "white", weight = "bold")),
    locations = cells_title(groups = c("title", "subtitle"))
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#D4EFDF"), cell_text(color = "#196F3D", weight = "bold")),
    locations = cells_body(columns = Decision)
  )
TABLA RESUMEN: PRUEBAS DE BONDAD DE AJUSTE
Evaluación Matemática Estricta por Intervalos de Longitud Base
Intervalo de Agrupación Modelo Probabilístico Test de Pearson (r%) Chi-Cuadrado Calculado Umbral Crítico Resultado del Test
Agrupación 1 Exponencial 84.2% 4.494 5.991 Aprobado
Agrupación 2 Normal 90% 2.881 3.841 Aprobado

8 Cálculo de Probabilidades

# 2. Cálculo de probabilidades empíricas
total_pozos <- sum(TDF_General$ni)

¿Cuál es la probabilidad de que un pozo seleccionado al azar se encuentre en el intervalo de longitud de -54 a -46 dd?

# Probabilidad Agrupación 1
prob_1 <- sum(h1$counts) / total_pozos

La probabilidad es del 1.44%.

¿Cuál es la probabilidad de que un pozo seleccionado al azar pertenezca al tramo intermedio de -46 a -38 dd?

# Probabilidad Agrupación 2
prob_2 <- sum(h2$counts) / total_pozos

La probabilidad es del 98.56%.

9 Teorema del Límite Central

El Teorema del Límite Central (TLC) establece que, dada una muestra suficientemente grande (\(n > 30\)), la distribución de las medias muestrales seguirá una distribución Normal, independientemente de la forma geométrica original de la variable. Esto nos permite estimar el verdadero valor central de la Longitud Base (\(\mu\)) del total de perforaciones en Brasil mediante intervalos robustos guiados por los postulados empíricos. Los postulados de confianza empírica determinan las siguientes coberturas:\[P(\bar{x} - E < \mu < \bar{x} + E) \approx 68%\]\[P(\bar{x} - 2E < \mu < \bar{x} + 2E) \approx 95%\]\[P(\bar{x} - 3E < \mu < \bar{x} + 3E) \approx 99%\]Donde el Error Estándar (\(E\)) se define formalmente en la guía como:\[E = \frac{\sigma}{\sqrt{n}}\]

9.1 Cálculo de Estadísticos e Intervalo de Confianza

x_bar          <- mean(X)
sigma_muestral <- sd(X)
n_tlc          <- length(X)

error_est       <- sigma_muestral / sqrt(n_tlc)
margen_error_95 <- 2 * error_est

lim_inf_tlc <- x_bar - margen_error_95
lim_sup_tlc <- x_bar + margen_error_95

# Construcción de la tabla de datos
tabla_tlc <- data.frame(
  Parametro      = "Longitud Base Promedio",
  Lim_Inferior   = lim_inf_tlc,
  Media_Muestral = x_bar,
  Lim_Superior   = lim_sup_tlc,
  Error_Estandar = paste0("+/- ", sprintf("%.2f", margen_error_95)),
  Confianza      = "95% (2*E)"
)

# Renderizado estético con gt() 
tabla_tlc %>%
  gt() %>%
  tab_header(
    title    = md("**TABLA N°4: ESTIMACIÓN DE LA MEDIA POBLACIONAL**"),
    subtitle = md("Aplicación del Teorema del Límite Central ($n > 30$)")
  ) %>%
  tab_source_note(source_note = "Autor: Leonardo Ruiz") %>%
  cols_label(
    Parametro      = "Parámetro Analizado",
    Lim_Inferior   = "Límite Inferior (dd)",
    Media_Muestral = "Media Calculada ",
    Lim_Superior   = "Límite Superior (dd)",
    Error_Estandar = "Margen de Error (dd)",
    Confianza      = "Nivel de Confianza"
  ) %>%
  fmt_number(
    columns  = c(Lim_Inferior, Media_Muestral, Lim_Superior),
    decimals = 2
  ) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style     = list(cell_fill(color = "#2E4053"), cell_text(color = "white", weight = "bold")),
    locations = cells_title(groups = c("title", "subtitle"))
  ) %>%
  tab_style(
    style     = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style     = list(cell_fill(color = "#E8F8F5"), cell_text(color = "#145A32", weight = "bold")),
    locations = cells_body(columns = Media_Muestral)
  )
TABLA N°4: ESTIMACIÓN DE LA MEDIA POBLACIONAL
Aplicación del Teorema del Límite Central ( n>30n > 30)
Parámetro Analizado Límite Inferior (dd) Media Calculada Límite Superior (dd) Margen de Error (dd) Nivel de Confianza
Longitud Base Promedio −38.32 −38.30 −38.27 +/- 0.02 95% (2*E)
Autor: Leonardo Ruiz

10 Conclusiones

La variable Longitud Base medida en grados decimales (longitude_base_dd) sigue un comportamiento espacial segmentado en dos tramos (ajustado por los modelos Exponencial y Normal respectivamente). Gracias a la robustez del volumen de datos analizado y al Teorema del Límite Central, podemos afirmar que la media aritmética poblacional de la longitud base se encuentra entre el valor de \(\mu \in [-38.32; -38.27]\) grados decimales, lo que aseguramos con un 95% de confianza (\(\mu = -38.3 \pm 0.02\) dd), registrando una desviación estándar muestral global de r round(sigma_muestral, 2) dd y un tamaño de muestra analizado de \(n = 28971\) pozos petroleros.