Modelo Lineal Multivariado SLA

Dataset

#install.packages("PerformanceAnalytics")
library(readr)
library(dplyr)

data <- read.csv("C:/Users/ander/Desktop/Kpis_SLA_meli.csv", header =TRUE, sep=",")

#Elimino la variable del SLA, para quedarme con dataset para analizar Backlog
data2 <- data[,c(2:15)]
head(data2)

Matriz de Correlación

#escala todas las variables para que tengan media = 0 y desviación estándar = 1 
data <- data%>% mutate_all (~ ( scale (.)%>% as.vector ))
data2 <- data2%>% mutate_all (~ ( scale (.)%>% as.vector ))

library(PerformanceAnalytics)
x <- data[,c( "SLA","VOLUMEN.RECIBIDO","BACKLOG", "Ausentismo","Ausentismo.NP", "Horas.trabajadas", "Hora.espera.promedio", "DESVIO.CAPACIDAD.vs.RECIBIDO", "BACKLOG_t1")]
chart.Correlation(x, histogram = TRUE, method = "pearson")

#install.packages("leaps")

require(leaps) 

# Prueba todos los posibles modelos y se queda con los mejores
#NO puede haber datos faltantes para aplicar lo que sigue:
mejores_modelos_back <- regsubsets(BACKLOG ~ ., data = data2, nvmax = 5) 
mejores_modelos_sla <- regsubsets(SLA ~ ., data = data, nvmax = 5) 

Selección de variables

#install.packages("leaps")

require(leaps) 

# Prueba todos los posibles modelos y se queda con los mejores
#NO puede haber datos faltantes para aplicar lo que sigue:
mejores_modelos_back <- regsubsets(BACKLOG ~ ., data = data2, nvmax = 7) 
mejores_modelos_sla <- regsubsets(SLA ~ ., data = data, nvmax = 7) 

library(ggplot2) 
p <- ggplot(data = data.frame(n_predictores = 1:7, R_ajustado = summary(mejores_modelos_back)$adjr2), aes(x = n_predictores, y = R_ajustado)) + 
  geom_line() + 
  geom_point() 
# Se identifica en rojo el máximo 
p <- p + geom_point(aes(x=n_predictores[which.max(summary(mejores_modelos_back)$adjr2)], y=R_ajustado[which.max(summary(mejores_modelos_back)$adjr2)]), colour = "red", size = 3) 
p <- p + scale_x_continuous(breaks = c(0:6)) + theme_bw() + 
  labs(title = "R2_ajustado vs número de predictores", x = "número predictores") 
p

################################################################


p1 <- ggplot(data = data.frame(n_predictores = 1:7, R_ajustado = summary(mejores_modelos_sla)$adjr2), aes(x = n_predictores, y = R_ajustado)) + 
  geom_line() + 
  geom_point() 
# Se identifica en rojo el máximo 
p1 <- p1 + geom_point(aes(x=n_predictores[which.max(summary(mejores_modelos_sla)$adjr2)], y=R_ajustado[which.max(summary(mejores_modelos_sla)$adjr2)]), colour = "red", size = 3) 
p1 <- p1 + scale_x_continuous(breaks = c(0:5)) + theme_bw() + 
  labs(title = "R2_ajustado vs número de predictores", x = "número predictores") 
p1

Mejor modelo para Backlog

coef(object = mejores_modelos_back, id = 5)

##      (Intercept)        CAPACIDAD VOLUMEN.RECIBIDO       BACKLOG_t1 
##    -4.510281e-17    -2.855217e-01     8.143013e-01     5.490245e-01 
##    Ausentismo.NP     Reencaminado 
##     2.465519e-01    -3.021792e-01

Mejor modelo para SLA

coef(object = mejores_modelos_sla, id = 3)

##         (Intercept)    VOLUMEN.RECIBIDO             BACKLOG Citados_confirmados 
##       -3.452100e-16        1.266789e-01       -9.456872e-01        8.757600e-02

Todas las combinaciones

Selecciona el subconjunto de predictores que alcanzan mayor R2 o menor MSE, Mallow’s Cp o AIC, etc.

library(olsrr)
lm.fit1 <- lm(BACKLOG ~ ., data = data2)
k_best <- ols_step_best_subset(lm.fit1)
k_best

plot(k_best)# el eje horizontal representa la cantidad de variables utilizadas en cada modelo.

lm.fit2 <- lm(SLA ~ ., data = data)
k_best <- ols_step_best_subset(lm.fit2)
k_best

plot(k_best)# el eje horizontal representa la cantidad de variables utilizadas en cada modelo.

Modelos Finales

Modelo Backlog

model_Backlog <- lm(BACKLOG ~ CAPACIDAD  + VOLUMEN.RECIBIDO  + BACKLOG_t1 +Ausentismo.NP  + Reencaminado , data = data2)
summary(model_Backlog)

## 
## Call:
## lm(formula = BACKLOG ~ CAPACIDAD + VOLUMEN.RECIBIDO + BACKLOG_t1 + 
##     Ausentismo.NP + Reencaminado, data = data2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.42503 -0.40659 -0.02751  0.39744  1.40309 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       7.264e-17  7.028e-02   0.000  1.00000    
## CAPACIDAD        -2.855e-01  9.035e-02  -3.160  0.00247 ** 
## VOLUMEN.RECIBIDO  8.143e-01  1.109e-01   7.345 6.46e-10 ***
## BACKLOG_t1        5.490e-01  7.516e-02   7.305 7.54e-10 ***
## Ausentismo.NP     2.466e-01  7.609e-02   3.240  0.00195 ** 
## Reencaminado     -3.022e-01  1.032e-01  -2.929  0.00480 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5709 on 60 degrees of freedom
## Multiple R-squared:  0.6991, Adjusted R-squared:  0.674 
## F-statistic: 27.88 on 5 and 60 DF,  p-value: 1.764e-14

Modelo SLA

model_sla <- lm(SLA ~ VOLUMEN.RECIBIDO     +   BACKLOG + Citados_confirmados  , data=data)
summary(model_sla)

## 
## Call:
## lm(formula = SLA ~ VOLUMEN.RECIBIDO + BACKLOG + Citados_confirmados, 
##     data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.81131 -0.22906  0.04872  0.31298  1.02202 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         -4.435e-16  5.658e-02   0.000   1.0000    
## VOLUMEN.RECIBIDO     1.267e-01  6.842e-02   1.851   0.0689 .  
## BACKLOG             -9.457e-01  6.860e-02 -13.786   <2e-16 ***
## Citados_confirmados  8.758e-02  5.728e-02   1.529   0.1314    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4597 on 62 degrees of freedom
## Multiple R-squared:  0.7985, Adjusted R-squared:  0.7887 
## F-statistic: 81.87 on 3 and 62 DF,  p-value: < 2.2e-16

Se usa el criterio del vif para verificar la multicolinealidad un vif bajo o menor a 5 es criterio suficiente para descartar multicolinealidad

library(car)
car::vif(model_Backlog)

##        CAPACIDAD VOLUMEN.RECIBIDO       BACKLOG_t1    Ausentismo.NP 
##         1.627691         2.451276         1.126340         1.154621 
##     Reencaminado 
##         2.121876

Análisis de normalidad, homocedasticidad y autocorrelación de los residuos.

#install.packages("lmtest")
library(lmtest)


shapiro.test(model_sla$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  model_sla$residuals
## W = 0.93513, p-value = 0.001882

bptest(model_sla)

## 
##  studentized Breusch-Pagan test
## 
## data:  model_sla
## BP = 6.3412, df = 3, p-value = 0.09614

dwtest(model_sla)

## 
##  Durbin-Watson test
## 
## data:  model_sla
## DW = 1.5639, p-value = 0.02968
## alternative hypothesis: true autocorrelation is greater than 0

par(mfrow=c(2,2))
plot(model_Backlog)

### Distancia Cook

dcook<-cooks.distance(model_sla)
influenceIndexPlot(model_sla, vars='Cook', las=1,col='blue')

dcook<-cooks.distance(model_Backlog)
influenceIndexPlot(model_Backlog, vars='Cook', las=1,col='blue')

qqPlot(model_Backlog$residuals, pch=19,
main="QQplot para los residuos del Modelo Lineal",
xlab="Cuantiles te´oricos",
ylab="Cuantiles muestrales")

## [1] 59 11