1 Configuración y Carga de Datos

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

#### REGRESIÓN POLINÓMICA ####
## 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 definieron los Años Activos como variable independiente (x), ya que representan el tiempo durante el cual un pozo ha estado en operación, constituyendo un factor clave en la acumulación de producción.

La Producción Acumulada actúa como variable dependiente (y), debido a que refleja la cantidad total de hidrocarburos extraídos a lo largo del tiempo de vida del pozo.

Esta relación busca modelar el comportamiento de la producción en función del tiempo. Desde el punto de vista operativo, a medida que aumentan los años activos, la producción acumulada tiende a incrementarse, aunque no necesariamente de forma lineal, debido a factores como declinación de producción, mantenimiento y condiciones del yacimiento.

Por ello, se justifica el uso de un modelo de regresión polinómica de grado 3 que permita capturar posibles curvaturas en la tendencia observada.

# Selección de variables
datos_raw <- Datos %>%
  select(YEARS_ACTIVE, CUMULATIVE_PRODUCTION) %>%
  mutate(
    x_raw = as.numeric(str_replace_all(as.character(YEARS_ACTIVE), ",", ".")),
    y_raw = as.numeric(str_replace_all(as.character(CUMULATIVE_PRODUCTION), ",", "."))
  ) %>%
  filter(!is.na(x_raw), !is.na(y_raw), x_raw > 0, y_raw > 0)

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 %>% 
  filter(y_raw < quantile(y_raw, 0.99))  

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(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

box()

4 Aplicación de Binning

Ante la alta dispersión visualizada en la Gráfica N°1, se aplica un método de agrupamiento por rangos (binning) para reducir el ruido en los datos y permitir una mejor identificación de la tendencia subyacente.

# Agrupamiento por rangos de 5 años
datos_model <- datos_raw %>%
  mutate(x_bin = floor(x_raw / 5) * 5) %>% 
  group_by(x_bin) %>%
  summarise(
    y = mean(y_raw, na.rm = TRUE),
    conteo = n(),
    .groups = "drop"
  ) %>%
  rename(x = x_bin) %>%
  filter(conteo >= 3)

# Limpieza de outliers
lim_y <- quantile(datos_model$y, probs = c(0.05, 0.95), na.rm = TRUE)

datos_model <- datos_model %>%
  filter(
    y >= lim_y[1],
    y <= lim_y[2]
  )

# Variables finales para el modelo
x <- datos_model$x
y <- datos_model$y

5 Conjetura del Modelo de Regresión Polinómico

La ecuación de tercer grado para dicho modelo es: \[ y = \beta_0 + \beta_1 x + \beta_2 x^2 + \beta_3 x^3 \]

modelo_polinomico <- lm(y ~ x + I(x^2) + I(x^3))

6 Gráfica del Modelo Polinómico (Grado 3)

Se presenta el ajuste del modelo incluyendo la banda de incertidumbre estadística (Intervalo de Confianza del 95%).

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

plot(x, y,
     main = "Gráfica N°2: Modelo Polinómico de la Producción Acumulada en función de los Años Activos",
     xlab = "Años Activos",
     ylab = "Producción Acumulada",
     col = "#3498DB",
     pch = 16,
     cex = 1.0,
     cex.main = 0.9,
     frame.plot = FALSE)

grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

x_seq <- seq(min(x), max(x), length.out = 500)

predicciones <- predict(modelo_polinomico,
                        newdata = data.frame(x = x_seq),
                        interval = "confidence",
                        level = 0.95)

polygon(c(x_seq, rev(x_seq)), 
        c(predicciones[, "lwr"], rev(predicciones[, "upr"])), 
        col = rgb(0.5, 0.5, 0.5, 0.2), border = NA)

lines(x_seq, predicciones[, "fit"], col = "#E74C3C", lwd = 3)

legend("topleft",
       legend = c("Datos promediados (binning)", 
                  "Modelo Polinómico (Grado 3)", 
                  "I.C. 95%"),
       col = c("#3498DB", "#E74C3C", "gray"),
       pch = c(16, NA, 15),
       lwd = c(NA, 3, NA),
       pt.cex = c(1, NA, 2),
       bty = "n")

7 Test de Bondad del Modelo

7.1 Coeficiente de correlación

El coeficiente de correlación es:  0.88

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 = -64654.6937 + 20231.5137101174x - 484.8108963878x^2 + 3.9888522154x^3

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)),
  Intercepto = c("", round(b0, 4)),
  Beta1 = c("", round(b1, 6)),
  Beta2 = c("", round(b2, 8)),
  Beta3 = c("", round(b3, 10)),
  Ecuación = c("", ecuacion)
)

tabla_resumen %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°1 del Resumen del Modelo de Regresión Polinómica**")
  ) %>%
  tab_source_note(
    source_note = "Autor: Liss Murillo"
  ) %>%
  cols_align(
    align = "center",
    everything()
  )
Tabla N°1 del Resumen del Modelo de Regresión Polinómica
Variable Tipo R R2 Intercepto Beta1 Beta2 Beta3 Ecuación
Años Activos Independiente (x)
Producción Acumulada Dependiente (y) 0.88 0.88 -64654.6937 20231.51371 -484.81089639 3.9888522154 y = -64654.6937 + 20231.5137101174x - 484.8108963878x^2 + 3.9888522154x^3
Autor: Liss Murillo

10 Cálculo de Estimaciones

¿Cuál es la Producción Acumulada estimada para un rango de 20 Años Activos?

Para 20 años activos, la Producción Acumulada estimada es: 177962

11 Conclusiones

Entre los Años Activos y la Producción Acumulada existe una relación polinómica de tercer grado, con un coeficiente de correlación \(r = 0.88\), lo que indica una asociación positiva fuerte entre ambas variables.

El modelo presenta un coeficiente de determinación \(R^2 = 0.88\) , lo que significa que el 88% de la variabilidad de la Producción Acumulada es explicada por los Años Activos bajo el modelo polinómico estimado.

La ecuación ajustada es: \(y = -64654.6937 + 20231.5137x - 484.8109x^2 + 3.9889x^3\).

Se observa que los términos de segundo y tercer grado son relevantes, lo que indica un comportamiento no lineal en la relación analizada.

En consecuencia, el modelo polinómico de tercer grado representa adecuadamente la relación, evidenciando una tendencia creciente con variaciones en la tasa de producción a lo largo del tiempo.