App Shiny
Aplicacion
de Shiny
Link: hhttps://josemariamejia.shinyapps.io/RumboMexico/
Instalar paquetes
#install.packages("forecast")
library(forecast)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(readxl)
Ejemplo. Produccion
Contexto
Una serie de tiempo es una coleccion de
observacoines sobre un determinado fenomeno efectuadas en momentos de
tiempo sucesivos, usualmente equiespaciados.
Ejemplos de series de tiempo: 1. Precio de Acciones 2. Niveles de
Inventario 3. Rotación de Personal 4. Ventas 5. PIB (GDP)
Crear la serie de tiempo
Ejemplo. Los siguientes datos de produccion trimestral inician en el
primer trimestre del 2020. Se busca pronosticar la produccion de los
siguientes cinco 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 primer trimestre y son 4 trimestres.
Crear el modelo ARIMA
ARIMA significa Modelo Autorregresivo Integrado de
Promedio Movil en ingles.
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 confiabiliad 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. Mexico rumbo al 2050
En equipos de 2, seleccionar un estado de México, obtener los datos
históricos de su población, generar un pronóstico hasta 2050.
poblacion <- c(519000, 719659, 944285, 1184996, 1425607)
st_poblacion <- ts(data=poblacion, start= c(1980), frequency = 0.1 )
# En este caso la serie de tiempo inicia en 2020 en el primer trimestre y son 4 trimestres.
modelo_poblacion <- auto.arima(st_poblacion) # D: diferenciacion estacional
modelo_poblacion
## Series: st_poblacion
## ARIMA(0,1,0) with drift
##
## Coefficients:
## drift
## 226651.750
## s.e. 8186.441
##
## sigma^2 = 357445118: log likelihood = -44.49
## AIC=92.98 AICc=104.98 BIC=91.75
summary(modelo_poblacion)
## Series: st_poblacion
## ARIMA(0,1,0) with drift
##
## Coefficients:
## drift
## 226651.750
## s.e. 8186.441
##
## sigma^2 = 357445118: log likelihood = -44.49
## AIC=92.98 AICc=104.98 BIC=91.75
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 58.46962 14644.69 11265.87 -0.320879 1.209658 0.01175108 0.1992363
pronostico_poblacion <- forecast(modelo_poblacion, level=c(95), h=5)
# Si no nos dicen otra cosa, el nivel de confiabiliad es 95 los periodos a pronosticar es h
pronostico_poblacion
## Point Forecast Lo 95 Hi 95
## 2030 1652259 1615203 1689314
## 2040 1878910 1826506 1931315
## 2050 2105562 2041380 2169744
## 2060 2332214 2258103 2406325
## 2070 2558866 2476007 2641724
plot(pronostico_poblacion)

Ejercicio 2. Aplicación de Shiny
Agregar una pestaña en la aplicacion de Shiny con el ejercicio México
rumbo al 2050. En el menú se debe seleccionar la cantidad de años a
pronosticar.
Ejercicio 3. Aprendizajes mas
importantes
- Aprendí a desglosar un proyecto en sus puntos fuertes y débiles, y a
detectar oportunidades y amenazas.
- Aprendí a cuadrar activos, pasivos y capital, y a calcular
utilidades para saber si una empresa es rentable.
- Aprendí a usar medias, varianzas y pruebas de hipótesis para
respaldar decisiones con datos y no solo con intuición.
- Aprendí a estructurar un discurso, controlar el tono de voz y
manejar el lenguaje corporal para mantener la atención del público.
- Aprendí a conectar bases de datos y crear gráficas dinámicas para
mostrar KPIs de manera clara y visual.
- Aprendí la importancia de tomar apuntes y guardar materiales, porque
sin ellos es fácil olvidar lo aprendido.
- Aprendí a importar datos, limpiarlos con dplyr y analizarlos para
encontrar patrones significativos.
- Aprendí a comparar medias entre grupos y a entender cómo las redes
neuronales pueden clasificar o predecir datos.
- Tuve semestre de intercambio y aprendi a crear juegos basicos con
programación
- Aprendí a aplicar modelos de machine learning.
Actividad 2. Hershey
ventas <- read_excel("C:\\Users\\Chema\\Downloads\\Ventas_Históricas_Lechitas.xlsx")
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)(1,1,0)[12] with drift
##
## Coefficients:
## ar1 sar1 drift
## 0.6383 -0.5517 288.8979
## s.e. 0.1551 0.2047 14.5026
##
## sigma^2 = 202701: log likelihood = -181.5
## AIC=371 AICc=373.11 BIC=375.72
summary(modelo_ventas)
## Series: st_ventas
## ARIMA(1,0,0)(1,1,0)[12] with drift
##
## Coefficients:
## ar1 sar1 drift
## 0.6383 -0.5517 288.8979
## s.e. 0.1551 0.2047 14.5026
##
## sigma^2 = 202701: log likelihood = -181.5
## AIC=371 AICc=373.11 BIC=375.72
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 25.22158 343.864 227.17 0.08059932 0.7069542 0.06491044 0.2081026
Generar el pronostico
pronostico_ventas <- forecast(modelo_ventas, level= c(95), h=12)
pronostico_ventas
## Point Forecast Lo 95 Hi 95
## 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
plot(pronostico_ventas)

LS0tDQp0aXRsZTogIkFjdGl2aWRhZCAyIg0KYXV0aG9yOiAiSm9zw6kgTWFyw61hIE1lasOtYSBPcm5lbGFzIC0gQTAxNjQyMTk3Ig0KZGF0ZTogIjIwMjUtMDgtMTQiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUcnVlDQogICAgdG9jX2Zsb2F0OiBUcnVlDQogICAgY29kZV9kb3dubG9hZDogVHJ1ZQ0KICAgIHRoZW1lOiBjb3Ntbw0KLS0tDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpvcmFuZ2U7Ij4gQXBwIFNoaW55ICA8L3NwYW4+DQpbQXBsaWNhY2lvbiBkZSBTaGlueV0oaHR0cHM6Ly9qb3NlbWFyaWFtZWppYS5zaGlueWFwcHMuaW8vUnVtYm9NZXhpY28vKQ0KDQpMaW5rOiBoaHR0cHM6Ly9qb3NlbWFyaWFtZWppYS5zaGlueWFwcHMuaW8vUnVtYm9NZXhpY28vDQoNCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOm9yYW5nZTsiPkluc3RhbGFyIHBhcXVldGVzICA8L3NwYW4+DQoNCmBgYHtyfQ0KI2luc3RhbGwucGFja2FnZXMoImZvcmVjYXN0IikNCmxpYnJhcnkoZm9yZWNhc3QpDQpsaWJyYXJ5KHJlYWR4bCkNCmBgYA0KDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOm9yYW5nZTsiPiBFamVtcGxvLiBQcm9kdWNjaW9uICA8L3NwYW4+DQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjpvcmFuZ2U7Ij4gQ29udGV4dG8gIDwvc3Bhbj4NClVuYSAqKnNlcmllIGRlIHRpZW1wbyoqIGVzIHVuYSBjb2xlY2Npb24gZGUgb2JzZXJ2YWNvaW5lcyBzb2JyZSB1biBkZXRlcm1pbmFkbyBmZW5vbWVubyBlZmVjdHVhZGFzIGVuIG1vbWVudG9zIGRlIHRpZW1wbyBzdWNlc2l2b3MsIHVzdWFsbWVudGUgZXF1aWVzcGFjaWFkb3MuDQoNCkVqZW1wbG9zIGRlIHNlcmllcyBkZSB0aWVtcG86DQoxLiBQcmVjaW8gZGUgQWNjaW9uZXMNCjIuIE5pdmVsZXMgZGUgSW52ZW50YXJpbw0KMy4gUm90YWNpw7NuIGRlIFBlcnNvbmFsDQo0LiBWZW50YXMgDQo1LiBQSUIgKEdEUCkNCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOm9yYW5nZTsiPiBDcmVhciBsYSBzZXJpZSBkZSB0aWVtcG8gIDwvc3Bhbj4NCg0KRWplbXBsby4gTG9zIHNpZ3VpZW50ZXMgZGF0b3MgZGUgcHJvZHVjY2lvbiB0cmltZXN0cmFsIGluaWNpYW4gZW4gZWwgcHJpbWVyIHRyaW1lc3RyZSBkZWwgMjAyMC4gU2UgYnVzY2EgcHJvbm9zdGljYXIgbGEgcHJvZHVjY2lvbiBkZSBsb3Mgc2lndWllbnRlcyBjaW5jbyB0cmltZXN0cmVzLg0KYGBge3J9DQpwcm9kdWNjaW9uIDwtIGMoNTAsIDUzLCA1NSwgNTcsIDU1LCA2MCkNCg0Kc3RfcHJvZHVjY2lvbiA8LSB0cyhkYXRhPXByb2R1Y2Npb24sIHN0YXJ0PSBjKDIwMjAsMSksIGZyZXF1ZW5jeSA9IDQgKQ0KIyBFbiBlc3RlIGNhc28gbGEgc2VyaWUgZGUgdGllbXBvIGluaWNpYSBlbiAyMDIwIGVuIGVsIHByaW1lciB0cmltZXN0cmUgeSBzb24gNCB0cmltZXN0cmVzLg0KYGBgDQoNCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOm9yYW5nZTsiPiBDcmVhciBlbCBtb2RlbG8gQVJJTUEgICA8L3NwYW4+DQoNCioqQVJJTUEqKiBzaWduaWZpY2EgTW9kZWxvIEF1dG9ycmVncmVzaXZvIEludGVncmFkbyBkZSBQcm9tZWRpbyBNb3ZpbCBlbiBpbmdsZXMuDQpgYGB7cn0NCm1vZGVsb19wcm9kdWNjaW9uIDwtIGF1dG8uYXJpbWEoc3RfcHJvZHVjY2lvbiwgRD0xKSAjIEQ6IGRpZmVyZW5jaWFjaW9uIGVzdGFjaW9uYWwNCm1vZGVsb19wcm9kdWNjaW9uDQpzdW1tYXJ5KG1vZGVsb19wcm9kdWNjaW9uKQ0KDQojIEFsIGNvbXBhcmFyIG1vZGVsb3Mgc2VsZWNjaW9uYW1vcyBlbCBxdWUgdGVuZ2EgZWwgbWVub3IgTUFQRSAoUG9yY2VudGFqZSBkZSBFcnJvciBQcm9tZWRpbyBBYnNvbHV0bykNCmBgYA0KDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjpvcmFuZ2U7Ij4gR2VuZXJhciBlbCBQcm9ub3N0aWNvICA8L3NwYW4+DQpgYGB7cn0NCnByb25vc3RpY29fcHJvZHVjY2lvbiA8LSBmb3JlY2FzdChtb2RlbG9fcHJvZHVjY2lvbiwgbGV2ZWw9Yyg5NSksIGg9NSkNCiMgU2kgbm8gbm9zIGRpY2VuIG90cmEgY29zYSwgZWwgbml2ZWwgZGUgY29uZmlhYmlsaWFkIGVzIDk1IGxvcyBwZXJpb2RvcyBhIHByb25vc3RpY2FyIGVzIGgNCnByb25vc3RpY29fcHJvZHVjY2lvbg0KcGxvdChwcm9ub3N0aWNvX3Byb2R1Y2Npb24pDQpgYGANCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpvcmFuZ2U7Ij4gRWplcmNpY2lvIDEuIE1leGljbyBydW1ibyBhbCAyMDUwICA8L3NwYW4+DQpFbiBlcXVpcG9zIGRlIDIsIHNlbGVjY2lvbmFyIHVuIGVzdGFkbyBkZSBNw6l4aWNvLCBvYnRlbmVyIGxvcyBkYXRvcyBoaXN0w7NyaWNvcyBkZSBzdSBwb2JsYWNpw7NuLCBnZW5lcmFyIHVuIHByb27Ds3N0aWNvIGhhc3RhIDIwNTAuDQoNCmBgYHtyfQ0KcG9ibGFjaW9uIDwtIGMoNTE5MDAwLCA3MTk2NTksIDk0NDI4NSwgMTE4NDk5NiwgMTQyNTYwNykNCg0Kc3RfcG9ibGFjaW9uIDwtIHRzKGRhdGE9cG9ibGFjaW9uLCBzdGFydD0gYygxOTgwKSwgZnJlcXVlbmN5ID0gMC4xICkNCiMgRW4gZXN0ZSBjYXNvIGxhIHNlcmllIGRlIHRpZW1wbyBpbmljaWEgZW4gMjAyMCBlbiBlbCBwcmltZXIgdHJpbWVzdHJlIHkgc29uIDQgdHJpbWVzdHJlcy4NCmBgYA0KDQoNCmBgYHtyfQ0KbW9kZWxvX3BvYmxhY2lvbiA8LSBhdXRvLmFyaW1hKHN0X3BvYmxhY2lvbikgIyBEOiBkaWZlcmVuY2lhY2lvbiBlc3RhY2lvbmFsDQptb2RlbG9fcG9ibGFjaW9uDQpzdW1tYXJ5KG1vZGVsb19wb2JsYWNpb24pDQoNCmBgYA0KDQpgYGB7cn0NCnByb25vc3RpY29fcG9ibGFjaW9uIDwtIGZvcmVjYXN0KG1vZGVsb19wb2JsYWNpb24sIGxldmVsPWMoOTUpLCBoPTUpDQojIFNpIG5vIG5vcyBkaWNlbiBvdHJhIGNvc2EsIGVsIG5pdmVsIGRlIGNvbmZpYWJpbGlhZCBlcyA5NSBsb3MgcGVyaW9kb3MgYSBwcm9ub3N0aWNhciBlcyBoDQpwcm9ub3N0aWNvX3BvYmxhY2lvbg0KcGxvdChwcm9ub3N0aWNvX3BvYmxhY2lvbikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpvcmFuZ2U7Ij4gRWplcmNpY2lvIDIuIEFwbGljYWNpw7NuIGRlIFNoaW55ICA8L3NwYW4+DQpBZ3JlZ2FyIHVuYSBwZXN0YcOxYSBlbiBsYSBhcGxpY2FjaW9uIGRlIFNoaW55IGNvbiBlbCBlamVyY2ljaW8gTcOpeGljbyBydW1ibyBhbCAyMDUwLiBFbiBlbCBtZW7DuiBzZSBkZWJlIHNlbGVjY2lvbmFyIGxhIGNhbnRpZGFkIGRlIGHDsW9zIGEgcHJvbm9zdGljYXIuIA0KDQoNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IEVqZXJjaWNpbyAzLiBBcHJlbmRpemFqZXMgbWFzIGltcG9ydGFudGVzICA8L3NwYW4+DQoxLiBBcHJlbmTDrSBhIGRlc2dsb3NhciB1biBwcm95ZWN0byBlbiBzdXMgcHVudG9zIGZ1ZXJ0ZXMgeSBkw6liaWxlcywgeSBhIGRldGVjdGFyIG9wb3J0dW5pZGFkZXMgeSBhbWVuYXphcy4NCjIuIEFwcmVuZMOtIGEgY3VhZHJhciBhY3Rpdm9zLCBwYXNpdm9zIHkgY2FwaXRhbCwgeSBhIGNhbGN1bGFyIHV0aWxpZGFkZXMgcGFyYSBzYWJlciBzaSB1bmEgZW1wcmVzYSBlcyByZW50YWJsZS4NCjMuIEFwcmVuZMOtIGEgdXNhciBtZWRpYXMsIHZhcmlhbnphcyB5IHBydWViYXMgZGUgaGlww7N0ZXNpcyBwYXJhIHJlc3BhbGRhciBkZWNpc2lvbmVzIGNvbiBkYXRvcyB5IG5vIHNvbG8gY29uIGludHVpY2nDs24uDQo0LiBBcHJlbmTDrSBhIGVzdHJ1Y3R1cmFyIHVuIGRpc2N1cnNvLCBjb250cm9sYXIgZWwgdG9ubyBkZSB2b3ogeSBtYW5lamFyIGVsIGxlbmd1YWplIGNvcnBvcmFsIHBhcmEgbWFudGVuZXIgbGEgYXRlbmNpw7NuIGRlbCBww7pibGljby4NCjUuIEFwcmVuZMOtIGEgY29uZWN0YXIgYmFzZXMgZGUgZGF0b3MgeSBjcmVhciBncsOhZmljYXMgZGluw6FtaWNhcyBwYXJhIG1vc3RyYXIgS1BJcyBkZSBtYW5lcmEgY2xhcmEgeSB2aXN1YWwuDQo2LiBBcHJlbmTDrSBsYSBpbXBvcnRhbmNpYSBkZSB0b21hciBhcHVudGVzIHkgZ3VhcmRhciBtYXRlcmlhbGVzLCBwb3JxdWUgc2luIGVsbG9zIGVzIGbDoWNpbCBvbHZpZGFyIGxvIGFwcmVuZGlkby4NCjcuIEFwcmVuZMOtIGEgaW1wb3J0YXIgZGF0b3MsIGxpbXBpYXJsb3MgY29uIGRwbHlyIHkgYW5hbGl6YXJsb3MgcGFyYSBlbmNvbnRyYXIgcGF0cm9uZXMgc2lnbmlmaWNhdGl2b3MuDQo4LiBBcHJlbmTDrSBhIGNvbXBhcmFyIG1lZGlhcyBlbnRyZSBncnVwb3MgeSBhIGVudGVuZGVyIGPDs21vIGxhcyByZWRlcyBuZXVyb25hbGVzIHB1ZWRlbiBjbGFzaWZpY2FyIG8gcHJlZGVjaXIgZGF0b3MuDQo5LiBUdXZlIHNlbWVzdHJlIGRlIGludGVyY2FtYmlvIHkgYXByZW5kaSBhIGNyZWFyIGp1ZWdvcyBiYXNpY29zIGNvbiBwcm9ncmFtYWNpw7NuIA0KMTAuIEFwcmVuZMOtIGEgYXBsaWNhciBtb2RlbG9zIGRlIG1hY2hpbmUgbGVhcm5pbmcuDQoNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IEFjdGl2aWRhZCAyLiBIZXJzaGV5ICA8L3NwYW4+DQoNCmBgYHtyfQ0KdmVudGFzIDwtIHJlYWRfZXhjZWwoIkM6XFxVc2Vyc1xcQ2hlbWFcXERvd25sb2Fkc1xcVmVudGFzX0hpc3TDs3JpY2FzX0xlY2hpdGFzLnhsc3giKQ0KDQpzdF92ZW50YXMgPC0gdHMoZGF0YT12ZW50YXMsIHN0YXJ0PWMoMjAxNywgMSksIGZyZXF1ZW5jeT0xMikNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IENyZWFyIGVsIG1vZGVsbyBBUklNQSA8L3NwYW4+DQpgYGB7cn0NCm1vZGVsb192ZW50YXMgPC0gYXV0by5hcmltYShzdF92ZW50YXMpDQptb2RlbG9fdmVudGFzDQpzdW1tYXJ5KG1vZGVsb192ZW50YXMpDQoNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6b3JhbmdlOyI+IEdlbmVyYXIgZWwgcHJvbm9zdGljbyA8L3NwYW4+DQoNCmBgYHtyfQ0KcHJvbm9zdGljb192ZW50YXMgPC0gZm9yZWNhc3QobW9kZWxvX3ZlbnRhcywgbGV2ZWw9IGMoOTUpLCBoPTEyKQ0KcHJvbm9zdGljb192ZW50YXMNCnBsb3QocHJvbm9zdGljb192ZW50YXMpDQpgYGANCg0K