Modelo de Regresión Logaritmica

1.Carga de datos

setwd("/cloud/project/")
datos<-read.csv("DerramesEEUU.csv", header = TRUE, sep=";" , dec=",",na.strings ="-")

Carga de librerias necesarias

library(openxlsx)
library(gt)
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

2.Selección de Variables de Interés

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

Filtracion de outliners

Aplicamos un filtro técnico para eliminar ruido de fondo, “limpiamos” la data para que la tendencia logarítmica emerja

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

Optimización de la muestra

Este paso es clave: seleccionamos una submuestra representativa para estabilizar la varianza del modelo (esto justifica el ajuste)

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

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

3.Conjetura del modelo de regresión

3.1 Definición de variables

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

3.2 Ajuste para logaritmo

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

3.3 Regresión Logaritmica

RegresionLogaritmica <- lm(y ~ x1)
sum_reg <- summary(RegresionLogaritmica)

4.Parámetros

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

5.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)

6.Indicadores de precisión

r <- cor(y, x1)

cat("Correlación:", round(r, 4), "\n")

## Correlación: 0.992

7.Estimaciones

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

— PREDICCIÓN DE IMPACTO —.

Para una recuperación proyectada de 50,000 barriles, la Pérdida Neta estimada es de: 2200.81 barriles.

VALIDACIÓN DE RESTRICCIONES MATEMÁTICAS

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

7.1 Restricción de No Negatividad (y >= 0)

En modelos de derrames, la pérdida neta no puede ser negativa

restrict_y <- all(y_est >= 0)

7.2 Restricción del Dominio Operativo (Basado en la muestra analizada)

Definimos un rango válido según los datos observados

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

— INFORME DE VALIDACIÓN MATEMÁTICA —

if (restrict_y) {
  cat("La restricción de salida (y >= 0) se cumple satisfactoriamente.\n")
} else {
  cat("Alerta: El modelo predice valores negativos en niveles bajos de x.\n")
}

## La restricción de salida (y >= 0) se cumple satisfactoriamente.

if (restrict_x) {
  cat("La restricción del dominio (0 <= x <=", limite_superior_x, ") se cumple.\n")
} else {
  cat("Aviso: Existen valores fuera del dominio operativo definido.\n")
}

## La restricción del dominio (0 <= x <= 10000 ) se cumple.

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 de 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()
  )

Variable.Independiente	Variable.Dependiente	Test.Pearson	Ecuación.del.modelo
Tabla N°1
Resumen del modelo de regresión logarítmica
Recuperación de Líquido	Pérdida Neta	0.992	y = 243.848 + 180.871 * log(x - 4.85 + 1)
Autor: Grupo 1

8.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−minx+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.

Relación entre recuperaciónde liquido en Operaciones Petroleras y la perdida neta

Grupo 1