Modelo de Regresión Multiple

1.Preparación de datos

1.1 Carga de datos

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

1.2 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)

1.3 Selección de Variables de Interés

LINB <- as.numeric(datos$LiberacionInvoluntariaBarriles)
PNB <- as.numeric(datos$PerdidaNetaBarriles)
CRE <- as.numeric(datos$CostosRespuestaEmergencia)

datos_interes <- data.frame(LINB,PNB,CRE)
datos_interes <- na.omit(datos_interes)

1.4 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
  )

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

2.1 Selección de Variable Predictora y Variable Respuesta

# Variable dependiente
y <- datos_filtrados$LINB

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

3.Conjetura del modelo de regresión

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

3.1 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

3.2 Gráfica del modelo

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

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

3.3 Análisis de Correlación

3.3.1 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 %

3.3.2 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 %

3.4 Ecuación del modelo

Para obtener la ecuación de la regresión mutiple, 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:

  • \(\boldsymbol{c}\) es el intercepto
  • \(\boldsymbol{b}\) y \(\boldsymbol{c}\) 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]

La pendiente es: 23.95

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

3.5 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.

3.6 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

4.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.