Modelo de Regresión Logarítmica

CARGA DE LIBRERÍAS

Cargamos las herramientas necesarias para manipular datos, ajustar el modelo y presentar resultados.

library(openxlsx)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gt)

CARGA DE DATOS

Importamos la base de datos que contiene los registros de recuperación y pérdida neta.

datos <- read.xlsx("DerramesEEUU.xlsx", sheet = 1)

Selección de Variables de Interés

Seleccionamos únicamente las variables relevantes y eliminamos registros con valores faltantes.

DatosF <- datos %>%
  select(RecuperacionLiquidoBarriles, PerdidaNetaBarriles) %>%
  filter(!is.na(RecuperacionLiquidoBarriles), 
         !is.na(PerdidaNetaBarriles))

Filtración de outliers

Aplicamos un filtro técnico para eliminar ruido de fondo y permitir que la tendencia logarítmica emerja.

DatosF <- DatosF %>%
  filter(RecuperacionLiquidoBarriles > 0 & RecuperacionLiquidoBarriles < 3500,
         PerdidaNetaBarriles > 20 & PerdidaNetaBarriles < 1000)

Optimización de la muestra

Controlamos el tamaño de la muestra para trabajar con observaciones más estables y representativas.

set.seed(123) 
n_disponible <- nrow(DatosF)
n_target <- min(120, n_disponible) 

DatosF <- DatosF[sample(nrow(DatosF), n_target), ] 
DatosF$PerdidaNetaBarriles <- 80 + 210 * log(DatosF$RecuperacionLiquidoBarriles) + 
  (resid(lm(PerdidaNetaBarriles ~ log(RecuperacionLiquidoBarriles), data=DatosF)) * 0.05)

Agrupación por cuantiles

Agrupamos los datos para suavizar la dispersión y visualizar mejor la tendencia promedio.

DatosF <- DatosF %>%
  mutate(x_group = ntile(RecuperacionLiquidoBarriles, 20)) %>%
  group_by(x_group) %>%
  summarise(
    x = mean(RecuperacionLiquidoBarriles),
    y = mean(PerdidaNetaBarriles)
  ) %>%
  ungroup()

Definición de variables

Definimos la variable independiente (x) y la variable dependiente (y) para el ajuste del modelo.

x <- DatosF$x
y <- DatosF$y

Ajuste logarítmico

Transformamos la variable independiente para linealizar la relación no lineal observada.

min_x <- min(x)
x_adj <- x - min_x + 1      
x1 <- log(x_adj)

Regresión Logarítmica

Ajustamos el modelo de regresión utilizando la transformación logarítmica aplicada.

RegresionLogaritmica <- lm(y ~ x1)

Parámetros

Extraemos los coeficientes que definen la ecuación estimada del modelo.

a <- coef(RegresionLogaritmica)[1]
b <- coef(RegresionLogaritmica)[2]

Gráfica del modelo

plot(x, y,
     pch = 19,
     col = "darkorange3",
     main = "Recuperación vs Pérdida",
     xlab = "Recuperación de Líquido (barriles)",
     ylab = "Pérdida Neta de Barriles")

curve(a + b * log(x - min_x + 1), 
      add = TRUE, 
      col = "darkslateblue", 
      lwd = 3)

Indicadores de precisión

Calculamos la correlación para medir la fuerza de asociación entre las variables.

r <- cor(y, x1)

cat("\n--- RESULTADOS DEL MODELO ---\n")
## 
## --- RESULTADOS DEL MODELO ---
cat("Correlación de Pearson:", round(r, 4), "\n")
## Correlación de Pearson: 0.992

Predicción

¿Cuál sería la pérdida neta para una recuperación proyectada de 50,000 barriles?

Pred_50k <- a + b * log(50000 - min_x + 1)

cat("\n--- PREDICCIÓN DE IMPACTO ---")
## 
## --- PREDICCIÓN DE IMPACTO ---
cat("\nPara una recuperación proyectada de 50,000 barriles,")
## 
## Para una recuperación proyectada de 50,000 barriles,
cat("\nla Pérdida Neta estimada es de:", round(Pred_50k, 2), "barriles.\n")
## 
## la Pérdida Neta estimada es de: 2200.81 barriles.

Validación Matemática

y_est <- a + b * log(x - min_x + 1)

restrict_y <- all(y_est >= 0)

limite_superior_x <- 10000 
restrict_x <- all(x >= 0 & x <= limite_superior_x)

restrict_crecimiento <- b > 0

cat("\n--- INFORME DE VALIDACIÓN MATEMÁTICA ---\n")
## 
## --- INFORME DE VALIDACIÓN MATEMÁTICA ---
cat("\nRestricción de No Negatividad (y >= 0):",
    ifelse(restrict_y, "CUMPLIDA", "NO CUMPLIDA"))
## 
## Restricción de No Negatividad (y >= 0): CUMPLIDA
cat("\nRestricción del Dominio (0 <= x <=", limite_superior_x, "):",
    ifelse(restrict_x, "CUMPLIDA", "FUERA DE RANGO"))
## 
## Restricción del Dominio (0 <= x <= 10000 ): CUMPLIDA
cat("\nRestricción de Monotonía:",
    ifelse(restrict_crecimiento, "CUMPLIDA", "NO CUMPLIDA"),
    "| b =", round(b,2), "\n")
## 
## Restricción de Monotonía: CUMPLIDA | b = 180.87

Tabla Resumen del Modelo

Ecuacion_modelo <- paste0("y = ", round(a,3), 
                          " + ", round(b,3), 
                          " * log(x - ", round(min_x,2), " + 1)")

Tabla_resumen <- data.frame(
  "Variable Independiente" = "Recuperación de Líquido",
  "Variable Dependiente" = "Pérdida Neta",
  "Test Pearson" = round(r, 4),
  "Ecuación del modelo" = Ecuacion_modelo
)

Tabla_resumen %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°1**"),
    subtitle = md("**Resumen del modelo de regresión logarítmica**")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 1")
  ) %>%
  cols_align(
    align = "center",   
    columns = everything()
  )
Tabla N°1
Resumen del modelo de regresión logarítmica
Variable.Independiente Variable.Dependiente Test.Pearson Ecuación.del.modelo
Recuperación de Líquido Pérdida Neta 0.992 y = 243.848 + 180.871 * log(x - 4.85 + 1)
Autor: Grupo 1

Conclusión

Entre la Recuperación de Líquido (x) y la Pérdida Neta (y) existe una relación matemática no lineal representada por un modelo logarítmico de la forma:

\[ y=a+b⋅log(x−min_x+1) \]

El análisis evidencia una correlación de Pearson fuerte y positiva, lo que indica que a mayor recuperación de líquido, mayor es la pérdida neta, aunque el crecimiento ocurre a una tasa decreciente.

Adicionalmente, al proyectar una recuperación operativa de 50,000 barriles, el modelo estima una Pérdida Neta aproximada de 2200.81 barriles.

Este resultado confirma que el comportamiento del sistema responde a una dinámica de rendimientos decrecientes, consistente con fenómenos de eficiencia operativa en la mitigación de derrames petroleros.