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

  1. Aprendí a desglosar un proyecto en sus puntos fuertes y débiles, y a detectar oportunidades y amenazas.
  2. Aprendí a cuadrar activos, pasivos y capital, y a calcular utilidades para saber si una empresa es rentable.
  3. Aprendí a usar medias, varianzas y pruebas de hipótesis para respaldar decisiones con datos y no solo con intuición.
  4. Aprendí a estructurar un discurso, controlar el tono de voz y manejar el lenguaje corporal para mantener la atención del público.
  5. Aprendí a conectar bases de datos y crear gráficas dinámicas para mostrar KPIs de manera clara y visual.
  6. Aprendí la importancia de tomar apuntes y guardar materiales, porque sin ellos es fácil olvidar lo aprendido.
  7. Aprendí a importar datos, limpiarlos con dplyr y analizarlos para encontrar patrones significativos.
  8. Aprendí a comparar medias entre grupos y a entender cómo las redes neuronales pueden clasificar o predecir datos.
  9. Tuve semestre de intercambio y aprendi a crear juegos basicos con programación
  10. 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