install.packages("readr")
install.packages("dplyer")
install.packages("zoo")
install.packages("lubridate")
install.packages("ggplot2")
install.packages("stringr")Pronóstico de un paso hacia delante: ventas mensuales
Instalación de los Paquetes Necesarios
Si no han sido instalados antes, se deben instalar los paquetes necesarios con el comando install.packages() . Una vez instalado, el paquete queda almacenado en la memoria del R y debe ser activado cada vez que se abre sesión.
Activamos los paquetes con library()
library(readr)
library(dplyr)
library(zoo)
library(ggplot2)
library(lubridate)
library(stringr)Base de Datos
Cargamos la base:
url <- "https://infra.datos.gob.ar/catalog/sspm/dataset/455/distribution/455.1/download/ventas-totales-supermercados-2.csv"
datos_ventas <- read_csv(url)Vemos las primeras filas:
head(datos_ventas)Vemos los nombres de las variables contenidas:
colnames(datos_ventas) [1] "indice_tiempo" "ventas_precios_corrientes"
[3] "ventas_precios_constantes" "ventas_totales_canal_venta"
[5] "salon_ventas" "canales_on_line"
[7] "ventas_totales_medio_pago" "efectivo"
[9] "tarjetas_debito" "tarjetas_credito"
[11] "otros_medios" "ventas_totales_grupo_articulos"
[13] "subtotal_ventas_alimentos_bebidas" "bebidas"
[15] "almacen" "panaderia"
[17] "lacteos" "carnes"
[19] "verduleria_fruteria" "alimentos_preparados_rotiseria"
[21] "articulos_limpieza_perfumeria" "indumentaria_calzado_textiles_hogar"
[23] "electronicos_articulos_hogar" "otros" Sin embargo, indice_tiempo está en formato character cuando necesitamos una variable en formato de fecha, date.
datos_ventas$tiempo_mensual <- as.yearmon(datos_ventas$indice_tiempo, format = "%d/%m/%Y")Revisamos si efectivamente está en formato temporal (y mensual):
head(datos_ventas$tiempo_mensual)[1] "ene. 2017" "feb. 2017" "mar. 2017" "abr. 2017" "may. 2017" "jun. 2017"Visualización
Ventas totales en supermercados a precios corrientes
plot(datos_ventas$tiempo_mensual, datos_ventas$ventas_precios_corrientes, type = "l", xlab ="Fecha", ylab ="Ventas (precios corrientes)")
Ventas totales en supermercados a precios constantes
plot(datos_ventas$tiempo_mensual, datos_ventas$ventas_precios_constantes, type = "l", xlab ="Fecha", ylab ="Ventas (precios constantes)")
Calcular la Tasa de Inflación Ímplicita
Con los datos de las ventas a precios corrientes y a precios constantes se puede calcular el IPI (Índice de Precios Implícito) y la Tasa de Inflación, que puede ser relevante para la toma de decisiones empresarial.
datos_ventas$IPI <- datos_ventas$ventas_precios_corrientes/datos_ventas$ventas_precios_constantesSe puede llamar a la función lag() del paquete dplyer para calcular la variación porcentual del IPI, es decir, la tasa de inflación mensual.
datos_ventas <- datos_ventas %>%
mutate(tasa_inflacion_mensual = (IPI / lag(IPI) - 1) * 100)
datos_ventas$tasa_inflacion_mensual[1] # NA[1] NAdatos_ventas$tasa_inflacion_mensual[1] <- 0datos_ventas$tasa_inflacion_mensual[1]
datos_ventas <- datos_ventas %>%
mutate(año = year(tiempo_mensual))ggplot(datos_ventas, aes(x = tiempo_mensual, y = tasa_inflacion_mensual, fill = as.factor(año))) +
geom_bar(stat = "identity") +
labs(x = "Fecha", y = "Tasa de Inflación Mensual (%)", title = "Tasa de Inflación Mensual por Año") +
scale_fill_viridis_d(name = "Año") +
theme_minimal()Warning: The `trans` argument of `continuous_scale()` is deprecated as of ggplot2 3.5.0.
ℹ Please use the `transform` argument instead.
datos_ventas <- datos_ventas %>%
mutate(tasa_inflacion_anual = (datos_ventas$IPI / lag(datos_ventas$IPI, n=12) - 1)*100)datos_anuales <- datos_ventas %>%
mutate(año = year(tiempo_mensual)) %>%
group_by(año) %>%
summarise(tasa_inflacion_anual = prod(1 + tasa_inflacion_mensual / 100) - 1) %>%
mutate(tasa_inflacion_anual = tasa_inflacion_anual * 100)ggplot(datos_anuales, aes(x = as.factor(año), y = tasa_inflacion_anual)) +
geom_bar(stat = "identity", fill = "steelblue") +
labs(x = "Año", y = "Tasa de Inflación Anual (%)", title = "Tasa de Inflación Acumulada por Año") +
theme_minimal()
Modelación y Eliminación de la Tendencia
Para realizar pronósticos debemos empezar con modelar la tendencia de la serie. En este caso y para mayor utilidad práctica, nos interesamos en la serie de las ventas a precios corrientes pues es potencialmente más relevante pronosticar el monto total de ventas para un periodo adyacente que una medida como las ventas a precios constantes que si bien sirve para identificar la evolución real de las cantidades vendidas y medir la inflación, no sirve para el propósito principal de este reporte que es realizar el pronóstico más acertado posible y para eso utilizaremos las ventas a precios corrientes (con una ayuda del logaritmo natural para así suavizar la secuencia y confiar en que se cumplan propiedades estadísticas deseables).
Para eso analizamos la posible tendencia temporal de la serie de ventas en base al gráfico del ln(ventas_precios_corrientes) (llamemosle log_ventas):
datos_ventas <- datos_ventas %>%
mutate(log_ventas = log(ventas_precios_corrientes))ggplot(datos_ventas, aes(x = indice_tiempo, y = log_ventas)) +
geom_line(linewidth = 1, color = "steelblue") +
labs(x = "Tiempo", y = "Log natural de ventas a precios corrientes", title = "Serie de Ln(Ventas)") +
theme_minimal()
Podría haber una tendencia cúbica (la cual contempla la tendencia exponencial hasta diciembre de 2023 con el cambio hacia una tendencia más lineal, o inclusive creciente a ritmo decreciente, en el 2024, apoyado también por el hecho de que en el 2024 habría recesión).
Asimismo, generamos una variable tiempo que va a tomar una secuencia [1,96] para los meses de nuestra realización temporal (1 para enero del 2017, 2 para febrero del 2017 y así sucesivamente).
datos_ventas <- datos_ventas %>%
mutate(tiempo = row_number())Creamos tiempo2 y tiempo3.
datos_ventas <- datos_ventas %>%
mutate(tiempo2 = tiempo^2)
datos_ventas <- datos_ventas %>%
mutate(tiempo3 = tiempo^3)Comenzamos entonces con un modelo de tendencia cúbica.
modelo_1 <- summary(lm(datos_ventas$log_ventas ~ datos_ventas$tiempo + datos_ventas$tiempo2 + datos_ventas$tiempo3))
modelo_1
Call:
lm(formula = datos_ventas$log_ventas ~ datos_ventas$tiempo +
datos_ventas$tiempo2 + datos_ventas$tiempo3)
Residuals:
Min 1Q Median 3Q Max
-0.24657 -0.06798 -0.01640 0.04198 0.38089
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.011e+01 4.800e-02 210.696 < 2e-16 ***
datos_ventas$tiempo 3.102e-02 4.263e-03 7.277 1.12e-10 ***
datos_ventas$tiempo2 -3.127e-04 1.018e-04 -3.070 0.00281 **
datos_ventas$tiempo3 5.161e-06 6.903e-07 7.476 4.35e-11 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.113 on 92 degrees of freedom
Multiple R-squared: 0.9924, Adjusted R-squared: 0.9922
F-statistic: 4013 on 3 and 92 DF, p-value: < 2.2e-16Todos los coeficientes son estadísticamente significativos y la tendencia explica casi toda la variación en log_ventas, R-Cuadrado: 0.9924.
Guardamos las estimaciones para graficar:
datos_ventas <- datos_ventas %>%
mutate(tendencia = modelo_1$coefficients[1,1] + modelo_1$coefficients[2,1]*tiempo + modelo_1$coefficients[3,1]*tiempo2 + modelo_1$coefficients[4,1]*tiempo3 )ggplot(datos_ventas, aes(x = indice_tiempo)) +
geom_line(aes(y = log_ventas, color = "Ventas"), linewidth = 1) +
geom_line(aes(y = tendencia, color = "Tendencia"), linewidth = 1) +
labs(x = "Tiempo",
y = "Log natural de ventas a precios corrientes",
title = "Serie de Ln(Ventas) con Tendencia",
color = "Series") +
theme_minimal() +
scale_color_manual(values = c("Ventas" = "steelblue", "Tendencia" = "red"))
Desestacionalización
El siguiente paso es agregar variables binarias que capten estacionalidades en la serie, en este caso picos de venta en el mes de diciembre. Por ende tenemos que crear una variable “diciembre” que tome valor 1 cuando sea diciembre y 0 en caso contrario.
datos_ventas <- datos_ventas %>%
mutate(diciembre = ifelse(str_detect(tiempo_mensual, "dic\\."), 1, 0))Y ahora lo añadimos a la regresión y volvemos a graficar
modelo_2 <- summary(lm(datos_ventas$log_ventas ~ datos_ventas$tiempo + datos_ventas$tiempo2 + datos_ventas$tiempo3 + datos_ventas$diciembre))
modelo_2
Call:
lm(formula = datos_ventas$log_ventas ~ datos_ventas$tiempo +
datos_ventas$tiempo2 + datos_ventas$tiempo3 + datos_ventas$diciembre)
Residuals:
Min 1Q Median 3Q Max
-0.31438 -0.05368 -0.00846 0.03600 0.34574
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.012e+01 4.263e-02 237.295 < 2e-16 ***
datos_ventas$tiempo 2.936e-02 3.800e-03 7.725 1.41e-11 ***
datos_ventas$tiempo2 -2.719e-04 9.080e-05 -2.995 0.00353 **
datos_ventas$tiempo3 4.877e-06 6.156e-07 7.922 5.54e-12 ***
datos_ventas$diciembre 1.888e-01 3.728e-02 5.065 2.12e-06 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.1004 on 91 degrees of freedom
Multiple R-squared: 0.9941, Adjusted R-squared: 0.9938
F-statistic: 3823 on 4 and 91 DF, p-value: < 2.2e-16datos_ventas <- datos_ventas %>%
mutate(tend_estac = modelo_2$coefficients[1,1] + modelo_2$coefficients[2,1]*tiempo + modelo_2$coefficients[3,1]*tiempo2 + modelo_2$coefficients[4,1]*tiempo3 + modelo_2$coefficients[5,1]*diciembre )ggplot(datos_ventas, aes(x = indice_tiempo)) +
geom_line(aes(y = log_ventas, color = "Ventas"), linewidth = 1) +
geom_line(aes(y = tend_estac, color = "Tendencia + Estacionalidad"), linewidth = 1) +
labs(x = "Tiempo",
y = "Log natural de ventas a precios corrientes",
title = "Serie de Ln(Ventas) con Tendencia y Estacionalidad",
color = "Series") +
theme_minimal() +
scale_color_manual(values = c("Ventas" = "steelblue", "Tendencia + Estacionalidad" = "red")) +
theme(legend.position = "bottom")
Bien, no está mal lo hecho hasta ahora pero… ¿lo podemos hacer mejor?
Correcciones
En el último gráfico se ve que, aún con el modelo de tendencia + estacionalidad esbozado, no se termina de captar bien la tendencia en el último tramo de la secuencia. Esto refuerza la idea de que hubo un cambio de tendencia con el cambio de administración que deberíamos reflejarlo en nuestro modelo.
Para ello podemos generar una nueva variable binaria correspondiente al nuevo mandato gubernamental, NewGov, y formar un termino de interaccion con el tiempo para pensar en un salto en diciembre de 2023 acompañado de una tendencia lineal (que a simple vista es lo que se deduce corresponde al nuevo comportamiento).
datos_ventas <- datos_ventas %>%
mutate(NewGov = ifelse(tiempo>=84, 1, 0))
datos_ventas <- datos_ventas %>%
mutate(tiempo_NewGov = tiempo*NewGov)modelo_corr <- summary(lm(datos_ventas$log_ventas ~ datos_ventas$tiempo + datos_ventas$tiempo2 + datos_ventas$tiempo3 + datos_ventas$diciembre + datos_ventas$NewGov + datos_ventas$tiempo_NewGov))
modelo_corr
Call:
lm(formula = datos_ventas$log_ventas ~ datos_ventas$tiempo +
datos_ventas$tiempo2 + datos_ventas$tiempo3 + datos_ventas$diciembre +
datos_ventas$NewGov + datos_ventas$tiempo_NewGov)
Residuals:
Min 1Q Median 3Q Max
-0.144936 -0.041725 -0.002675 0.035105 0.216066
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.009e+01 2.924e-02 345.075 < 2e-16 ***
datos_ventas$tiempo 3.262e-02 2.998e-03 10.882 < 2e-16 ***
datos_ventas$tiempo2 -3.516e-04 8.258e-05 -4.257 5.11e-05 ***
datos_ventas$tiempo3 5.322e-06 6.461e-07 8.237 1.41e-12 ***
datos_ventas$diciembre 1.767e-01 2.369e-02 7.456 5.60e-11 ***
datos_ventas$NewGov 4.652e+00 5.303e-01 8.773 1.11e-13 ***
datos_ventas$tiempo_NewGov -5.042e-02 6.213e-03 -8.116 2.51e-12 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.06366 on 89 degrees of freedom
Multiple R-squared: 0.9977, Adjusted R-squared: 0.9975
F-statistic: 6357 on 6 and 89 DF, p-value: < 2.2e-16Añadimos los nuevos terminos a la regresión y volvemos a graficar:
datos_ventas <- datos_ventas %>%
mutate(tend_estac_corr = modelo_corr$coefficients[1,1] + modelo_corr$coefficients[2,1]*tiempo + modelo_corr$coefficients[3,1]*tiempo2 + modelo_corr$coefficients[4,1]*tiempo3 + modelo_corr$coefficients[5,1]*diciembre + modelo_corr$coefficients[6,1]*NewGov + modelo_corr$coefficients[7,1]*tiempo_NewGov)ggplot(datos_ventas, aes(x = indice_tiempo)) +
geom_line(aes(y = log_ventas, color = "Ventas"), linewidth = 1) +
geom_line(aes(y = tend_estac_corr, color = "Tendencia + Estacionalidad"), linewidth = 1) +
labs(x = "Tiempo",
y = "Log natural de ventas a precios corrientes",
title = "Serie de Ln(Ventas) con Tendencia y Estacionalidad",
color = "Series") +
theme_minimal() +
scale_color_manual(values = c("Ventas" = "steelblue", "Tendencia + Estacionalidad" = "red")) +
theme(legend.position = "bottom")
Mucho mejor!
Ciclo
El último componente faltante necesario para hacer un buen pronóstico es el ciclo. Para modelar el ciclo obtenemos los residuos de la última regresión con tendencia y estacionalidad incorporadas y encontramos el modelo AR(q) que mejor se adecúe. En este caso el mejor modelo hallado fue uno con 4 rezagos (lags de uno, tres, seis, siete y diez meses).
Guardamos los residuos:
datos_ventas$residuos <- residuals(modelo_corr)ggplot(datos_ventas, aes(x = indice_tiempo)) +
geom_line(aes(y = residuos), linewidth = 1, color="blue") +
geom_hline(yintercept = 0, linewidth = 0.5, color = "black", linetype = "solid") +
labs(x = "Tiempo",
y = "Residuos",
title = "Reisudos del modelo") +
theme_minimal()
Guardamos asimismo los rezagos de los residuos:
datos_ventas <- datos_ventas %>%
mutate(
residuos_rezago_1 = lag(residuos, 1), # Rezago de 1 periodo
residuos_rezago_3 = lag(residuos, 3), # Rezago de 3 periodos
residuos_rezago_6 = lag(residuos, 6), # Rezago de 6 periodos
residuos_rezago_7 = lag(residuos, 7) # Rezago de 7 periodos
)Modelamos el ciclo con la regresión de los residuos contra los rezagos (aquellos estadísticamente significativos a un nivel de confianza del 90%):
ciclo <- summary(lm(residuos ~ residuos_rezago_1 + residuos_rezago_3 + residuos_rezago_6 + residuos_rezago_7, data = datos_ventas))
ciclo
Call:
lm(formula = residuos ~ residuos_rezago_1 + residuos_rezago_3 +
residuos_rezago_6 + residuos_rezago_7, data = datos_ventas)
Residuals:
Min 1Q Median 3Q Max
-0.202256 -0.027833 0.003788 0.033415 0.160161
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.002180 0.005705 -0.382 0.7033
residuos_rezago_1 0.450440 0.097882 4.602 1.47e-05 ***
residuos_rezago_3 0.172419 0.101195 1.704 0.0921 .
residuos_rezago_6 -0.277792 0.106747 -2.602 0.0109 *
residuos_rezago_7 0.228038 0.104891 2.174 0.0325 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.05379 on 84 degrees of freedom
(7 observations deleted due to missingness)
Multiple R-squared: 0.2825, Adjusted R-squared: 0.2483
F-statistic: 8.269 on 4 and 84 DF, p-value: 1.132e-05Modelo Tendencia-Cico-Estacionalidad Listo para Pronósticos
modelo_ok <- summary(lm(log_ventas ~ residuos_rezago_1 + residuos_rezago_3 + residuos_rezago_6 + residuos_rezago_7 + tiempo + tiempo2 + tiempo3 + diciembre + NewGov + tiempo_NewGov, data = datos_ventas))
modelo_ok
Call:
lm(formula = log_ventas ~ residuos_rezago_1 + residuos_rezago_3 +
residuos_rezago_6 + residuos_rezago_7 + tiempo + tiempo2 +
tiempo3 + diciembre + NewGov + tiempo_NewGov, data = datos_ventas)
Residuals:
Min 1Q Median 3Q Max
-0.192080 -0.030122 0.005859 0.029847 0.167231
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 9.962e+00 5.128e-02 194.274 < 2e-16 ***
residuos_rezago_1 3.919e-01 1.020e-01 3.842 0.000247 ***
residuos_rezago_3 1.652e-01 1.088e-01 1.518 0.132955
residuos_rezago_6 -2.448e-01 1.087e-01 -2.251 0.027185 *
residuos_rezago_7 2.682e-01 1.068e-01 2.510 0.014137 *
tiempo 4.332e-02 4.380e-03 9.890 2.05e-15 ***
tiempo2 -6.040e-04 1.069e-04 -5.650 2.51e-07 ***
tiempo3 7.098e-06 7.757e-07 9.151 5.49e-14 ***
diciembre 1.842e-01 2.121e-02 8.687 4.37e-13 ***
NewGov 5.277e+00 5.061e-01 10.426 < 2e-16 ***
tiempo_NewGov -5.845e-02 5.994e-03 -9.751 3.81e-15 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.05347 on 78 degrees of freedom
(7 observations deleted due to missingness)
Multiple R-squared: 0.9984, Adjusted R-squared: 0.9982
F-statistic: 4773 on 10 and 78 DF, p-value: < 2.2e-16datos_ventas <- datos_ventas %>%
mutate(log_pronostico = modelo_ok$coefficients[1,1] + modelo_ok$coefficients[2,1]*residuos_rezago_1 + modelo_ok$coefficients[3,1]*residuos_rezago_3 + modelo_ok$coefficients[4,1]*residuos_rezago_6 + modelo_ok$coefficients[5,1]*residuos_rezago_7 + modelo_ok$coefficients[6,1]*tiempo + modelo_ok$coefficients[7,1]*tiempo2 + modelo_ok$coefficients[8,1]*tiempo3 + modelo_ok$coefficients[9,1]*diciembre + modelo_ok$coefficients[10,1]*NewGov + modelo_ok$coefficients[11,1]*tiempo_NewGov)ggplot(datos_ventas, aes(x = indice_tiempo)) +
geom_line(aes(y = log_ventas, color = "Ln(Ventas)"), linewidth = 1) +
geom_line(aes(y = log_pronostico, color = "Ln(Pronostico)"), linewidth = 1) +
labs(x = "Tiempo",
y = "Log natural de ventas a precios corrientes",
title = "Serie de Ln(Ventas) con Tendencia, Ciclo y Estacionalidad",
color = "Series") +
theme_minimal() +
scale_color_manual(values = c("Ln(Ventas)" = "steelblue", "Ln(Pronostico)" = "red")) +
theme(legend.position = "bottom")Warning: Removed 7 rows containing missing values or values outside the scale range
(`geom_line()`).
Pronóstico (Forecasting) - Estimación Puntual
Creamos una nueva fila (vacía) para enero de 2025 y la incorporamos:
nueva_fila <- data.frame(matrix(NA, nrow = 1, ncol = ncol(datos_ventas)))
colnames(nueva_fila) <- colnames(datos_ventas)
datos_ventas <- rbind(datos_ventas, nueva_fila)Insertamos en la nueva fila los valores para enero de 2025 necesarios para pronosticar:
datos_ventas$residuos_rezago_1[97] <- datos_ventas$residuos[96]
datos_ventas$residuos_rezago_3[97] <- datos_ventas$residuos[94]
datos_ventas$residuos_rezago_6[97] <- datos_ventas$residuos[91]
datos_ventas$residuos_rezago_7[97] <- datos_ventas$residuos[90]
datos_ventas$tiempo[97] <- 97
datos_ventas$tiempo2[97] <- 97^2
datos_ventas$tiempo3[97] <- 97^3
datos_ventas$diciembre[97] <- 0
datos_ventas$NewGov[97] <- 1
datos_ventas$tiempo_NewGov[97] <- 97Calculamos y almacenamos el ln(pronóstico) para enero de 2025:
datos_ventas$log_pronostico[97] <- modelo_ok$coefficients[1,1] + modelo_ok$coefficients[2,1]*datos_ventas$residuos_rezago_1[97] + modelo_ok$coefficients[3,1]*datos_ventas$residuos_rezago_3[97] + modelo_ok$coefficients[4,1]*datos_ventas$residuos_rezago_6[97] + modelo_ok$coefficients[5,1]*datos_ventas$residuos_rezago_7[97] + modelo_ok$coefficients[6,1]*datos_ventas$tiempo[97] + modelo_ok$coefficients[7,1]*datos_ventas$tiempo2[97] + modelo_ok$coefficients[8,1]*datos_ventas$tiempo3[97] + modelo_ok$coefficients[9,1]*datos_ventas$diciembre[97] + modelo_ok$coefficients[10,1]*datos_ventas$NewGov[97] + modelo_ok$coefficients[11,1]*datos_ventas$tiempo_NewGov[97]Para calcular las ventas a precios corrientes pronosticadas para enero de 2025 no se puede simplemente usar la función inversa exponenciando log_pronostico, sino qu se debe primero hacer la regresión de ventas_precios_corrientes sobre exp(log_pronostico y multiplicar exp(log_pronostico) por este coeficiente para así obtener el pronóstico final.
datos_ventas <- datos_ventas %>%
mutate(exp_log_pronostico = exp(log_pronostico))coeficiente_ajuste <- summary(lm(ventas_precios_corrientes ~ exp_log_pronostico, data = datos_ventas))$coefficients[2,1]
coeficiente_ajuste[1] 0.9911468Pronóstico de un paso hacia adelante para enero de 2025:
pronóstico_enero2025 <- coeficiente_ajuste*datos_ventas$exp_log_pronostico[97]
pronóstico_enero2025
2048397 Dado que, según el recurso del Dataset original, las ventas están medidas en millones de pesos, se pronostica que para el mes de enero las ventas en supermercados (a precios corrientes) sean por un total de 2.048.397 millones de pesos.
datos_ventas <- datos_ventas %>%
mutate(pronostico_ventas = coeficiente_ajuste*exp_log_pronostico)
datos_ventas$pronostico_ventas[97] <- pronóstico_enero2025
datos_ventas$pronostico_ventas[97]
2048397 ggplot(datos_ventas, aes(x = tiempo)) +
geom_line(aes(y = log_ventas, color = "Ln(Ventas)"), linewidth = 1) +
geom_line(aes(y = log_pronostico, color = "Ln(Pronostico)"), linewidth = 1) +
labs(x = "Tiempo",
y = "Log natural de ventas a precios corrientes",
title = "Pronóstico de Ln(Ventas)",
color = "Series") +
theme_minimal() +
scale_color_manual(values = c("Ln(Ventas)" = "steelblue", "Ln(Pronostico)" = "red")) +
theme(legend.position = "bottom")Warning: Removed 1 row containing missing values or values outside the scale range
(`geom_line()`).Warning: Removed 7 rows containing missing values or values outside the scale range
(`geom_line()`).
ggplot(datos_ventas, aes(x = tiempo)) +
geom_line(aes(y = ventas_precios_corrientes, color = "Ventas"), linewidth = 1) +
geom_line(aes(y = pronostico_ventas, color = "Pronóstico de Ventas"), linewidth = 1) +
labs(x = "Tiempo",
y = "Ventas",
title = "Pronóstico de Ventas",
color = "Series") +
theme_minimal() +
scale_color_manual(values = c("Ventas" = "steelblue", "Pronóstico de Ventas" = "red")) +
theme(legend.position = "bottom")Warning: Removed 1 row containing missing values or values outside the scale range
(`geom_line()`).Warning: Removed 7 rows containing missing values or values outside the scale range
(`geom_line()`).
Pronóstico (Forecasting) - Estimación por Intervalo
Además, se puede también hacer un intervalo de confianza al nivel de confianza que deseemos para determinar un rango probable para el monto de ventas que efectivamente se va a observar en la realidad.
Para ello sólo tenemos que obtener el error estándar de predicción. Este último lo podemos obtener indirectamente al hacer la regresión de log_pronostico con respecto a los valores específicos de las variables explicativas. Así, el intercepto será el pronóstico ya obtenido y el error estándar del estimador del intercepto será el error estándar del pronóstico. Con sumar el error estándar del error será suficiente para estimar un intervalo de confianza para las ventas del siguiente mes.
Centramos los regresores en los valores específicos:
datos_ventas <- datos_ventas %>%
mutate(residuos_rezago_1_ene25 = residuos_rezago_1 - -0.0622779694)
datos_ventas <- datos_ventas %>%
mutate(residuos_rezago_3_ene25 = residuos_rezago_3 - -0.0381012517)
datos_ventas <- datos_ventas %>%
mutate(residuos_rezago_6_ene25 = residuos_rezago_6 - 0.0563119301)
datos_ventas <- datos_ventas %>%
mutate(residuos_rezago_7_ene25 = residuos_rezago_7 - 0.0701142691)
datos_ventas <- datos_ventas %>%
mutate(tiempo_ene25 = tiempo - tiempo[97])
datos_ventas <- datos_ventas %>%
mutate(tiempo2_ene25 = tiempo2 - tiempo2[97])
datos_ventas <- datos_ventas %>%
mutate(tiempo3_ene25 = tiempo3 - tiempo3[97])
datos_ventas <- datos_ventas %>%
mutate(diciembre_ene25 = diciembre - 0)
datos_ventas <- datos_ventas %>%
mutate(NewGov_ene25 = NewGov - 1)
datos_ventas <- datos_ventas %>%
mutate(tiempo_NewGov_ene25 = tiempo_NewGov - 97)Corremos la regresión (nos interesa el intercepto y su error estándar):
summary(lm(log_ventas ~ residuos_rezago_1_ene25 + residuos_rezago_3_ene25 + residuos_rezago_6_ene25 + residuos_rezago_7_ene25 + tiempo_ene25 + tiempo2_ene25 + tiempo3_ene25 + diciembre_ene25 + NewGov_ene25 + tiempo_NewGov_ene25, data = datos_ventas))
Call:
lm(formula = log_ventas ~ residuos_rezago_1_ene25 + residuos_rezago_3_ene25 +
residuos_rezago_6_ene25 + residuos_rezago_7_ene25 + tiempo_ene25 +
tiempo2_ene25 + tiempo3_ene25 + diciembre_ene25 + NewGov_ene25 +
tiempo_NewGov_ene25, data = datos_ventas)
Residuals:
Min 1Q Median 3Q Max
-0.192080 -0.030122 0.005859 0.029847 0.167231
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.454e+01 3.313e-02 438.867 < 2e-16 ***
residuos_rezago_1_ene25 3.919e-01 1.020e-01 3.842 0.000247 ***
residuos_rezago_3_ene25 1.652e-01 1.088e-01 1.518 0.132955
residuos_rezago_6_ene25 -2.448e-01 1.087e-01 -2.251 0.027185 *
residuos_rezago_7_ene25 2.682e-01 1.068e-01 2.510 0.014137 *
tiempo_ene25 4.332e-02 4.380e-03 9.890 2.05e-15 ***
tiempo2_ene25 -6.040e-04 1.069e-04 -5.650 2.51e-07 ***
tiempo3_ene25 7.098e-06 7.757e-07 9.151 5.49e-14 ***
diciembre_ene25 1.842e-01 2.121e-02 8.687 4.37e-13 ***
NewGov_ene25 5.277e+00 5.061e-01 10.426 < 2e-16 ***
tiempo_NewGov_ene25 -5.845e-02 5.994e-03 -9.751 3.81e-15 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.05347 on 78 degrees of freedom
(8 observations deleted due to missingness)
Multiple R-squared: 0.9984, Adjusted R-squared: 0.9982
F-statistic: 4773 on 10 and 78 DF, p-value: < 2.2e-16El intercepto es exactamente el log_pronóstico obtenido antes para enero de 2025 (14.54146). No obstante, ahora contamos con el error estándar del log_pronóstico que es igual a 0
Si además computamos el error estándar del error podemos construir un intervalo de confianza para el verdadero monto de ventas. El error estándar del error es, según el summary corrido, 0.05347.
ee_ln_ventas_ene25 <- sqrt((0.03313^2) + (0.05347^2))
ee_ln_ventas_ene25[1] 0.06290181Intervalo de confianza al 95% para una distribución t de student con 78 grados de libertad:
limite_inferior_ln <- 14.54146 - qt(0.975, 78)*ee_ln_ventas_ene25
limite_superior_ln <- 14.54146 + qt(0.975, 78)*ee_ln_ventas_ene25
c(limite_inferior_ln, limite_superior_ln)[1] 14.41623 14.66669Expresado en terminos de ventas nominales:
limite_inferior <- coeficiente_ajuste*exp(limite_inferior_ln)
limite_superior <- coeficiente_ajuste*exp(limite_superior_ln)
c(limite_inferior, limite_superior)[1] 1807291 2321665El intervalo estimado para las ventas a precios corrientes en supermercados, con un 95% de nivel de confianza, es (1.807.291, 2.321.665), en millones de pesos.
De esta manera hemos visto con este ejemplo cómo podemos obtener un pronóstico puntual y un intervalo de pronóstico para la serie que queramos.