# Instalar paquetes y llamar librerías

#install.packages("forecast")
library(forecast)
library(readxl)

Ejemplo Producción 1.

Contexto

Una serie de tiempo es una colección de observaciones sobre un determinado fenomeno efectuadas en momentos de tiempo sucesivos, usualmente equiespaciados.

Ejemplos de series de tiempo: 1. Precio de acciones 2. Nieveles de inventario 3. Rotación de personal 4. Ventas 5. PIB (GDP)

Crear la serie de tiempo

Ejemplo: los siguientes datos de producción trimestral inician en el primer trimestre de 2020. Se busca pronosticar la producción de los siguientes 5 trimestres

produccion <- c(50,53,55,57,55,60)
st_produccion <- ts(data=produccion, start = c(2020,1), frequency = 4) #En este caso, la serie de tiempo inicia en 2020, en el 1er trimestre

#MENSUAL: st_produccion <- ts(data=produccion, start = c(2020,1), frequency = 12) #En este caso, la serie de tiempo inicia en 2020, en el 1er mes
#MENSUAL: st_produccion <- ts(data=produccion, start = c(2020,8), frequency = 12) #En este caso, la serie de tiempo inicia en 2020, en el 8vo mes
#ANUAL: st_produccion <- ts(data=produccion, start = c(2020), frequency = 12 #En este caso, la serie de tiempo inicia en 2020

Crear el modelo ARIMA

ARIMA significa Modelo Autoregresivo integrado de promedio movil, en inglés.

modelo_produccion <- auto.arima(st_produccion, D=1) # D: diferenciacion estacional
modelo_produccion
## Series: st_produccion 
## ARIMA(0,0,0)(0,1,0)[4] with drift 
## 
## Coefficients:
##        drift
##       1.5000
## s.e.  0.1768
## 
## sigma^2 = 2.01:  log likelihood = -2.84
## AIC=9.68   AICc=-2.32   BIC=7.06
summary(modelo_produccion)
## Series: st_produccion 
## ARIMA(0,0,0)(0,1,0)[4] with drift 
## 
## Coefficients:
##        drift
##       1.5000
## s.e.  0.1768
## 
## sigma^2 = 2.01:  log likelihood = -2.84
## AIC=9.68   AICc=-2.32   BIC=7.06
## 
## Training set error measures:
##                      ME      RMSE       MAE        MPE      MAPE       MASE
## Training set 0.03333332 0.5787923 0.3666667 0.03685269 0.6429133 0.06111111
##                    ACF1
## Training set -0.5073047
# Al comparar modelos, seleccionamos el que tenga el menor MAPE (Porcentaje de error promedio absoluto)

Generar el Pronostico

pronostico_produccion <- forecast(modelo_produccion, level=c(95), h=5)
#Si no nos dicen otra cosa, el nivel de confiabilidad es 95%. Los periodos a pronosticar es h.
pronostico_produccion
##         Point Forecast    Lo 95    Hi 95
## 2021 Q3             61 58.22127 63.77873
## 2021 Q4             63 60.22127 65.77873
## 2022 Q1             61 58.22127 63.77873
## 2022 Q2             66 63.22127 68.77873
## 2022 Q3             67 63.07028 70.92972
plot(pronostico_produccion)

Ejercicio 1. México rumbo al 2050

En equipos de 2 o 3, seleccionar un estado de México, obtener los datos historicos de su población, generar un pronostico hasta 2050.

poblacion <- c(720753,906063,1229576,1757530,3050442,4870876,6874165,8831079,8235744,8605239,8851080,9209944)
st_poblacion <- ts(data=poblacion, start = c(1910), frequency = .1) #En este caso la serie inicia en 1910 y va a ser anualmente
modelo_poblacion <- auto.arima(st_poblacion, D=1) # D: diferenciacion estacional
modelo_poblacion
## Series: st_poblacion 
## ARIMA(0,1,0) with drift 
## 
## Coefficients:
##          drift
##       771744.6
## s.e.  246886.1
## 
## sigma^2 = 7.375e+11:  log likelihood = -165.38
## AIC=334.76   AICc=336.26   BIC=335.56
summary(modelo_poblacion)
## Series: st_poblacion 
## ARIMA(0,1,0) with drift 
## 
## Coefficients:
##          drift
##       771744.6
## s.e.  246886.1
## 
## sigma^2 = 7.375e+11:  log likelihood = -165.38
## AIC=334.76   AICc=336.26   BIC=335.56
## 
## Training set error measures:
##                     ME     RMSE      MAE       MPE     MAPE     MASE      ACF1
## Training set -4.249297 783937.7 664432.7 -6.400298 18.05876 0.126273 0.3933874
pronostico_poblacion <- forecast(modelo_poblacion, level=c(95), h=3)
#Si no nos dicen otra cosa, el nivel de confiabilidad es 95%. Los periodos a pronosticar es h.
pronostico_poblacion
##      Point Forecast   Lo 95    Hi 95
## 2030        9981689 8298548 11664829
## 2040       10753433 8373114 13133753
## 2050       11525178 8609894 14440462
plot(pronostico_poblacion)

Ejercicio 2. Aplicación de shiny

Agregar una pestaña en la aplicación de shiny con el ejercicio Mexico rumbo al 2050. En el menú se debe seleccionar la cantidad de años a pronosticar Aplicación de shiny

Ejercicio 3.

  1. fue una introduccion de negocios donde vimos kpi, pestel
  2. aprendi de estados financieros, balance general
  3. Aprendi a usar minitab
  4. Aqui hicimos un video
  5. Aprendimos sobre mercadotecnia
  6. Aqui nos dieron un proyecto y vimos sobre tir y vpn 7.Este fue mi primer acercamiento a R 8.Aqui aprendimos sobre machine learning 9.la introduccion al servicio social: aqui fue el primer acercamiento al servicio social
  7. Inteligencia artificial enfocada a los negocios: fue un semestre donde aplicamos varios modelos de machine learning

Actividad 2. Hersheys

## Crear la serie de tiempo

ventas <- read_excel( "C:\\Users\\admin\\Downloads\\Ventas_Históricas_Lechitas.xlsx")
str(ventas)
## tibble [35 × 1] (S3: tbl_df/tbl/data.frame)
##  $ 25520.511307767953: num [1:35] 23740 26254 25868 27073 27150 ...
st_ventas <- ts(data=ventas, start = c(2017,1), frequency = 12)

Crear el modelo ARIMA

modelo_ventas <- auto.arima(st_ventas)
modelo_ventas
## Series: st_ventas 
## ARIMA(1,0,0)(0,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     drift
##       0.6984  287.1607
## s.e.  0.1408   26.9208
## 
## sigma^2 = 282406:  log likelihood = -176.25
## AIC=358.49   AICc=359.76   BIC=361.9
summary(modelo_ventas)
## Series: st_ventas 
## ARIMA(1,0,0)(0,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     drift
##       0.6984  287.1607
## s.e.  0.1408   26.9208
## 
## sigma^2 = 282406:  log likelihood = -176.25
## AIC=358.49   AICc=359.76   BIC=361.9
## 
## Training set error measures:
##                    ME     RMSE      MAE        MPE      MAPE       MASE
## Training set 13.98205 411.6355 268.5098 0.05077429 0.8297318 0.07619582
##                   ACF1
## Training set 0.2097495

Generar el Pronostico

pronostico_ventas <- forecast (modelo_ventas, level = c(95), h=12)
pronostico_ventas
##          Point Forecast    Lo 95    Hi 95
## Dec 2019       35534.09 34492.53 36575.65
## Jan 2020       34448.05 33177.60 35718.50
## Feb 2020       36622.79 35254.52 37991.06
## Mar 2020       36256.61 34843.07 37670.14
## Apr 2020       37352.89 35917.79 38787.98
## May 2020       37135.96 35690.46 38581.46
## Jun 2020       36325.84 34875.29 37776.38
## Jul 2020       37736.95 36283.95 39189.95
## Aug 2020       38574.10 37119.90 40028.29
## Sep 2020       39562.85 38108.07 41017.63
## Oct 2020       38234.56 36779.50 39689.63
## Nov 2020       38284.22 36829.02 39739.43
plot(pronostico_ventas)

LS0tDQp0aXRsZTogIkFDVDIiDQphdXRob3I6ICJSb2RyaWdvIEFuZ3VsbyBBMDA4MzQ2NjciDQpkYXRlOiAiMjAyNS0wOC0xNCINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFIA0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogY2VydWxlYW4NCi0tLQ0KDQohW10oaHR0cHM6Ly9lbmNyeXB0ZWQtdGJuMC5nc3RhdGljLmNvbS9pbWFnZXM/cT10Ym46QU5kOUdjU2IwZzZpd1FhcXItYW5Zb0tpSncwNnBwWGc5YTdQdzB1ZV9BJnMpDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyIgPiBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzIDwvc3Bhbj4NCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQojaW5zdGFsbC5wYWNrYWdlcygiZm9yZWNhc3QiKQ0KbGlicmFyeShmb3JlY2FzdCkNCmxpYnJhcnkocmVhZHhsKQ0KYGBgDQoNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiID4gRWplbXBsbyBQcm9kdWNjacOzbiAxLiA8L3NwYW4+DQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyIgPiBDb250ZXh0byA8L3NwYW4+DQpVbmEgKipzZXJpZSBkZSB0aWVtcG8qKiBlcyB1bmEgY29sZWNjacOzbiBkZSBvYnNlcnZhY2lvbmVzIHNvYnJlIHVuIGRldGVybWluYWRvIGZlbm9tZW5vIGVmZWN0dWFkYXMgZW4gbW9tZW50b3MgZGUgdGllbXBvIHN1Y2VzaXZvcywgdXN1YWxtZW50ZSBlcXVpZXNwYWNpYWRvcy4NCg0KRWplbXBsb3MgZGUgc2VyaWVzIGRlIHRpZW1wbzoNCjEuIFByZWNpbyBkZSBhY2Npb25lcw0KMi4gTmlldmVsZXMgZGUgaW52ZW50YXJpbw0KMy4gUm90YWNpw7NuIGRlIHBlcnNvbmFsIA0KNC4gVmVudGFzDQo1LiBQSUIgKEdEUCkNCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7IiA+IENyZWFyIGxhIHNlcmllIGRlIHRpZW1wbyA8L3NwYW4+DQpFamVtcGxvOiBsb3Mgc2lndWllbnRlcyBkYXRvcyBkZSBwcm9kdWNjacOzbiB0cmltZXN0cmFsIGluaWNpYW4gZW4gZWwgcHJpbWVyIHRyaW1lc3RyZSBkZSAyMDIwLiBTZSBidXNjYSBwcm9ub3N0aWNhciBsYSBwcm9kdWNjacOzbiBkZSBsb3Mgc2lndWllbnRlcyA1IHRyaW1lc3RyZXMNCmBgYHtyfQ0KcHJvZHVjY2lvbiA8LSBjKDUwLDUzLDU1LDU3LDU1LDYwKQ0Kc3RfcHJvZHVjY2lvbiA8LSB0cyhkYXRhPXByb2R1Y2Npb24sIHN0YXJ0ID0gYygyMDIwLDEpLCBmcmVxdWVuY3kgPSA0KSAjRW4gZXN0ZSBjYXNvLCBsYSBzZXJpZSBkZSB0aWVtcG8gaW5pY2lhIGVuIDIwMjAsIGVuIGVsIDFlciB0cmltZXN0cmUNCg0KI01FTlNVQUw6IHN0X3Byb2R1Y2Npb24gPC0gdHMoZGF0YT1wcm9kdWNjaW9uLCBzdGFydCA9IGMoMjAyMCwxKSwgZnJlcXVlbmN5ID0gMTIpICNFbiBlc3RlIGNhc28sIGxhIHNlcmllIGRlIHRpZW1wbyBpbmljaWEgZW4gMjAyMCwgZW4gZWwgMWVyIG1lcw0KI01FTlNVQUw6IHN0X3Byb2R1Y2Npb24gPC0gdHMoZGF0YT1wcm9kdWNjaW9uLCBzdGFydCA9IGMoMjAyMCw4KSwgZnJlcXVlbmN5ID0gMTIpICNFbiBlc3RlIGNhc28sIGxhIHNlcmllIGRlIHRpZW1wbyBpbmljaWEgZW4gMjAyMCwgZW4gZWwgOHZvIG1lcw0KI0FOVUFMOiBzdF9wcm9kdWNjaW9uIDwtIHRzKGRhdGE9cHJvZHVjY2lvbiwgc3RhcnQgPSBjKDIwMjApLCBmcmVxdWVuY3kgPSAxMiAjRW4gZXN0ZSBjYXNvLCBsYSBzZXJpZSBkZSB0aWVtcG8gaW5pY2lhIGVuIDIwMjANCg0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyIgPiBDcmVhciBlbCBtb2RlbG8gQVJJTUEgPC9zcGFuPg0KKipBUklNQSoqIHNpZ25pZmljYSBNb2RlbG8gQXV0b3JlZ3Jlc2l2byBpbnRlZ3JhZG8gZGUgcHJvbWVkaW8gbW92aWwsIGVuIGluZ2zDqXMuDQpgYGB7cn0NCm1vZGVsb19wcm9kdWNjaW9uIDwtIGF1dG8uYXJpbWEoc3RfcHJvZHVjY2lvbiwgRD0xKSAjIEQ6IGRpZmVyZW5jaWFjaW9uIGVzdGFjaW9uYWwNCm1vZGVsb19wcm9kdWNjaW9uDQpzdW1tYXJ5KG1vZGVsb19wcm9kdWNjaW9uKQ0KIyBBbCBjb21wYXJhciBtb2RlbG9zLCBzZWxlY2Npb25hbW9zIGVsIHF1ZSB0ZW5nYSBlbCBtZW5vciBNQVBFIChQb3JjZW50YWplIGRlIGVycm9yIHByb21lZGlvIGFic29sdXRvKQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyIgPiBHZW5lcmFyIGVsIFByb25vc3RpY28gPC9zcGFuPg0KYGBge3J9DQpwcm9ub3N0aWNvX3Byb2R1Y2Npb24gPC0gZm9yZWNhc3QobW9kZWxvX3Byb2R1Y2Npb24sIGxldmVsPWMoOTUpLCBoPTUpDQojU2kgbm8gbm9zIGRpY2VuIG90cmEgY29zYSwgZWwgbml2ZWwgZGUgY29uZmlhYmlsaWRhZCBlcyA5NSUuIExvcyBwZXJpb2RvcyBhIHByb25vc3RpY2FyIGVzIGguDQpwcm9ub3N0aWNvX3Byb2R1Y2Npb24NCnBsb3QocHJvbm9zdGljb19wcm9kdWNjaW9uKQ0KDQpgYGANCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyIgPiBFamVyY2ljaW8gMS4gTcOpeGljbyBydW1ibyBhbCAyMDUwIDwvc3Bhbj4NCkVuIGVxdWlwb3MgZGUgMiBvIDMsIHNlbGVjY2lvbmFyIHVuIGVzdGFkbyBkZSBNw6l4aWNvLCBvYnRlbmVyIGxvcyBkYXRvcyBoaXN0b3JpY29zIGRlIHN1IHBvYmxhY2nDs24sIGdlbmVyYXIgdW4gcHJvbm9zdGljbyBoYXN0YSAyMDUwLg0KYGBge3J9DQpwb2JsYWNpb24gPC0gYyg3MjA3NTMsOTA2MDYzLDEyMjk1NzYsMTc1NzUzMCwzMDUwNDQyLDQ4NzA4NzYsNjg3NDE2NSw4ODMxMDc5LDgyMzU3NDQsODYwNTIzOSw4ODUxMDgwLDkyMDk5NDQpDQpzdF9wb2JsYWNpb24gPC0gdHMoZGF0YT1wb2JsYWNpb24sIHN0YXJ0ID0gYygxOTEwKSwgZnJlcXVlbmN5ID0gLjEpICNFbiBlc3RlIGNhc28gbGEgc2VyaWUgaW5pY2lhIGVuIDE5MTAgeSB2YSBhIHNlciBhbnVhbG1lbnRlDQptb2RlbG9fcG9ibGFjaW9uIDwtIGF1dG8uYXJpbWEoc3RfcG9ibGFjaW9uLCBEPTEpICMgRDogZGlmZXJlbmNpYWNpb24gZXN0YWNpb25hbA0KbW9kZWxvX3BvYmxhY2lvbg0Kc3VtbWFyeShtb2RlbG9fcG9ibGFjaW9uKQ0KDQpgYGANCmBgYHtyfQ0KcHJvbm9zdGljb19wb2JsYWNpb24gPC0gZm9yZWNhc3QobW9kZWxvX3BvYmxhY2lvbiwgbGV2ZWw9Yyg5NSksIGg9MykNCiNTaSBubyBub3MgZGljZW4gb3RyYSBjb3NhLCBlbCBuaXZlbCBkZSBjb25maWFiaWxpZGFkIGVzIDk1JS4gTG9zIHBlcmlvZG9zIGEgcHJvbm9zdGljYXIgZXMgaC4NCnByb25vc3RpY29fcG9ibGFjaW9uDQpwbG90KHByb25vc3RpY29fcG9ibGFjaW9uKQ0KYGBgDQoNCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyIgPiBFamVyY2ljaW8gMi4gQXBsaWNhY2nDs24gZGUgc2hpbnkgPC9zcGFuPg0KQWdyZWdhciB1bmEgcGVzdGHDsWEgZW4gbGEgYXBsaWNhY2nDs24gZGUgc2hpbnkgY29uIGVsIGVqZXJjaWNpbyBNZXhpY28gcnVtYm8gYWwgMjA1MC4gRW4gZWwgbWVuw7ogc2UgZGViZSBzZWxlY2Npb25hciBsYSBjYW50aWRhZCBkZSBhw7FvcyBhIHByb25vc3RpY2FyDQpbQXBsaWNhY2nDs24gZGUgc2hpbnldKGh0dHBzOi8vcm9kcmlnb2FuZ3Vsby5zaGlueWFwcHMuaW8vRU0yNS8pDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7IiA+IEVqZXJjaWNpbyAzLiA8L3NwYW4+DQoxLiBmdWUgdW5hIGludHJvZHVjY2lvbiBkZSBuZWdvY2lvcyBkb25kZSB2aW1vcyBrcGksIHBlc3RlbA0KMi4gYXByZW5kaSBkZSBlc3RhZG9zIGZpbmFuY2llcm9zLCBiYWxhbmNlIGdlbmVyYWwNCjMuIEFwcmVuZGkgYSB1c2FyIG1pbml0YWINCjQuIEFxdWkgaGljaW1vcyB1biB2aWRlbw0KNS4gQXByZW5kaW1vcyBzb2JyZSBtZXJjYWRvdGVjbmlhDQo2LiBBcXVpIG5vcyBkaWVyb24gdW4gcHJveWVjdG8geSB2aW1vcyBzb2JyZSB0aXIgeSB2cG4NCjcuRXN0ZSBmdWUgbWkgcHJpbWVyIGFjZXJjYW1pZW50byBhIFINCjguQXF1aSBhcHJlbmRpbW9zIHNvYnJlIG1hY2hpbmUgbGVhcm5pbmcNCjkubGEgaW50cm9kdWNjaW9uIGFsIHNlcnZpY2lvIHNvY2lhbDogYXF1aSBmdWUgZWwgcHJpbWVyIGFjZXJjYW1pZW50byBhbCBzZXJ2aWNpbyBzb2NpYWwNCjEwLiBJbnRlbGlnZW5jaWEgYXJ0aWZpY2lhbCBlbmZvY2FkYSBhIGxvcyBuZWdvY2lvczogZnVlIHVuIHNlbWVzdHJlIGRvbmRlIGFwbGljYW1vcyB2YXJpb3MgbW9kZWxvcyBkZSBtYWNoaW5lIGxlYXJuaW5nDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7IiA+IEFjdGl2aWRhZCAyLiBIZXJzaGV5cyA8L3NwYW4+DQohW10oaHR0cHM6Ly9taXItczMtY2RuLWNmLmJlaGFuY2UubmV0L3Byb2plY3RfbW9kdWxlcy8xNDAwL2EyZjBjMzk0MjY2NzY1LjVlN2JhMGMwMTBlMzEuZ2lmKQ0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7IiA+IENyZWFyIGxhIHNlcmllIGRlIHRpZW1wbyA8L3NwYW4+DQoNCmBgYHtyfQ0KdmVudGFzIDwtIHJlYWRfZXhjZWwoICJDOlxcVXNlcnNcXGFkbWluXFxEb3dubG9hZHNcXFZlbnRhc19IaXN0w7NyaWNhc19MZWNoaXRhcy54bHN4IikNCnN0cih2ZW50YXMpDQpzdF92ZW50YXMgPC0gdHMoZGF0YT12ZW50YXMsIHN0YXJ0ID0gYygyMDE3LDEpLCBmcmVxdWVuY3kgPSAxMikNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiID4gQ3JlYXIgZWwgbW9kZWxvIEFSSU1BIDwvc3Bhbj4NCg0KYGBge3J9DQptb2RlbG9fdmVudGFzIDwtIGF1dG8uYXJpbWEoc3RfdmVudGFzKQ0KbW9kZWxvX3ZlbnRhcw0Kc3VtbWFyeShtb2RlbG9fdmVudGFzKQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyIgPiBHZW5lcmFyIGVsIFByb25vc3RpY28gPC9zcGFuPg0KYGBge3J9DQpwcm9ub3N0aWNvX3ZlbnRhcyA8LSBmb3JlY2FzdCAobW9kZWxvX3ZlbnRhcywgbGV2ZWwgPSBjKDk1KSwgaD0xMikNCnByb25vc3RpY29fdmVudGFzDQpwbG90KHByb25vc3RpY29fdmVudGFzKQ0KYGBgDQoNCg==