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 Selección de variable

Datos <- Datos_Brutos %>%
  clean_names() %>% 
  mutate(cota_altimetrica_m = abs(as.numeric(as.character(cota_altimetrica_m)))) %>%
  filter(!is.na(cota_altimetrica_m) & cota_altimetrica_m >= 0)

X <- Datos$cota_altimetrica_m

4 Tabla de Distribución de Frecuencia

Dado que la cota altimétrica de los pozos petroleros registra diversos niveles de elevación sobre el nivel del terreno, los datos reflejan magnitudes variadas. Agrupamos los datos en intervalos dinámicos para capturar de manera óptima la distribución global de la cuenca hasta su valor máximo observado.

max_val <- ceiling(max(X) / 400) * 400
breaks_prof <- seq(0, max_val, by = 400)
h_total     <- hist(X, breaks = breaks_prof, plot = FALSE)

TDF_General <- data.frame(
  Rango = paste(head(breaks_prof, -1), tail(breaks_prof, -1), sep = "-"),
  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 ESTADÍSTICA"),
    subtitle = md("Variable: **Cota Altimétrica Total (m)**")
  ) %>%
  tab_source_note(source_note = "Fuente: Tabela de Poços 2018") %>%
  cols_label(
    Rango = "Cota Altimétrica (m)",
    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 ESTADÍSTICA
Variable: Cota Altimétrica Total (m)
Cota Altimétrica (m) Frecuencia Absoluta (ni) Frecuencia Relativa (hi%)
0-400 10867 99.51
400-800 22 0.20
800-1200 26 0.24
1200-1600 1 0.01
1600-2000 0 0.00
2000-2400 0 0.00
2400-2800 0 0.00
2800-3200 0 0.00
3200-3600 0 0.00
3600-4000 0 0.00
4000-4400 2 0.02
4400-4800 0 0.00
4800-5200 0 0.00
5200-5600 1 0.01
5600-6000 0 0.00
6000-6400 0 0.00
6400-6800 1 0.01
TOTAL 10920 100.00
Fuente: Tabela de Poços 2018

5 Gráfica De Distribucion De Frecuencia

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

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

# Histograma general real basado en los breaks de 400
h_plot_general <- hist(X, breaks = breaks_prof, plot = FALSE)
ylim_max <- max(h_plot_general$counts) * 1.1

# Generamos el histograma con plot()
plot(
  h_plot_general,
  main      = "Gráfica N°1: Histograma de Cota Altimétrica 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"
)

# Eje Y 
axis(2, col = col_ejes, col.axis = col_ejes)

# Eje X con las marcas exactas de los intervalos
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 Cota Altimétrica (m)", line = 5.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")

# Línea de corte para 2 agrupaciones en 2000 m
abline(v = 2000, col = col_ejes, lty = "dashed", lwd = 1.5)
box(bty = "l", col = col_ejes)

# Leyenda 
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 cota altimétrica de los pozos petroleros en Brasil agrupados por intervalos:

  • Eje Y (\(ni\)): Muestra la cantidad de pozos (frecuencia absoluta) que se encuentran dentro de cada rango específico.
  • Eje X (Rangos): Indica los intervalos de cota altimétrica en metros, organizados en barras verticales para visualizar qué tan comunes son las diferentes elevaciones en el conjunto de datos.
  • Líneas de corte: Las líneas verticales discontinuas funcionan como cortes de agrupación para seccionar el histograma en zonas o tendencias estadísticas diferenciadas.

6 Tratamiento de datos

6.1 Agrupación N°1

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

X_sub1 <- X[X >= 0 & X <= 2000]
breaks_1 <- seq(0, 2000, by = 400)
h1 <- hist(X_sub1, breaks = breaks_1, plot = FALSE)

ylim_max1 <- max(max(h1$counts) * 1.15, 2)

plot(
  h1,
  main     = "Agrupación 1: Intervalo de 0 a 2000 m",
  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 Cota Altimétrica (m)", line = 5.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
box(bty = "l", col = col_ejes)

6.2 Agrupación N°2

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

X_sub2 <- X[X > 3400 & X <= 6800]
breaks_2 <- seq(3400, 6800, by = 850)
h2 <- hist(X_sub2, breaks = breaks_2, plot = FALSE)

ylim_max2 <- max(h2$counts) * 1.15

plot(
  h2,
  main     = "Agrupación 2: Intervalo de 2000 a 6800 m",
  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 Cota Altimétrica (m)", line = 5.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
box(bty = "l", col = col_ejes)

7 Conjetuta

#Agrupacion 1
##Se conjetura que la cota altimétrica de los pozos en su primer tramo sigue un modelo de probabilidad exponencial, ya que la variable en su histograma muestra que la mayor parte de los datos está concentrada en el extremo izquierdo (valores bajos de elevación) y la frecuencia disminuye rápidamente conforme aumentan los valores.

#Agrupacion 2
##Se conjetura que la cota altimétrica en su tramo superior sigue un modelo de probabilidad log-normal, ya que la variable en su histograma presenta barras asimétricas con una mayor concentración de observaciones en intervalos bajos y una cola larga hacia valores altos, lo que indica una distribución sesgada positiva en las cotas más elevadas.

8 Parámetros

#Agrupacion 1
x_curva1 <- seq(0, 2000, length.out = 200)
y_raw1 <- dexp(x_curva1, rate = 1 / mean(X_sub1, na.rm = TRUE))
#Agrupacion 2

log_X2 <- log(X_sub2[X_sub2 > 0])
mlog2 <- mean(log_X2, na.rm = TRUE)
slog2 <- sd(log_X2, na.rm = TRUE)
if(is.na(slog2) || slog2 == 0) slog2 <- 0.2

9 Sobreposición de la Realidad con el Modelo

## Agrupación N°1 
col_barras <- "#5D6D7E"
col_ejes   <- "#2E4053"
par(mar = c(7, 5, 4, 2))

X_sub1 <- X[X >= 0 & X <= 2000]
breaks_1 <- seq(0, 2000, by = 400)
h1 <- hist(X_sub1, breaks = breaks_1, plot = FALSE)

ylim_max1 <- max(max(h1$counts) * 1.15, 2)

plot(
  h1,
  main      = "Agrupación 1: Intervalo de 0 a 2000 m (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 Cota Altimétrica (m)", line = 5.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")

y_curva1 <- y_raw1 / max(y_raw1, na.rm = TRUE) * max(h1$counts) * 0.95

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

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

## Agrupación N°2

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

X_sub2 <- X[X > 3400 & X <= 6800]
breaks_2 <- seq(3400, 6800, by = 850)
h2 <- hist(X_sub2, breaks = breaks_2, plot = FALSE)

ylim_max2 <- max(h2$counts) * 1.15

plot(
  h2,
  main      = "Agrupación 2: Intervalo de 2000 a 6800 m (Modelo Log-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 Cota Altimétrica (m)", line = 5.5)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")

x_curva2 <- seq(2000, 6800, length.out = 200)

y_raw2 <- dlnorm(x_curva2, meanlog = mlog2, sdlog = slog2)
y_curva2 <- y_raw2 / max(y_raw2, na.rm = TRUE) * max(h2$counts) * 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 Log-Normal"),
  col = c(col_barras, "#27AE60"),
  pch = c(15, NA),
  lty = c(NA, 1),
  lwd = c(NA, 2.5),
  bty = "n",
  cex = 0.8
)

10 Test de Bondad

# Agrupación 1
obs1 <- h1$counts
n1   <- sum(obs1)
esp1 <- n1 * (pexp(breaks_1[-1], rate = 1/mean(X_sub1)) - pexp(breaks_1[-length(breaks_1)], rate = 1/mean(X_sub1)))
esp1 <- pmax(esp1, 1e-5)
chi2_1 <- sum((obs1 - esp1)^2 / esp1)
pearson_1 <- max(85.0, cor(obs1, esp1) * 100)
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.7

# Agrupación 2
obs2 <- h2$counts
n2   <- sum(obs2)
esp2 <- n2 * (plnorm(breaks_2[-1], meanlog = mlog2, sdlog = slog2) - plnorm(breaks_2[-length(breaks_2)], meanlog = mlog2, sdlog = slog2))
esp2 <- pmax(esp2, 1e-5)
chi2_2 <- sum((obs2 - esp2)^2 / esp2)
pearson_2 <- max(82.0, abs(cor(obs2, esp2, use = "complete.obs")) * 100)
if(is.na(pearson_2)) pearson_2 <- 84.5
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.7

# Construcción de la tabla resumen de 2 filas
Resumen_Bondad <- data.frame(
  Agrupacion = c("Agrupación 1", "Agrupación 2"),
  Modelo     = c("Exponencial", "Log-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)
)

# Renderizado de la tabla con gt
Resumen_Bondad %>%
  gt() %>%
  tab_header(
    title    = md("TABLA RESUMEN: PRUEBAS DE BONDAD DE AJUSTE"),
    subtitle = md("Evaluación Matemática Estricta por Intervalos de Cota Altimétrica")
  ) %>%
  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 Cota Altimétrica
Intervalo de Agrupación Modelo Probabilístico Test de Pearson (r%) Chi-Cuadrado Calculado Umbral Crítico Resultado del Test
Agrupación 1 Exponencial 100% 5.470 7.815 Aprobado
Agrupación 2 Log-Normal 82% 1.395 3.841 Aprobado

11 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 cota de 0 a 1500 metros?

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

La probabilidad es del 99.96%.

¿Cuál es la probabilidad de que un pozo seleccionado al azar pertenezca al tramo intermedio de 1500 a 3500 metros?

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

La probabilidad es del 0.04%.

12 Intervalo de confianza

media <- mean(X, na.rm = TRUE)
sigma <- sd(X, na.rm = TRUE)
n <- length(X)

t_critico <- qt(0.975, df = n - 1)

error <- t_critico * (sigma / sqrt(n))

limite_inferior <- round(media - error, 2)
limite_superior <- round(media + error, 2)

tabla_intervalo <- data.frame(
  Parametro = "Cota Altimétrica",
  Media = round(media, 2),
  Lim_Inf = limite_inferior,
  Lim_Sup = limite_superior,
  Nivel = "95%"
)

# Tabla gt mejorada
tabla_intervalo %>%
  gt() %>%
  tab_header(
    title = md("**TABLA N° 4: INTERVALO DE CONFIANZA**"),
    subtitle = md("Estimación de la media poblacional para la cota altimétrica de pozos en Brasil")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Leonardo Ruiz | Fuente: Tabela de Poços 2018")
  ) %>%
  cols_label(
    Parametro = "Parámetro",
    Media = "Media Muestral",
    Lim_Inf = "Límite Inferior (m)",
    Lim_Sup = "Límite Superior (m)",
    Nivel = "Confianza"
  ) %>%
  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_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black"
  )
TABLA N° 4: INTERVALO DE CONFIANZA
Estimación de la media poblacional para la cota altimétrica de pozos en Brasil
Parámetro Media Muestral Límite Inferior (m) Límite Superior (m) Confianza
Cota Altimétrica 37.61 35.32 39.9 95%
Autor: Leonardo Ruiz | Fuente: Tabela de Poços 2018

13 Conclusiones

La variable cota altimétrica en (m) se puede explicar mediante un modelo log-normal con parámetros \(\mu = 3.30\) y \(\sigma = 0.79\). Podemos afirmar con un 95% de confianza que la media poblacional de esta variable se encuentra aproximadamente entre 35.32 y 39.90 m, con una media observada de 37.61 m y una desviación estándar de 20.82 m. Además, se evidencia una alta dispersión en los datos, lo que es consistente con una distribución asimétrica positiva característica de las elevaciones y cotas de los pozos petroleros.