1. Modelo Cervezas

# Cargar librerías de trabajo en R

library(readxl)
library(scales)
library(ggplot2)
library(ggpubr)
library(forecast)
library(dplyr)
library(car)
library(ggcorrplot)
library(FitAR)

Importar los datos, dependiendo la ubicación que se encuentren en el directorio

ruta = "/Users/mivicuna/Desktop/Proyecto CCU/Información CCU/Cervezas 26-08-2021 V5/DataFrameCervezasInterna.xlsx"

datoscer  = read_excel(ruta,col_types = c("date", "numeric","numeric",
                       "numeric", "numeric", "numeric", "numeric"))

1.1 Análisis Descriptivo

1.1.1 Venta Volumen de Cervezas

A continuación se grafica la variable objetivo de venta volumen de cerveza desde Enero 2014 a Agosto 2021.

plot1.1  =  ggplot(datoscer,aes(x = PERIODO, y = CERVEZAS))   +
  geom_point(colour = "skyblue4", alpha = 0.7)    +
  geom_line(colour = "skyblue4", alpha = 0.7)     +
  labs(title = "Volumen Industria Cerveza",
       x = "Fecha",
       y = "Volumen en millones")                 +
  theme_bw()                                      +
  scale_y_continuous(labels = label_number(suffix =   "M", scale = 1e-6))                                         

El histograma de la venta volumen de cervezas está dado por

plot1.2  =  ggplot(data = datoscer, aes(x = CERVEZAS))      +
            geom_histogram(alpha = 0.7, color="black", fill =
            "slategray4")                                   +
            labs(title = "Histograma del Volumen Industria   
            Cerveza",
            x = "Volumen Industria Cerveza",
            y = "Frecuencia")                               +
            scale_x_continuous(labels = label_number(suffix = "M", scale = 1e-6))  +
            theme_bw()
ggarrange(plot1.1,plot1.2, ncol=2,nrow=1)

Las medidas descriptivas de la venta volumen de cervezas se calculan mediante

medidas = skimr::skim(select(datoscer,CERVEZAS))

1.1.2 Variables Independientes

Los gráficos de tendencia para cada una de las dimesiones predictoras del modelo

#====== Desempleo ======#

plot2.1  =  ggplot(datoscer,aes(x = PERIODO))                                     +
            geom_point(aes(y = DESEMPLEO), alpha = 0.7, colour = "skyblue4")      +
            geom_line(aes(y = DESEMPLEO), alpha = 0.7, colour = "skyblue4")       +
            labs(title    = "Tasa de Desempleo  \n INE",  
            x = "Fecha", y = "Valor Tasa")                                        +
            theme_bw()                
 

#====== Precio Cervezas ======#

plot2.2   = ggplot(datoscer,aes(x = PERIODO))                                     +
            geom_point(aes(y = PCERVEZAS_T), alpha = 0.7, colour = "skyblue4")    +
            geom_line(aes(y = PCERVEZAS_T), alpha = 0.7, colour = "skyblue4")     +
            labs(title    = "Precio Industria \n    Cerveza",  
            x = "Fecha",  y = "Precio")                                           +
            theme_bw()                                                        
 
#====== Temperatura Máxima ======#

plot2.3  = ggplot(datoscer,aes(x = PERIODO))                                     +
           geom_point(aes(y = TEMP_MAX), alpha = 0.7, colour = "skyblue4")       +
           geom_line(aes(y = TEMP_MAX), alpha = 0.7, colour = "skyblue4")        +
           labs(title    = "Temperatura Máxima \n  Promedio", 
           x = "Fecha",y = "Temperatura")                                        +
           theme_bw()                                                 
 
#====== Índice de Movilidad ======#

plot2.4 =   ggplot(datoscer,aes(x = PERIODO))                                     +
            geom_point(aes(y = MOVILIDAD), alpha = 0.7, colour = "skyblue4")      +
            geom_line(aes(y = MOVILIDAD), alpha = 0.7, colour = "skyblue4")       +
            labs(title    = "Índice de Movibilidad",
            x = "Fecha",
            y = "Valor del índice")                                               +
            theme_bw()                                               
 
  
#====== Retiros ======#

plot2.5  = ggplot(datoscer,aes(x = PERIODO))                                     +
           geom_point(aes(y = RETIROS), alpha = 0.7, colour = "skyblue4")        +
           geom_line(aes(y = RETIROS), alpha = 0.7, colour = "skyblue4")         +
           labs(title    = "Variable Retiros \n AFP",
           x = "Fecha",
           y = "Valor del índice")                                               +
           theme_bw()                                                       
               
ggarrange(plot2.1,plot2.2,plot2.3,plot2.4,plot2.5,ncol=3,nrow=2)

Los histogramas de distribuciones de cada dimensión predictiva

#====== Desempleo ======#

plot3.1  = ggplot(data = datoscer, aes(x = DESEMPLEO))                       +
           geom_histogram(alpha = 0.7, color="black", fill = "slategray4")   +
           labs(title = "Histograma de la tasa \n de desempleo", 
           x = "Tasa desempleo",  y = "Frecuencia")                          +
           theme_bw()


#====== Precio Cervezas ======#

plot3.2  =  ggplot(data = datoscer, aes(x = PCERVEZAS_T))                      +
            geom_histogram(alpha = 0.7, color="black", fill = "slategray4")    +
            labs(title = "Histograma de precio \n industria cerveza",
            x = "Precio Cerveza",  y = "Frecuencia")                           +
            theme_bw()


#====== Temperatura Máxima ======#

plot3.3  = ggplot(data = datoscer, aes(x = TEMP_MAX))                          +
           geom_histogram(alpha = 0.7, color="black", fill = "slategray4")     +
           labs(title = "Histograma de la \n temperatura máxima",
           x = "Temperatura máxima", y = "Frecuencia")                         +
           theme_bw()

#====== Índice de Movilidad ======#


plot3.4  =  ggplot(data = datoscer, aes(x = MOVILIDAD))                        +
            geom_histogram(alpha = 0.7, color="black", fill = "slategray4")    +
            labs(title = "Histograma de índice \n de movilidad ",  
            x = "índice movilidad",y = "Frecuencia")                      +
            theme_bw()


#====== Retiros ======#


plot3.5  =  ggplot(data = datoscer, aes(x = RETIROS))                          +
            geom_histogram(alpha = 0.7, color="black", fill = "slategray4")    +
            labs(title = "Histograma de retiros \n AFP", 
            x = "Retiros AFP",  y = "Frecuencia")                              +
            theme_bw()

ggarrange(plot3.1,plot3.2,plot3.3,plot3.4,plot3.5,ncol=3,nrow=2)

medidas_variables = skimr::skim(select(datoscer,-c(PERIODO,CERVEZAS)))

1.2 Análisis Bivariado

A continuación los gráficos de dispersión de la variable objetivo con las dimensiones independientes

subset2.1 <- select(datoscer,-c(PERIODO,CERVEZAS))
Cervezas  <- datoscer$CERVEZAS

myplots <- list()

for(i in 1:ncol(subset2.1)){
  col <- names(subset2.1)[i]
  aux <- bind_cols(Cervezas = Cervezas,select(datoscer,col))
  ggp <- ggplot(aux, aes_string(x = col , y = "Cervezas"))    +
    geom_point(color = "slategray4",alpha=0.7)                +
    geom_smooth(method = "lm",col="red")                      +
    labs(y = "Volumen Industria Cerveza")                     +
    scale_y_continuous(labels = label_number(suffix = " M", scale = 1e-6))
  theme_bw()
  myplots[[i]] <- ggp
  rm(ggp,aux,col)
}
plot3.3 <- ggarrange(myplots[[1]],myplots[[2]],myplots[[3]], 
                     myplots[[4]],myplots[[5]],
                     nrow = 2, ncol = 3, common.legend = TRUE)

annotate_figure(plot3.3,top = text_grob("Gráficos de dispersión las variables independientes"))

Cálculo de correlaciones de la variable objetivo con las dimensiones utilizadas

tibble(Variable = row.names(cor(subset2.1, Cervezas)),
       Correlacion = as.numeric(cor(subset2.1, Cervezas))) %>%
       arrange(desc(abs(Correlacion)))
## # A tibble: 5 x 2
##   Variable    Correlacion
##   <chr>             <dbl>
## 1 TEMP_MAX          0.666
## 2 RETIROS           0.416
## 3 DESEMPLEO         0.258
## 4 PCERVEZAS_T       0.201
## 5 MOVILIDAD        -0.175

Ajuste del Modelo CCU

Cervezas  = ts(datoscer$CERVEZAS, frequency=12, start=c(2014,1))
TYPCYD    = ts(as.matrix(select(datoscer,-c(PERIODO,CERVEZAS))), frequency=12,
            start=c(2014,1))

## Modelo Ajustado  con la función auto.arima()

arimaCervezas = auto.arima(Cervezas, xreg=TYPCYD)

Se ajusta el modelo obtenido con la función auto.arima( ) utilizando la función Arima( ) del paquete forecast de R,

## Ajustar el modelo obtenido con autoarima con la función Arima

model_auto_arima_cerv = Arima(Cervezas,order = c(3, 0, 0),
                         seasonal = list(order = c(0, 1, 1), 
                         period = 12),include.drift =TRUE,xreg = TYPCYD )

Se evalúa la significancia de los parámetros realizando test \(H_0:\beta_i = 0\) v/s \(H_1: \beta_i \neq 0\) para \(i=1,2,3,4,5\)

### Significancia de los parámetros del modelo

beta_est = model_auto_arima_cerv$coef
sd_est = sqrt(diag(model_auto_arima_cerv$var.coef))
value_t = abs(beta_est/sd_est)

1.3 Análisis Multivariado

A continuación los gráficos de heatmap de correlaciones de a pares de las dimensiones independientes

variables      = colnames(subset2.1[,1:5])
corr_variables = matrix(round(cor(subset2.1[,1:5]),3),nrow=5,ncol=5, dimnames = list(variables,variables))

ggcorrplot(corr_variables, hc.order = TRUE, outline.col = "black", lab = TRUE, )    + 
           theme(axis.text.x = element_text(size = 8),
           axis.text.y = element_text(size = 8)) 

1.4 Verificación de los supuestos

1.4.1 Normalidad

datoscer$Residuos <- residuals(model_auto_arima_cerv)

# Residuos Estandarizados
datoscer$Residuos_z = (datoscer$Residuos - mean(datoscer$Residuos))/sd(datoscer$Residuos)
  
# ===== QQ-plot =====#

plot4.3 <- ggplot(datoscer, aes(sample = Residuos_z))         + 
           stat_qq()                                          + 
           geom_abline(slope=1)                               + 
           labs(title = "Normal Q-Q Plot",
           x = "Theoretical Quantiles",
           y = "Sample Quantiles")              +
           theme_bw()

x  = seq(min(seq(min(datoscer$Residuos_z),max(datoscer$Residuos_z),len=1000)),
     max(datoscer$Residuos_z),len=1000)
gg = dnorm(x,0,1)

datosplot <- data.frame(x = x, y = gg)

plot4.4 <- ggplot(data = datoscer, aes(x = Residuos_z))        +
           geom_histogram(aes(y=..density..),alpha = 0.5,
           color="black", fill = "gray50")                     +
           geom_point(data=datosplot, aes(x=x,y=y),
           color="skyblue4")                                   +
           labs(title = "Distribución Normal",
            x = "Residuos") +
            theme_bw()

ggarrange(plot4.3,plot4.4,ncol=2)

1.4.2 Independencia

plot1 = ggAcf(datoscer$Residuos,lag=30) +
        labs(title = "ACF Residuos Modelo Cervezas") +
        ylim(-0.3,0.3) + 
        theme_bw()
plot1

El test de Ljung-Box para testear simúltaneamente que sean incorrelacionados los errores para varios lag de tiempo

Est = c()
valorp = c()

for( i in 1:12){
  Test = Box.test(datoscer$Residuos, lag = i, type =   "Ljung-Box")
  Est[i]  = Test$statistic
  valorp[i] = Test$p.value
}

tibble(Lag = seq(1,12),Estadistico = Est, valor_p = valorp)
## # A tibble: 12 x 3
##      Lag Estadistico valor_p
##    <int>       <dbl>   <dbl>
##  1     1     0.00951   0.922
##  2     2     0.0397    0.980
##  3     3     0.0490    0.997
##  4     4     0.0721    0.999
##  5     5     0.0728    1.00 
##  6     6     0.588     0.997
##  7     7     0.793     0.998
##  8     8     1.33      0.995
##  9     9     3.59      0.936
## 10    10     3.94      0.950
## 11    11     4.12      0.966
## 12    12     4.47      0.973

Gráfico de los valores-p del test Ljung-Box

LBQPlot(datoscer$Residuos)

1.4.3 No colinealidad

Regresion_Model_Cer <- lm(CERVEZAS ~ -1 + DESEMPLEO  + PCERVEZAS_T +TEMP_MAX + MOVILIDAD +RETIROS,data=datoscer )
tibble(Variable = names(vif(Regresion_Model_Cer)), VIF = round(vif(Regresion_Model_Cer),3))%>%as.data.frame()
##      Variable     VIF
## 1   DESEMPLEO 193.789
## 2 PCERVEZAS_T 189.882
## 3    TEMP_MAX  18.857
## 4   MOVILIDAD   8.578
## 5     RETIROS   1.893

1.4.4 Homocedasticidad

plot1 =  ggplot(data = subset2.1, aes(model_auto_arima_cerv$fitted,model_auto_arima_cerv$residuals)) +
  geom_point() +
  geom_smooth(color = "firebrick", se = FALSE) +
  geom_hline(yintercept = 0) +
  labs( title = "Gráfico Homocedasticidad Modelo Cervezas ",
        y = "Residuos",
        x = "Ventas Volumen Proyectadas")               +
  theme_bw()

plot1