1 Configuración y Carga de Datos

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

#### REGRESIÓN LOGARÍTMICA ####
## 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 estableció los Años Activos como variable independiente (x), ya que representa el tiempo de operación del pozo y su evolución productiva a lo largo del tiempo.

La Producción Acumulada se define como variable dependiente (y), puesto que refleja el volumen total producido durante la vida útil del pozo.

Esta relación modela el comportamiento productivo: a medida que aumentan los años de operación, la producción acumulada crece, aunque con una tasa decreciente, lo cual justifica el uso de un modelo logarítmico.

  • 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 = as.numeric(YEARS_ACTIVE),
    y_raw = as.numeric(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

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

plot(datos_plot$x_raw, datos_plot$y_raw,
     main = "Gráfica N°1: Producción Acumulada 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

Debido a la variabilidad observada en la Gráfica N°1, se implementa la técnica de binning con el objetivo de disminuir el ruido estadístico y visualizar con mayor claridad la tendencia general de los datos.

# Limpieza de outliers
lim_x <- quantile(datos_raw$x_raw, c(0.01, 0.99))
lim_y <- quantile(datos_raw$y_raw, c(0.01, 0.99))

datos_limpios <- datos_raw %>%
  filter(x_raw >= lim_x[1] & x_raw <= lim_x[2],
         y_raw >= lim_y[1] & y_raw <= lim_y[2])

# Binning cada 5 años
datos_model <- datos_limpios %>%
  mutate(x_bin = round(x_raw / 2) * 2) %>%
  group_by(x_bin) %>%
  summarise(
    y = mean(y_raw, na.rm = TRUE),
    conteo = n(),
    .groups = "drop"
  ) %>%
  rename(x = x_bin) %>%
  filter(conteo >= 5)

datos_model <- datos_model %>%
  filter(x > 0 & y > 0)

x <- datos_model$x
y <- datos_model$y

5 Conjetura del Modelo de Regresión Logarítmico

La ecuación del modelo es: \(y = a + b \cdot \ln(x)\). .

modelo_log <- lm(y ~ log(x))

6 Gráfica del Modelo Potencial

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 Logarítmico 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 = 1.0, 
     cex.main = 0.9, 
     frame.plot = FALSE)

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

pred <- predict(modelo_log,
                newdata = data.frame(x = x_seq),
                interval = "confidence")

y_fit <- pred[, "fit"]
y_lwr <- pred[, "lwr"]
y_upr <- pred[, "upr"]

# Intervalo 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 ajustada
lines(x_seq, y_fit, col = "#E74C3C", lwd = 3)

legend("topleft",
       legend = c("Datos Binned",
                  "Modelo Logarítmico",
                  "I.C. 95%"),
       col = c(rgb(46/255, 134/255, 193/255, 0.3), "#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 del modelo linealizado

El coeficiente de correlación es:  0.83

7.2 Coeficiente de Determinación

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

8 Ecuación del Modelo

La ecuación estimada del modelo es:

 y = -143708.0791 + 101119.8126 ln(x)

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_a = c("", round(a_bin, 4)),
  Pendiente_b = c("", round(b_bin, 4)),
  Ecuación = c("", ecuacion)
)

tabla_resumen %>%
  gt() %>%
  tab_header(title = md("**Tabla N°1 del Resumen del Modelo de Regresión Logarítmica**")) %>%
  tab_source_note(source_note = "Autor: Liss Murillo") %>%
  cols_align(align = "center", everything())
Tabla N°1 del Resumen del Modelo de Regresión Logarítmica
Variable Tipo R R2 Intercepto_a Pendiente_b Ecuación
Años Activos Independiente (x)
Producción Acumulada Dependiente (y) 0.83 0.7 -143708.0791 101119.8126 y = -143708.0791 + 101119.8126 ln(x)
Autor: Liss Murillo

10 Cálculo de Estimaciones

¿Cuál es la Producción Acumulada estimada para un pozo con 20 años de actividad?

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

11 Conclusiones

Entre los Años Activos y la Producción Acumulada existe una relación de tipo logarítmica, con un coeficiente de determinación \(R^2 = 0.7\), lo que indica que el modelo logra explicar una proporción considerable de la variabilidad de la Producción Acumulada en función del tiempo de operación del pozo.

El coeficiente de correlación fue de \(R = 0.83\), evidenciando una relación positiva moderadamente fuerte entre las variables analizadas.

La ecuación estimada es: \(y = -143708.0791 + 101119.8126 \cdot \ln(x)\).

El modelo presenta como condición matemática que x > 0, lo cual se cumple en este caso, ya que los Años Activos son siempre valores positivos dentro del contexto operativo de los pozos, por lo que no existen restricciones prácticas dentro del rango analizado.