Modelo de Regresión Multiple

Preparación de datos

Carga de datos

library(readxl)
datos <- read_excel("DerramesEEUU.xlsx", sheet = 1)

Carga de librerias necesarias

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

Selección de Variables de Interés

LINB <- as.numeric(datos$LiberacionInvoluntariaBarriles)
PNB <- as.numeric(datos$PerdidaNetaBarriles)
CRE <- as.numeric(datos$CostosRespuestaEmergencia)
## Warning: NAs introduced by coercion
datos_interes <- data.frame(LINB,PNB,CRE)
datos_interes <- na.omit(datos_interes)

Depuración de Datos

Filtración por Percentiles

calcular_limites <- function(x) {
  lim_inf <- quantile(x, 0.01, na.rm = TRUE)
  lim_sup <- quantile(x, 0.99, na.rm = TRUE)
  return(list(inf = lim_inf, sup = lim_sup))
}

lim_LINB <- calcular_limites(datos_interes$LINB)
lim_PNB  <- calcular_limites(datos_interes$PNB)
lim_CRE  <- calcular_limites(datos_interes$CRE)

datos_filtrados <- datos_interes %>%
  filter(
    LINB >= lim_LINB$inf, LINB <= lim_LINB$sup,
    PNB  >= lim_PNB$inf,  PNB  <= lim_PNB$sup,
    CRE  >= lim_CRE$inf,  CRE  <= lim_CRE$sup
  )

Definición de Variables para el Modelo de Regresión

Selección de Variable Predictora y Variable Respuesta

# Variable dependiente
y <- datos_filtrados$LINB

# Variables independientes
x1 <- datos_filtrados$PNB
x2 <- datos_filtrados$CRE

Conjetura del modelo de regresión

modelo_mul <- lm(y ~ x1 + x2, data = datos_filtrados)

#Resumen del modelo

summary(modelo_mul)
## 
## Call:
## lm(formula = y ~ x1 + x2, data = datos_filtrados)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -614.3  -25.6  -24.0  -21.4 3476.0 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 2.395e+01  3.508e+00   6.827 1.06e-11 ***
## x1          1.132e+00  1.543e-02  73.375  < 2e-16 ***
## x2          2.727e-04  1.671e-05  16.321  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 175.8 on 2695 degrees of freedom
## Multiple R-squared:  0.6958, Adjusted R-squared:  0.6956 
## F-statistic:  3083 on 2 and 2695 DF,  p-value: < 2.2e-16

Gráfica del modelo

graf <- scatterplot3d(
  x1, x2, y,
  main = "Regresión Múltiple: LINB ~ PNB + CRE (Filtro 1%-99%)",
  xlab = "Perdida Neta",
  ylab = "Costos Respuesta Emergencia",
  zlab = "Liberacion Involuntaria",
  angle = 120,
  color = "blue",
  pch = 19
)

graf$plane3d(modelo_mul, col = "red", lwd = 2)

Análisis de Correlación

Test de Pearson

El coeficiente de correlación de Pearson indica el grado de asociación lineal entre ambas variables. Un valor cercano a ±1 representa una relación fuerte, mientras que valores cercanos a 0 indican una relación débil.

r <- sqrt(summary(modelo_mul)$r.squared)

La correlación múltiple del modelo es: 83.42 %

Coeficiente de determinación

El coeficiente de determinación es aquel que expresa la proporción de la variación total de la variable dependiente que es explicada por la variable independiente. Se interpreta como el grado de ajuste del modelo a los datos observados.

Coeficiente normal

r2 <- summary(modelo_mul)$r.squared
r2
## [1] 0.6958314

Coeficiente ajustado

r2_ajustado <- summary(modelo_mul)$adj.r.squared
r2_ajustado
## [1] 0.6956057

El porcentaje de la variación de la variable liberacion involuntaria explicado por la perdida neta y los costos de emergencia es de : 69.58 % # Ecuación del modelo ## 3.4 Ecuación del modelo

Para obtener la ecuación de la regresión múltiple, utilizamos los coeficientes estimados del modelo, los cuales permiten expresar la relación entre las variables mediante la siguiente forma general:

\[ y = c + a x_1 + b x_2 \]

Donde:

  • c es el intercepto
  • a y b son los coeficientes de la regresión
a <- modelo_mul$coefficients[2]

El coeficiente de x_1 1.132

b <- modelo_mul$coefficients[3]

El coeficiente de x_2: 3e-04

c <- modelo_mul$coefficients[1]

El intercepto es: 23.95

Por lo siguiente la ecuación de la recta obtenida es : y = 23.95 + 1.132 x1 + 3e-04 x2

Restricciones

La ecuación del modelo multiple es : \[ y=23.95+1.132∗x_1+3e−04∗x_2 \] Donde:

  • y representa la Liberación Involuntaria (barriles).
  • x_1 representa la Pérdida neta (barriles).
  • x_2 representa los Costos de respuesta de Emergencia.

Todas las variables del modelo (Y: liberación involuntaria; X1: pérdida neta; X2: costos de emergencia) son cantidades no negativas, por lo que su dominio natural es [0, ∞). Dentro del rango de observación de los datos, no se generan predicciones fuera del dominio de la variable dependiente, y no se imponen restricciones adicionales al modelo.

Tabla de resumen del modelo

VariableIn <- c("Pérdida neta")
VariableIn2 <- c("Costos de respuesta de Emergencia")
VariableDep <- c("Liberación Involuntaria")
Ecuacion <- c(" y =  23.95  +  1.132 *x1 +  0.0003 *x2")

Tabla_resumen <- data.frame(
  VariableIn,VariableIn2,VariableDep,
  Correlación_Pearson = round(r, 2),
  Co_determinacion = round(r2*100, 2),
  Ecuacion
)

colnames(Tabla_resumen) <- c("Variable Ind.1",
                             "Variable Ind.2",
                             "Variable Dependiente",
                            "Test Pearson",
                            "Coeficiente de determinación",
                            "Ecuación de la recta")
library(gt)

Tabla_resumen %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°2**"),
    subtitle = md("**Resumen del modelo de regresion multiple**")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 1")
  ) %>%
  cols_align(
    align = "center",   
    columns = everything()  
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    table.border.top.style = "solid",
    table.border.bottom.style = "solid",
    column_labels.font.weight = "bold",
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    table_body.hlines.color = "grey",
    table_body.border.bottom.color = "black"
  )
Tabla N°2
Resumen del modelo de regresion multiple
Variable Ind.1 Variable Ind.2 Variable Dependiente Test Pearson Coeficiente de determinación Ecuación de la recta
Pérdida neta Costos de respuesta de Emergencia Liberación Involuntaria 0.83 69.58 y = 23.95 + 1.132 *x1 + 0.0003 *x2
Autor: Grupo 1

Cálculo de estimaciones

¿Cuál sería la liberacion de líquido si la perdida neta fuera de 500 barriles y los costos de respuesta de emergencia fueran de 1000?

# Valor para predecir
x1_pred <- 500
x2_pred <- 1000
# Predicción del modelo
y_esperado <- a * x1_pred + b * x2_pred + c

Respuesta : La liberación involuntaria esperada es 590.31 barriles.

Conclución

El análisis identifica una relación lineal multivariable entre la Pérdida Neta de barriles (X₁), los Costos de Respuesta de Emergencia (X₂) y la Liberación Involuntaria de barriles (Y). La ecuación del modelo es: \[ y = 23.95 + 1.132 x₁ + 0.0003 x₂. \] Con una correlación múltiple de 0.83, se confirma que la liberación involuntaria presenta una asociación positiva considerable con las variables explicativas, evidenciando que tanto la pérdida neta como los costos de emergencia influyen en el comportamiento de la variable dependiente.

Adicionalmente, al proyectar una pérdida neta de 500 barriles y costos de respuesta de emergencia de 1.000 unidades monetarias, el modelo estima una liberación involuntaria aproximada de 590.31 barriles.

Este resultado confirma que el comportamiento de la liberación involuntaria responde de manera directa al incremento de las variables operativas, siendo la pérdida neta el factor de mayor impacto dentro del modelo, lo cual es consistente con la dinámica operativa en eventos de derrames petroleros.