Actividad 2. Generación de escenarios futuros con modelos de pronósticos en series de tiempo | A00833172

Generación de escenarios futuros con modelos de pronósticos en series de tiempo

Ejemplo en clase Población

(Lunes 17)

## Librerias
library(forecast)
library(tidyverse)
library(ggplot2)

Importar base de datos (población)

#file.choose()
bdpob <- read_csv("/Users/genarorodriguezalcantara/Desktop/Tec/Generacion de escenarios futuros con analítica (Gpo 101)/PIB/M1 - Actividad 2/population.csv")

Analisis Descriptivo

summary(bdpob)

##     state                year        population      
##  Length:6020        Min.   :1900   Min.   :   43000  
##  Class :character   1st Qu.:1930   1st Qu.:  901483  
##  Mode  :character   Median :1960   Median : 2359000  
##                     Mean   :1960   Mean   : 3726003  
##                     3rd Qu.:1990   3rd Qu.: 4541883  
##                     Max.   :2019   Max.   :39512223

str(bdpob)

## spc_tbl_ [6,020 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ state     : chr [1:6020] "AK" "AK" "AK" "AK" ...
##  $ year      : num [1:6020] 1950 1951 1952 1953 1954 ...
##  $ population: num [1:6020] 135000 158000 189000 205000 215000 222000 224000 231000 224000 224000 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   state = col_character(),
##   ..   year = col_double(),
##   ..   population = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>

head(bdpob)

## # A tibble: 6 × 3
##   state  year population
##   <chr> <dbl>      <dbl>
## 1 AK     1950     135000
## 2 AK     1951     158000
## 3 AK     1952     189000
## 4 AK     1953     205000
## 5 AK     1954     215000
## 6 AK     1955     222000

Serie de tiempo en Texas

poblacion_texas <- bdpob %>% filter(state=="TX")
ggplot(poblacion_texas, aes(x=year, y=population)) +
        geom_line() +
        labs(title="Poblacion Texas", x = "Año", y = "Población")

ts_texas <- ts(poblacion_texas$population, start = 1900, frequency = 1) #ts anual

# ts trimestral 
#ts_texas <- ts(poblaciomn_texas$population, start=c(1900, 4), frequency=4)

# ts mensual 
#ts_texas <- ts(poblaciomn_texas$population, start=c(1900, 8), frequency=12)

arima_texas <- auto.arima(ts_texas)
summary(ts_texas)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  3055000  5823500  9514500 11825205 16866230 28995881

pronostico_texas <- forecast(arima_texas, level=95, h=10)
plot(pronostico_texas, main="Población en Texas")

Ejercicio en clase: Mapa

Librerias

library(forecast)
library(tidyverse)
library(ggplot2)
library(maps)
library(leaflet)

Crear Mapa Inicial

# crear mapa de EUA por decada, con unngradiente verde-rojo de la poblacion por estado, desde 1950, 2050
#map(database="state")
#map(database="state", regions="Texas", col="darkred", fill=TRUE, add=TRUE)
#ap(database="state", regions="New York", col="darkgreen", fill=TRUE, add=TRUE)

Leche saborizada Hershey´s

Instalar paquetes y llamar librerias

library(forecast)
library(tidyverse)
library(ggplot2)
library(readxl)

Importar la base de datos

ventas <- read.csv("/Users/genarorodriguezalcantara/Desktop/Tec/Generacion de escenarios futuros con analítica (Gpo 101)/PIB/M1 - Actividad 2/Ventas_Históricas_Lechitas.csv")

Modelo AUTO.ARIMA

ts_ventas <- ts(ventas$Ventas, start = c(2017,1), frequency = 12)
autoplot(ts_ventas) + labs(title = "Ventas de leche saborizada Hersheys", x = "Tiempo", y = "Miles de dolares")

arima_ventas <- auto.arima(ts_ventas)
summary(arima_ventas)

## Series: ts_ventas 
## ARIMA(1,0,0)(1,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     sar1     drift
##       0.6383  -0.5517  288.8980
## s.e.  0.1551   0.2047   14.5025
## 
## sigma^2 = 202700:  log likelihood = -181.5
## AIC=371   AICc=373.11   BIC=375.72
## 
## Training set error measures:
##                    ME    RMSE      MAE        MPE      MAPE       MASE
## Training set 25.22163 343.863 227.1699 0.08059942 0.7069541 0.06491041
##                   ACF1
## Training set 0.2081043

pronostico_ventas <- forecast(arima_ventas, level = 95, h = 12) 
autoplot(pronostico_ventas, main = "Pronostico de ventas de leche saborizada Hersheys")

Modelo Regresión Lineal

ventas$mes <- 1:36
regresion_ventas <- lm(Ventas ~ mes, data = ventas)
summary(regresion_ventas)

## 
## Call:
## lm(formula = Ventas ~ mes, data = ventas)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2075.79  -326.41    33.74   458.41  1537.04 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 24894.67     275.03   90.52   <2e-16 ***
## mes           298.37      12.96   23.02   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 808 on 34 degrees of freedom
## Multiple R-squared:  0.9397, Adjusted R-squared:  0.9379 
## F-statistic: 529.8 on 1 and 34 DF,  p-value: < 2.2e-16

siguiente_anio <- data.frame(mes=37:48)
prediccion_regresion <- predict(regresion_ventas, siguiente_anio)
prediccion_regresion

##        1        2        3        4        5        6        7        8 
## 35934.49 36232.86 36531.23 36829.61 37127.98 37426.35 37724.73 38023.10 
##        9       10       11       12 
## 38321.47 38619.85 38918.22 39216.59

plot(ventas$mes, ventas$Ventas, main = "Pronóstico de ventas de Hersheys", xlab = "Tiempo", ylab = "Miles de dolares")
abline(regresion_ventas, col = "blue")
points(siguiente_anio$mes, prediccion_regresion, col = "red")

predicciones_reales <- predict(regresion_ventas, ventas)
MAPE <- mean(abs((ventas$Ventas - predicciones_reales)/ventas$Ventas))*100
MAPE

## [1] 2.011298

Conclusiones

El mejor modelo que se adapta a la serie es el SARIMA con un Mape de 0.71%, comparado con la Regresion Lineal que su MAPE es de 2.01%

Para el siguiente año, la proyección de ventas es la siguiente:

Mes y Año	Escenario Optimista	Escenario Esperado	Escenario Pesimista
Jan 2020	35498.90	34616.48	36381.32
Feb 2020	34202.17	33155.28	35249.05
Mar 2020	36703.01	35596.10	37809.92
Apr 2020	36271.90	35141.44	37402.36
May 2020	37121.98	35982.07	38261.90
Jun 2020	37102.65	35958.90	38246.40
Jul 2020	37151.04	36005.73	38296.34
Aug 2020	38564.64	37418.70	39710.58
Sep 2020	38755.22	37609.03	39901.42
Oct 2020	39779.02	38632.72	40925.32
Nov 2020	38741.63	37595.28	39887.97
Dec 2020	38645.86	37499.50	39792.22

ventasporanio <- read.csv("/Users/genarorodriguezalcantara/Desktop/Tec/Generacion de escenarios futuros con analítica (Gpo 101)/PIB/M1 - Actividad 2/ventas_por_anio.csv")
ggplot(ventasporanio, aes(x = mes,y= ventas, col=as.factor(anio), group=anio))+
  geom_line() + labs(title = "Ventas de Leche Saborizada Hershey's por Año", x="Mes", y= "Miles de Dólares")

Nuestra recomendación sería realizar campañas publicitarias para aumentar el consumo de leche saborizada Hershey’s en el primer semestre del año.