1 Configuración y Carga de Datos

##### UNIVERSIDAD CENTRAL DEL ECUADOR #####
#### AUTOR: LISS MURILLO ####
### CARRERA: INGENIERÍA EN PETRÓLEOS #####

#### REGRESIÓN POTENCIAL ####
## DATASET ##
setwd("~/SEBAS PROYECTO")
# Cargar dataset
Datos <- read.csv("oil_and_gas_leases_data.csv", sep = ",", fileEncoding = "latin1")
## Estructura de los datos
str(Datos)
'data.frame':   47757 obs. of  24 variables:
 $ KID                      : int  1001106903 1001106572 1001106590 1001107343 1001108234 1001106684 1001107377 1001107386 1001107740 1001106710 ...
 $ DEPTH_OF_WELL            : num  700 800 1400 1125 2940 ...
 $ CUMULATIVE_PRODUCTION    : num  47225 275063 82624 7544 681006 ...
 $ AVG_PRODUCTION           : num  859 5001 1758 377 24322 ...
 $ LATITUDE                 : num  37.1 38.8 37.5 37.8 37.1 ...
 $ LONGITUDE                : num  -95.9 -95.2 -96.3 -95.7 -101.3 ...
 $ YEARS_ACTIVE             : num  55 55 47 20 28 55 20 48 48 55 ...
 $ SECTION                  : num  33 11 34 8 30 4 26 28 11 17 ...
 $ COUNTY_CODE              : num  125 45 49 207 189 121 49 1 31 121 ...
 $ STATE_CODE               : int  15 15 15 15 15 15 15 15 15 15 ...
 $ TOWNSHIP                 : num  33 15 29 26 33 17 30 26 23 16 ...
 $ RANGE                    : num  14 20 10 16 36 25 12 21 16 24 ...
 $ PRODUCES_OIL             : num  1 1 1 1 0 1 1 1 1 1 ...
 $ PRODUCES_GAS             : num  0 0 0 0 1 0 0 0 0 0 ...
 $ OPERATOR_NAME            : chr  "Horton, John" "Whitlow Energy, Inc." "Suerte Oil Company" "Patterson-Blackford" ...
 $ FIELD_NAME               : chr  "WAYSIDE-HAVANA" "BALDWIN" "DUNKLEBERGER" "ROSE EAST" ...
 $ PRODUCING_FORMATION      : chr  "UNKNOWN" "UNKNOWN" "UNKNOWN" "UNKNOWN" ...
 $ LONGITUDE_LATITUDE_SOURCE: chr  "CENTER_OF_SECTION" "CENTER_OF_SECTION" "CENTER_OF_SECTION" "CENTER_OF_SECTION" ...
 $ PROD_LEVEL               : chr  "MEDIUM" "HIGH" "MEDIUM" "LOW" ...
 $ DEPTH_LEVEL              : chr  "SHALLOW" "SHALLOW" "SHALLOW" "SHALLOW" ...
 $ LIFE_STAGE               : chr  "OLD" "OLD" "OLD" "MATURE" ...
 $ AVG_PROD_LEVEL           : chr  "LOW" "MEDIUM" "MEDIUM" "LOW" ...
 $ TOWNSHIP_DIRECTION       : chr  "S" "S" "S" "S" ...
 $ RANGE_DIRECTION          : chr  "E" "E" "E" "E" ...
## Librerias 
library(dplyr)
library(ggplot2)
library(gt)
library(stringr)

2 Extracción y Depuración de Variables

Se definió los Años Activos como variable independiente (x), ya que representa el tiempo de operación del pozo.

La Producción Acumulada se considera la variable dependiente (y), debido a que refleja el volumen total producido a lo largo del tiempo.

Esta relación permite modelar el crecimiento productivo del pozo, el cual suele seguir un comportamiento no lineal que puede ser adecuadamente representado mediante un modelo de tipo potencial.

  • Variable Independiente (X): Años Activos.
  • Variable Dependiente (Y): Producción Acumulada.
# Selección de variables
datos_raw <- Datos %>%
  select(YEARS_ACTIVE, CUMULATIVE_PRODUCTION) %>%
  mutate(
    x_raw = abs(as.numeric(gsub(",", ".", as.character(YEARS_ACTIVE)))),
    y_raw = abs(as.numeric(gsub(",", ".", as.character(CUMULATIVE_PRODUCTION))))
  ) %>%
  filter(!is.na(x_raw) & !is.na(y_raw) & 
         x_raw > 0 & y_raw > 0) %>%
  filter(x_raw < quantile(x_raw, 0.95))

3 Análisis Gráfico Exploratorio

Previo a la ejecución del agrupamiento, se analiza la distribución inicial de los datos con el fin de fundamentar técnicamente el uso de la técnica de Binning.

datos_plot <- datos_raw

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

plot(datos_plot$x_raw, datos_plot$y_raw,
     main = "Gráfica N°1: Diagrama de Dispersión de la Producción Acumulada\n en función de los Años Activos",
     xlab = "Años Activos",
     ylab = "Producción Acumulada",
     pch = 19,
     col = rgb(46/255, 134/255, 193/255, 0.3),
     cex = 0.6,
     cex.main = 0.9,
     frame.plot = FALSE)

grid(col = "#D7DBDD", lty = "dotted")

box()

4 Aplicación de Binning

Para mitigar el ruido visual de la Gráfica N°1, se aplicó un agrupamiento por Binning utilizando intervalos de 5 años sobre la variable Años Activos, lo que permite una mejor interpretación del comportamiento productivo a lo largo del tiempo.

# Crear bins y calcular promedios
datos_binned <- datos_raw %>%
  mutate(bin = cut(x_raw, breaks = seq(0, max(x_raw), by = 5))) %>%
  group_by(bin) %>%
  summarise(
    x_mean = mean(x_raw, na.rm = TRUE),
    y_mean = mean(y_raw, na.rm = TRUE),
    n = n(),
    .groups = "drop"
  ) %>%
  filter(n >= 10)

5 Conjetura del Modelo de Regresión Potencial

La ecuación es \(y = a \cdot x^b\). Para lograr la linealización del modelo y aplicar una regresión lineal simple, aplicamos logaritmo natural a ambos lados de la igualdad: \(\ln(y) = \ln(a) + b \cdot \ln(x)\)

datos_modelo <- datos_binned %>%
  mutate(
    x_log = log(x_mean),
    y_log = log(y_mean)
  )

modelo_potencial <- lm(y_log ~ x_log, data = datos_modelo)

log_a <- coef(modelo_potencial)[1]
b_param <- coef(modelo_potencial)[2]
a_param <- exp(log_a)

6 Gráfica del Modelo Potencial

Se exhibe el ajuste del modelo acompañado por su correspondiente banda de incertidumbre, definida mediante un intervalo de confianza del 95%.

x_seq <- seq(min(datos_binned$x_mean), 
             max(datos_binned$x_mean), 
             length.out = 500)

# Predicciones
pred_log <- predict(modelo_potencial,
                    newdata = data.frame(x_log = log(x_seq)),
                    interval = "confidence",
                    level = 0.95)

y_fit <- exp(pred_log[, "fit"])
y_lwr <- exp(pred_log[, "lwr"])
y_upr <- exp(pred_log[, "upr"])

plot(datos_binned$x_mean, datos_binned$y_mean,
     main = "Gráfica N°2: Modelo de Regresión Potencial de la Producción Acumulada\n en función de los Años Activos",
     xlab = "Años Activos",
     ylab = "Producción Acumulada",
     col = rgb(46/255, 134/255, 193/255, 0.3),
     cex.main = 0.9,
     pch = 19)

# Banda de confianza
polygon(c(x_seq, rev(x_seq)),
        c(y_lwr, rev(y_upr)),
        col = rgb(0.5, 0.5, 0.5, 0.2),
        border = NA)

# Línea del modelo
lines(x_seq, y_fit,
      col = "red",
      lwd = 3)

# Leyenda
legend("topleft",
       legend = c("Datos Binned", "Modelo Potencial", "I.C. 95%"),
       col = c(rgb(46/255, 134/255, 193/255, 0.5), "red", "gray"),
       pch = c(16, NA, 15),
       lwd = c(NA, 3, NA),
       pt.cex = c(0.8, NA, 2),
       bty = "n")

7 Test de Bondad del Modelo

7.1 Coeficiente de correlación del modelo linealizado

El coeficiente de correlación es:  0.94

7.2 Coeficiente de Determinación

El coeficiente de determinación (R²) es: 0.88

8 Ecuación del Modelo

La ecuación estimada del modelo es:

 y = 10852.65 x^ 0.8077

9 Tabla Resumen del Modelo

tabla_resumen <- data.frame(
  Variable = c("Años Activos", "Producción Acumulada"),
  Tipo = c("Independiente (x)", "Dependiente (y)"),
  R = c("", round(r, 2)),
  R2 = c("", round(r2, 2)),
  Parametro_a = c("", round(a_param, 4)),
  Exponente_b = c("", round(b_param, 4)),
  Ecuación = c("", ecuacion)
)

tabla_resumen %>%
  gt() %>%
  tab_header(title = md("**Tabla N°1 del Resumen del Modelo de Regresión Potencial**")) %>%
  tab_source_note(source_note = "Autor: Liss Murillo") %>%
  cols_align(align = "center", everything())
Tabla N°1 del Resumen del Modelo de Regresión Potencial
Variable Tipo R R2 Parametro_a Exponente_b Ecuación
Años Activos Independiente (x)
Producción Acumulada Dependiente (y) 0.94 0.88 10852.6504 0.8077 y = 10852.6504x^0.8077
Autor: Liss Murillo

10 Cálculo de Estimaciones

¿Cuál sería la Producción Acumulada estimada para 30 años activos?

Para 30 años activos, la Producción Acumulada estimada es: 169265.4

11 Conclusiones

Entre los Años Activos y la Producción Acumulada existe una relación directa de tipo potencial, explicada por un coeficiente de determinación R² ≈ 88%.

Esto indica que el 88% de la variabilidad de la Producción Acumulada puede ser explicada por la variación en los Años Activos, lo que representa una relación estadísticamente muy significativa y de alta capacidad explicativa.

La ecuación matemática estimada del modelo es: \(y = 10852.6504 \cdot x^{0.8077}\).

Dado que el exponente \(b = 0.8077\) es positivo, la relación es creciente; sin embargo, al ser menor que 1, el crecimiento es de tipo desacelerado, lo que implica que, aunque la Producción Acumulada aumenta con el tiempo, lo hace a una tasa cada vez menor.

Este comportamiento es consistente con la dinámica real de producción en pozos petroleros, donde la extracción tiende a estabilizarse o disminuir progresivamente a medida que aumentan los años de operación.