Descripcción del trabajo

El presente trabajo pretende desarrollar un modelo predictivo de ventas el cual permita una acertada toma de decisiones basada en información útil obtenida de los datos históricos con respecto a la venta de tabaco en el mercado español durante los años 2015-2023.

Para lograr este objetivo, se analizará a profundidad la información disponible en lo que respecta a la venta de cigarrillos en España, mediante la utilización del lenguaje de programación R Studio, así como la siguiente fuente de datos perteneciente al Ministerio de Hacienda Pública de España link

Cargar las librerías necesarias

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(dplyr)
library(ggplot2)
library(ggpubr)
library(writexl)
library(forecast)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo 
## 
## Attaching package: 'forecast'
## 
## The following object is masked from 'package:ggpubr':
## 
##     gghistogram
library(tseries)
library(readxl)

Cargar los datos

Resumen_marcas <- read_excel("C:/Users/Moi/Desktop/Rioja/Trabajo Fin de Master/Punto 3 TFM/Datasets/Resumen marcas-Corregido.xlsx", 
                             sheet = "Ventas mensuales_2015-2023#")
View(Resumen_marcas)

datos<-Resumen_marcas

Análisis Estadístico

summary(Resumen_marcas)
##      Fecha                     Ventas Totales     
##  Min.   :2015-01-31 00:00:00   Min.   :403584687  
##  1st Qu.:2017-04-22 12:00:00   1st Qu.:502843275  
##  Median :2019-07-15 12:00:00   Median :551116160  
##  Mean   :2019-07-16 05:33:20   Mean   :549593575  
##  3rd Qu.:2021-10-07 18:00:00   3rd Qu.:594976856  
##  Max.   :2023-12-31 00:00:00   Max.   :718000692
prop.table(datos$`Ventas Totales`)
##   [1] 0.009123024 0.007325150 0.009656478 0.009315585 0.009963288 0.010666858
##   [7] 0.012096493 0.010873732 0.010550999 0.010066431 0.008603297 0.009837532
##  [13] 0.008472993 0.008297810 0.009417944 0.009462514 0.010128042 0.010905187
##  [19] 0.010927621 0.011858203 0.010548337 0.009423798 0.009378457 0.009999635
##  [25] 0.007567922 0.007618973 0.009831374 0.008772292 0.010525080 0.010924832
##  [31] 0.010265605 0.011554438 0.009721246 0.009718356 0.009208440 0.008414760
##  [37] 0.008467561 0.007618004 0.008779745 0.009254237 0.010293995 0.009919832
##  [43] 0.010997809 0.011410169 0.009223092 0.010033571 0.008742047 0.008284549
##  [49] 0.008922985 0.007527202 0.008764469 0.009319640 0.010321059 0.009375016
##  [55] 0.011396150 0.010911927 0.009329665 0.009942145 0.008340776 0.008682947
##  [61] 0.009111983 0.007805308 0.008590914 0.006799379 0.007397037 0.008987592
##  [67] 0.010858491 0.008836311 0.008517579 0.008190686 0.007331348 0.008512339
##  [73] 0.007139059 0.006828723 0.008773459 0.007607437 0.008132392 0.009107032
##  [79] 0.009703491 0.009929358 0.009436613 0.008182139 0.008251580 0.008476867
##  [85] 0.007609415 0.007549845 0.008821438 0.008408352 0.009445709 0.010020613
##  [91] 0.009677814 0.010582328 0.009995937 0.008161644 0.008679107 0.008964964
##  [97] 0.008084891 0.007645756 0.009710490 0.008593353 0.010337233 0.010276052
## [103] 0.010293992 0.011213290 0.009401391 0.009704254 0.008867068 0.008566632
sd(datos$`Ventas Totales`)
## [1] 69269444
var(datos$`Ventas Totales`)
## [1] 4.798256e+15

Se sabe que las ventas estan a una desviación estandar de 69.269.444$ con respecto a su media 549.593.575$ lo cual no es tan elevada teniendo en cuenta un coeficiente de variacion de 12.3%. Más adelante nos vamos a dar cuenta el comportamiento y la fluctuación de las ventas con respecto al tiempo.

Análisis de Tendencías

  • Se van a establecer los datos de la fecha en su formato respectivo
Resumen_marcas$Fecha <- as.Date(Resumen_marcas$Fecha, format="%Y-%m-%d")
Resumen_marcas %>%
  ggplot(aes(x=Fecha, y=`Ventas Totales`)) +
  geom_line(color = '#3393f3') +
  scale_x_date(date_breaks = "6 month", date_labels = "%b") +
  labs(x="Mes", y="Ventas Mensuales", title = "Ventas de ALTADIS periodo 2015 - 2023",
       caption = "Datos: Ministerio de Hacienda Pública")

Como se puede observar en la gráfica, existe bastante ruido y fluctuación pero al mismo tiempo, hay un comportamiento estacionario repetitivo donde cierto número de meses suben las ventas y cierto número de veces bajan en respectivas fechas del año teniendo como meses clave febrero disminuyendo las ventas y agosto donde empiezan a subir.

Serie temporal

ventas_st <- ts(Resumen_marcas$`Ventas Totales`, start = c(2015,1), frequency = 12)
descomposicion_ventas <- decompose(ventas_st)
plot(descomposicion_ventas)

Se llega a descomponer la serie de tiempo para entender su comportamiento regular, tendencia, temporada y aleatoriedad de los datos.

Es curioso observar como el efecto del COVID se hace notar durante el año 2020 dentro del comoportamiento aleatorio destacando lo inusual que llegó a ser este evento inesperado y como la tendencia se desploma de igual forma.

tendencia_ventas <- descomposicion_ventas$trend
plot(tendencia_ventas)

Análisis de la tendencia en las ventas

Resumen_marcas %>%
  ggplot(aes(x=Fecha, y=`Ventas Totales`)) +
  geom_line(color = '#3393f3') +
  geom_smooth(method = "lm") +
  scale_x_date(date_breaks = "6 month", date_labels = "%b") +
  labs(x="Mes", y="Ventas Mensuales", title = "Tendencia de ventas de ALTADIS",
       caption = "Datos: Ministerio de Hacienda Pública")
## `geom_smooth()` using formula = 'y ~ x'

  • Vamos a suavizar la tendencia para enteder a mayor profundidad el comportamiento
Resumen_marcas %>%
  ggplot(aes(x=Fecha, y=`Ventas Totales`)) +
  geom_line(color = '#3393f3') +
  geom_smooth(color = '#d10e28') +
  scale_x_date(date_breaks = "6 month", date_labels = "%y") +
  labs(x="Año", y="Ventas Mensuales", title = "Tendencia de ventas de ALTADIS",
       caption = "Datos: ALTADIS")
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

Pronóstico

Creación del modelo ARIMA y predicción

modelo_ventas_altadis <- auto.arima(ventas_st)
prediccion_ventas_altadis <- forecast(modelo_ventas_altadis,12)
plot(prediccion_ventas_altadis)

Se realizo el pronóstico para los próximos 12 meses donde la linea azul es el comportamiento de la media de ventas a futuro y los bordes grises obscuros son los límites de las ventas a futuro. A simple vista, se puede entender que el comportamiento va a ser similar a los años previos con un ligero y posible aumento de ventas considerando los límites grises.

Valores a futuro

valores_prediccion_ventas <- prediccion_ventas_altadis$mean
valores_prediccion_ventas
##            Jan       Feb       Mar       Apr       May       Jun       Jul
## 2024 519106312 470211267 576846917 549204475 598896396 612170830 643811117
##            Aug       Sep       Oct       Nov       Dec
## 2024 668268472 590406648 586488377 540959200 539521014

Extrayendo la media de la predicción, obtenemos las posibles ventas en lo que respecta cada mes del año 2024

Valores actuales

prediccion_modelo <- prediccion_ventas_altadis$fitted
prediccion_modelo
##            Jan       Feb       Mar       Apr       May       Jun       Jul
## 2015 541194521 434735198 573016579 552839649 591269628 633011288 717808763
## 2016 505122316 431171452 577134292 542637378 618865615 616680707 728434360
## 2017 497522831 499799016 547024797 539672137 598233100 642230204 634290464
## 2018 450932731 443291183 535214751 539154187 595506740 607900049 646590526
## 2019 504047861 447266489 513618812 560345483 588883430 602622846 645352298
## 2020 506042730 427817148 538403810 546954184 587086130 544328199 600379006
## 2021 454994479 374772652 467536335 367634203 461143644 526646731 610647315
## 2022 431378196 445855484 523763685 472270390 535422994 551339807 630859540
## 2023 464208338 479044898 531595567 483227702 546448928 621266862 615764118
##            Aug       Sep       Oct       Nov       Dec
## 2015 645322731 626195803 597468143 510708489 584222223
## 2016 648136185 635571863 577964718 533123606 577032281
## 2017 689098108 616606730 540165048 548493040 559365285
## 2018 661351440 562603785 584782880 524572378 497127129
## 2019 681764875 540953335 596480987 503019850 503448412
## 2020 589757302 487308218 498238815 387818072 466280155
## 2021 544245108 519211543 497060322 462368197 502407457
## 2022 621175420 582983099 521015491 519670294 527585241
## 2023 651259947 610888598 520418970 561120103 535845599

Comparativa valores actuales vs predicción

plot(ventas_st, ann=FALSE)
lines(prediccion_ventas_altadis$fitted, col="green", lwd=2)
title(main = "Datos reales vs valores de la predicción", xlab = "Años", ylab = "Ventas")
legend("bottomright", c("Original", "Predicción"),
       lwd=c(1,2), col=c("black", "green"), cex = 0.8)

Tal y como lo representa el gráfico, la linea verde explica el comportamiento de la predicción tomando en cuenta los ventas actuales y a futuro. Se logra entender que el comportamiento llegaría a ser similar a los datos reales con ligeros cambios en los picos y sobretodo en la etapa del COVID.

Conclusiones de la predicción

prediccion_ventas_altadis$mean
##            Jan       Feb       Mar       Apr       May       Jun       Jul
## 2024 519106312 470211267 576846917 549204475 598896396 612170830 643811117
##            Aug       Sep       Oct       Nov       Dec
## 2024 668268472 590406648 586488377 540959200 539521014
accuracy(prediccion_ventas_altadis)
##                   ME     RMSE      MAE        MPE     MAPE      MASE       ACF1
## Training set 1422352 36029291 25343762 0.09339001 4.844126 0.7178207 0.02420018

El error medio (ME): Es de 1.422.342$ con respecto a las ventas donde se entiende que el modelo sobrestimo las ventas en esta cantidad en relación a los datos reales. Esto nos da un indicio de que las ventas aumentarían en una nivel bajo pero llegarían a aumentar a la final.

El error cuadrático medio de raíz (RMSE): Logra medir la magnitud promedio del error enfocandose a errores grandes debido a su elevación al cuadrado y analizando las predicciones individuales para evaluar posibles errores en caso de que este indicador sea alto. Con 36.029.291$, se entiende que el RMSE es razonable debido a la magnitud de las ventas las cuales son en millones y acercandose a los billones de $

El error absoluto medio (MAE): Es similar al RMSE con la diferencia donde este indicador no se enfoca tanto en los errores grandes, mas bien se centra en la diferencia de los datos reales con los datos de predicción. En este caso, 25.342.762$ con respecto a las ventas reales no estan muy separadas de la realidad.

El error porcentual medio (MPE): Es de 9.33% entendiendo que el modelo de predicción es bueno, no excelente pero bastante acertado ya que solo se desvia de los datos reales en un 9.3% tomando en cuenta que el margen de error esperado es de 10%. Brinda una visión de como se tendría que preparar la industria del tabaco con respecto al futuro y los comportamientos temporales de su industria.

El error absoluto porcentual medio (MAPE): Es similar al MPE pero con la diferencia de que este idicador toma en cuenta valores atípicos con picos muy alto o muy bajos dentro del comportamiento de una predicción alterando el estudio de errores. Con un MAPE de 484.4%, es bastante elevado pero tiene su explicación ya que dentro del periodo del COVID, exisitieron picos bastante bajos donde la predicción al momento de analizar las ventas, tomo este comportamiento como un error o una anomalía fuera de lo comun alterando el indicador.

El error medio absoluto escalado (MASE): Ayuda a entender si el modelo tiene un error promedio similar a un modelo básico. Con un 71.7% se entiende que el modelo es mas preciso que un modelo de referencia.

La autocorrelación del error en lag 1 (ACF1): Permite entender la correlación de los errores de las variables con respecto al tiempo. Si el valor es cercano a 0, el error de las variables no tienen dependencia temporal significativa. Con un 0.024, se entiende que los errores son independientes en su mayoría