1 Introducción y Metodología

El presente informe estadístico analiza la variable Término de Perforación de pozos petroleros de Brasil, aplicando técnicas descriptivas e inferenciales.

2 Tabla de Distribución de Frecuencia

Dado que la variable abarca casi un siglo (1920–2018), trabajar con años individuales generaría demasiado ruido estadístico. Por ello, agrupamos los datos en décadas (intervalos de 10 años) para visualizar la tendencia estructural.

# Librerias 
library(readxl)
library(dplyr)
library(gt)
library(e1071)
library(lubridate)
library(MASS)
library(knitr)


# Datos
setwd("C:/Users/majke/Downloads/Proyecto Estadistica/RMARKDOWN")

Datos_Brutos <- read.csv(
  "Pozos brasil 2.csv",
  header       = TRUE,
  sep          = ";",
  dec          = ",",
  fileEncoding = "Latin1"
)
# Extracción de Variable

Datos <- Datos_Brutos %>%
  mutate(
    Fecha_Obj = as.Date(TERMINO, format = "%d/%m/%Y"),
    Anio      = year(Fecha_Obj)
  ) %>%
  filter(!is.na(Anio) & Anio >= 1920 & Anio <= 2020)

X <- Datos$Anio

# TABLA DE FRECUENCIAS por décadas (vista general)
breaks_dec <- seq(1920, 2020, by = 10)
h_total    <- hist(X, breaks = breaks_dec, plot = FALSE)

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

totales_simplificados <- c("TOTAL", sum(TDF_General$ni), 100)
TDF_Inferencial <- TDF_General %>% mutate(across(everything(), as.character))
TDF_Show_Simple <- rbind(TDF_Inferencial, totales_simplificados)

TDF_Show_Simple %>%
  gt() %>%
  tab_header(
    title    = md("TABLA DE FRECUENCIAS: INFERENCIA ESTADÍSTICA"),
    subtitle = md("Variable: **Término de Perforación**")
  ) %>%
  tab_source_note(source_note = "Fuente: Tabela de Poços 2018") %>%
  cols_label(
    Decada = "Periodo (Década)",
    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: Término de Perforación
Periodo (Década) Frecuencia Absoluta (ni) Frecuencia Relativa (hi%)
1920-1930 2 0.01
1930-1940 11 0.04
1940-1950 216 0.78
1950-1960 1018 3.67
1960-1970 2419 8.72
1970-1980 2893 10.43
1980-1990 9375 33.81
1990-2000 3382 12.2
2000-2010 4586 16.54
2010-2020 3827 13.8
TOTAL 27729 100
Fuente: Tabela de Poços 2018

3 Gráficas

3.1 Diagrama de Barras (Escala Local)

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

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

vals_x   <- TDF_General$Decada
vals_y   <- TDF_General$ni
ylim_max <- max(vals_y) * 1.1

bp <- barplot(
  vals_y,
  main      = "Gráfica N°1: Distribución de Fecha de Término de Pozos Petroleros de Brasil",
  cex.main  = 0.9,
  ylab      = "Cantidad de Pozos Finalizados",
  col       = col_barras, border = "white",
  axes      = FALSE, ylim = c(0, ylim_max), axisnames = FALSE
)
axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = bp, labels = vals_x, col = col_ejes, col.axis = col_ejes, las = 2, cex.axis = 0.9)
title(xlab = "Década", line = 8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
box(bty = "l", col = col_ejes)

Al observar la Gráfica N°1 se identifican dos periodos con dinámicas distintas que se analizan por separado para garantizar un buen ajuste de los modelos probabilísticos:

  1. Sección 1 (1980–1999, por lustros): El pico de actividad se concentra en esta época. Al agrupar en lustros (5 años) dentro de este rango, los datos toman una forma que el modelo Normal puede capturar.
  2. Sección 2 (2000–2020, por lustros): La actividad muestra descenso gradual asimétrico, compatible con el modelo Gamma.

4 Agrupación 1 (1980–1999)

Analizamos el periodo de máxima actividad agrupado en lustros (cada 5 años), obteniendo 4 intervalos con forma más regular.

# S1: solo el periodo de pico, agrupado en lustros
X1        <- X[X >= 1980 & X < 2000]
breaks_s1 <- seq(1980, 2000, by = 5)

hist(
  X1,
  breaks = breaks_s1,
  col    = col_barras,
  border = "white",
  main   = "Histograma Sección 1 (1980–1999, por lustros)",
  xlab   = "Año",
  ylab   = "Frecuencia"
)

4.1 Conjetura del Modelo

El histograma de S1 muestra un descenso monótono constante (0.44 → 0.30 → 0.15 → 0.10), patrón incompatible con la Normal (simétrica) pero perfectamente compatible con una Distribución Exponencial, que modela exactamente procesos de decaimiento constante. Se transforma el año a “años desde 1979” (valores > 0, requisito de la Exponencial), estimando la tasa (λ).

# Transformación: años desde 1979 → valores de 1 a 20
X1_transf     <- X1 - 1979
breaks_transf <- breaks_s1 - 1979

fit_exp <- fitdistr(X1_transf, "exponential")
lambda  <- fit_exp$estimate["rate"]

h1  <- hist(X1, breaks = breaks_s1, plot = FALSE)
Fo1 <- h1$counts / sum(h1$counts)
Fe1 <- diff(pexp(breaks_transf, rate = lambda))

etiquetas_s1 <- c("1980-84", "1985-89", "1990-94", "1995-99")

barplot(
  rbind(Fo1, Fe1),
  beside    = TRUE,
  col       = c(col_barras, "#F2F3F4"),
  border    = "black",
  names.arg = etiquetas_s1,
  main      = "Gráfica N°2: Modelo de Probabilidad Exponencial de Fecha de Término (1980–1999)",
  cex.main  = 0.85,
  ylab      = "Probabilidad",
  xlab      = "Lustros"
)
legend("topright", legend = c("Real", "Modelo Exponencial"),
       fill = c(col_barras, "#F2F3F4"), border = "white", bty = "n")

4.2 Test de Pearson

plot(
  Fo1, Fe1,
  main = "Gráfica N°3: Correlación de Pearson — Sección 1",
  xlab = "Frecuencia Observada",
  ylab = "Frecuencia Esperada",
  pch  = 19, col = col_barras,
  xlim = c(0, max(Fo1) * 1.05),
  ylim = c(0, max(Fe1) * 1.05)
)
abline(lm(Fe1 ~ Fo1 + 0), col = "red", lwd = 2)

cor1 <- cor(Fo1, Fe1) * 100

4.3 Test de Chi-Cuadrado

x2_1 <- sum((Fo1 - Fe1)^2 / Fe1)
vc1  <- qchisq(0.95, length(Fo1) - 1)

4.4 Tabla Resumen de Test

tabla_1 <- data.frame(
  Modelo       = "Exponencial",
  Pearson      = round(cor1, 2),
  Chi_Cuadrado = round(x2_1, 4),
  Umbral       = round(vc1, 4),
  Decision     = ifelse(x2_1 < vc1, "Modelo aceptado", "Modelo rechazado")
)

gt(tabla_1) %>%
  tab_header(title = md("**Tabla N°2: Resumen Bondad de Ajuste Sección 1**")) %>%
  tab_source_note(source_note = "Autor: Ashly Alzate") %>%
  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            = "#2E4053",
    table.border.bottom.color         = "#2E4053",
    column_labels.border.bottom.color = "#2E4053",
    data_row.padding                  = px(6)
  )
Tabla N°2: Resumen Bondad de Ajuste Sección 1
Modelo Pearson Chi_Cuadrado Umbral Decision
Exponencial 98.57 0.063 7.8147 Modelo aceptado
Autor: Ashly Alzate

4.5 Cálculo de Probabilidades

¿Cuál fue la probabilidad de que un pozo terminara sus operaciones antes de 1990?

# Transformación: 1990 - 1979 = 11
p_1990 <- pexp(1990 - 1979, rate = lambda)
p_1990
## [1] 0.7397706

La probabilidad es del 73.98%.

5 Agrupación 2 (2000–2020)

Analizamos la segunda etapa probando un ajuste a la Distribución Gamma.

X2             <- X[X >= 2000 & X <= 2020]
breaks_lustros <- seq(2000, 2020, by = 5)

hist(
  X2,
  breaks = breaks_lustros,
  col    = col_barras,
  border = "white",
  main   = "Histograma Sección 2 (2000–2020, por lustros)",
  xlab   = "Año",
  ylab   = "Frecuencia"
)

5.1 Conjetura del Modelo

Para el periodo 2000–2020, el histograma muestra descenso asimétrico desde un pico inicial, comportamiento que la Normal no puede capturar. Se ajusta una Distribución Gamma estimando los parámetros de Forma (α) y Tasa (β).

fit_gamma <- fitdistr(X2, "gamma")
alpha <- fit_gamma$estimate["shape"]
beta  <- fit_gamma$estimate["rate"]

h2  <- hist(X2, breaks = breaks_lustros, plot = FALSE)
Fo2 <- h2$counts / sum(h2$counts)
Fe2 <- diff(pgamma(breaks_lustros, shape = alpha, rate = beta))

etiquetas_lustros <- c("2000-05", "2005-10", "2010-15", "2015-20")

barplot(
  rbind(Fo2, Fe2),
  beside    = TRUE,
  col       = c(col_barras, "#F2F3F4"),
  border    = "black",
  names.arg = etiquetas_lustros,
  main      = "Gráfica N°5: Modelo de Probabilidad Gamma de Fecha de Término (2000–2020)",
  cex.main  = 0.85,
  ylab      = "Probabilidad"
)
legend("topright", legend = c("Real", "Modelo Gamma"),
       fill = c(col_barras, "#F2F3F4"), border = "white", bty = "n")

5.2 Test de Pearson

plot(
  Fo2, Fe2,
  main = "Gráfica N°6: Correlación de Pearson — Sección 2 (Gamma)",
  xlab = "Frecuencia Observada",
  ylab = "Frecuencia Esperada",
  pch  = 19, col = col_barras,
  xlim = c(0, max(Fo2) * 1.05),
  ylim = c(0, max(Fe2) * 1.05)
)
abline(lm(Fe2 ~ Fo2 + 0), col = "red", lwd = 2)

cor2 <- cor(Fo2, Fe2) * 100
cor2
## [1] 97.07117

5.3 Test de Chi-Cuadrado

x2_2 <- sum((Fo2 - Fe2)^2 / Fe2)
vc2  <- qchisq(0.95, length(Fo2) - 1)

5.4 Tabla Resumen de Test

tabla_2 <- data.frame(
  Variable     = "Término (S2)",
  Pearson_Pct  = round(cor2, 2),
  Chi_Cuadrado = round(x2_2, 4),
  Umbral       = round(vc2, 4),
  Decision     = ifelse(x2_2 < vc2, "Modelo aceptado", "Modelo rechazado")
)

gt(tabla_2) %>%
  tab_header(title = md("**Tabla N°3: Resumen Bondad de Ajuste Sección 2 (Gamma)**")) %>%
  tab_source_note(source_note = "Autor: Ashly Alzate") %>%
  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            = "#2E4053",
    table.border.bottom.color         = "#2E4053",
    column_labels.border.bottom.color = "#2E4053",
    data_row.padding                  = px(6)
  )
Tabla N°3: Resumen Bondad de Ajuste Sección 2 (Gamma)
Variable Pearson_Pct Chi_Cuadrado Umbral Decision
Término (S2) 97.07 0.0338 7.8147 Modelo aceptado
Autor: Ashly Alzate

5.5 Cálculo de Probabilidades

De cada 1,000 pozos finalizados en la era moderna (2000–2020), ¿cuántos se estimó que terminaron en el último lustro (2015–2020)?

p_ultimo          <- pgamma(2020, shape = alpha, rate = beta) - pgamma(2015, shape = alpha, rate = beta)
cantidad_estimada <- round(p_ultimo * 1000, 0)

El modelo Gamma estimó que, por cada 1,000 pozos de este periodo, aproximadamente 97 correspondieron al intervalo 2015–2020 (es decir, un 9.72%).

6 Conclusiones

El análisis segmentado nos permite concluir:

Periodo 1980–1999 (por lustros): Se modeló bajo una distribución Exponencial, ya que los datos muestran un descenso monótono constante (0.44 → 0.30 → 0.15 → 0.10) incompatible con la Normal. La correlación de Pearson fue de 98.57% y la prueba Chi-Cuadrado (0.063) se mantuvo por debajo del umbral crítico de 7.8147 , confirmando la validez del modelo.

Periodo 2000–2020 (por lustros): El modelo Gamma capturó la tendencia decreciente asimétrica. La prueba Chi-Cuadrado (0.0338) se mantuvo por debajo del umbral crítico de 7.8147 , confirmando la validez estadística del modelo.