Introducción

El término Forecasting hace referencia a la previsión o pronóstico de situaciones a futuro. Estas situaciones se consideran de incertidumbre y a través de la estimación de series temporales se puede determinar con un acierto más o menos alto (dependiendo de los datos de origen con que se trabaje) lo que va a ocurrir en el futuro cercano.Por ejemplo, hacer una previsión de abandono en el proceso de compra. Es muy común la realización de forecast de ventas en determinados sectores como retail o consumo, donde se utilizan muchas referencias, e intervienen muchos factores internos como promociones, nuevas referencias o externos como el calendario o la meteorología y un modelo de forecasting puede anticipar acciones que impacten directamente en las ventas, evitar roturas de stock y en definitiva, controlar la producción. [1]

Son reportes que contienen los pronósticos de ocupación en base a los cuales se tomaran decisiones sobre en cuanto a las tarifas que se van a comercializar. Es la proyección futura estimada en el volumen de los negocios.(Marcio Barros)[2]

Series de tiempo

Un pronóstico de serie de tiempo lo que nos da es una idea de lo que pudiera pasar después si sigue pasando lo que ha venido ocurriendo(Rafa Gonzales,2020)[3]

Para el siguiente ejercicio se utilizará los datos de la web oficial “Ecobici” : https://www.ecobici.cdmx.gob.mx/es/informacion-del-servicio/open-data

Lo cual el tiempo a analizar será del año 2020 en el mes de febrero, puede descargarlo del enlace eligiendo las fechas mencionadas, no es necesario registrarse.

Lectura y procesamiento de datos

Para ello activaremos las librerias a utilizar e instalar un paquete en caso no lo tenga-

Librerias:

\[ l_1: library(tidyverse) \] \[ l_2: library(lubridate) \] Esta libreria la utilizaremos más delante pero lo cargamos de una vez.

\[ l_3: library(forecast) \] Instalar el siguiente paquete si no cuenta con ello. \[ p_1: install.packages('forecast') \]

raw_data <- read_csv("C:/Users/AlexQ/Downloads/2020-02.csv",show_col_types=FALSE)
viajes_diarios <- raw_data %>% 
  mutate(fecha_hora = dmy_hms(paste(Fecha_Retiro, Hora_Retiro))) %>% 
  filter(fecha_hora >= as.Date('2020-02-24'),
         fecha_hora <= as.Date('2020-02-27')) %>% 
  group_by(horas = floor_date(fecha_hora, unit = 'hour')) %>% 
  summarise(conteo = n())
head(viajes_diarios)
horas_completas <- data.frame(
  horas = seq(
    floor_date(min(viajes_diarios$horas), unit = 'hour'),
    floor_date(max(viajes_diarios$horas), unit = 'hour'),
    by = 'hour'
))

“Si observas, hay un salto en las horas de 00, 01, 02, a 05! Esto es porque no hay datos para las 03 y 04 horas. Para el análisis de serie de tiempo tenemos que corregir este error. Esto podemos hacerlo utilizando el siguiente código”[3]

head(viajes_diarios)
## # A tibble: 6 x 2
##   horas               conteo
##   <dttm>               <int>
## 1 2020-02-24 00:00:00     34
## 2 2020-02-24 01:00:00      7
## 3 2020-02-24 02:00:00      5
## 4 2020-02-24 05:00:00    145
## 5 2020-02-24 06:00:00    697
## 6 2020-02-24 07:00:00   1809

Rellenado y Join

Se llenará de ceros “Luego tenemos que hacer un left_join para cruzar las tablas. Esto es posible utilizando el código:”[3]

viajes_hora <- horas_completas %>% 
  group_by(horas_readondeadas = floor_date(horas, unit = 'hour')) %>% 
  left_join(viajes_diarios) %>% 
  mutate(conteo = ifelse(is.na(conteo), 0, conteo))
## Joining, by = "horas"
head(viajes_hora)
## # A tibble: 6 x 3
## # Groups:   horas_readondeadas [6]
##   horas               horas_readondeadas  conteo
##   <dttm>              <dttm>               <dbl>
## 1 2020-02-24 00:00:00 2020-02-24 00:00:00     34
## 2 2020-02-24 01:00:00 2020-02-24 01:00:00      7
## 3 2020-02-24 02:00:00 2020-02-24 02:00:00      5
## 4 2020-02-24 03:00:00 2020-02-24 03:00:00      0
## 5 2020-02-24 04:00:00 2020-02-24 04:00:00      0
## 6 2020-02-24 05:00:00 2020-02-24 05:00:00    145

Ahora sí incluye los ceros para las 03 y 04 horas.

Gráfico inicial

“Podemos hacer una gráfica con los datos que hemos obtenidos en ggplot2 utilizando el siguiente código.”“[3]

ggplot(data = viajes_diarios,
       aes(x = horas,
           y = conteo)) +
  geom_line()


Modelo Arima Estacional en R

“En este caso, vamos a trabajar el modelo auto regresivo integrado de media móvil estacional o arima estacional o sarima. También se le conoce este es un modelo que tiene varias partes digamos unidas y así puede hacer una mejor predicción o pronóstico. Estas partes son

-AR: Autoregresivo – cómo una regresión sobre sí mismo -I: Integrado – diferencias con respecto a valores posteriores -MA – Media movil (Moving Average en inglés) – tiene que ver con los «errores» de la predicción -S: Estacional – para fenómenos que se repiten.”[3]

Parámetros: (p,d,q) (p_s, d_s, q_s) [s]

Crear objeto ts

conteo_ts <- ts(viajes_hora$conteo,
                start = 1,
                frequency = 24)

Ajuste del modelo

ajuste <- auto.arima(y = conteo_ts)
summary(ajuste)
## Series: conteo_ts 
## ARIMA(3,1,0)(1,1,0)[24] 
## 
## Coefficients:
##           ar1      ar2     ar3    sar1
##       -0.3454  -0.2328  0.0394  -0.272
## s.e.   0.1452   0.1491  0.1419   0.194
## 
## sigma^2 = 3136:  log likelihood = -254.81
## AIC=519.62   AICc=521.08   BIC=528.87
## 
## Training set error measures:
##                     ME    RMSE      MAE MPE MAPE      MASE         ACF1
## Training set -1.164243 43.2755 24.45498 NaN  Inf 0.4549763 -0.006269555

Predicciones

predicciones <- forecast(ajuste)
autoplot(predicciones)
LS0tDQp0aXRsZTogIkZPUkVDQVNUSU5HIg0KYXV0aG9yOiAiQWxleCBRdWlqYWRhIg0KZGF0ZTogIjEvNS8yMDIyIg0Kb3V0cHV0Og0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIHRoZW1lOiAiam91cm5hbCINCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQotLS0NCg0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmxpYnJhcnkobHVicmlkYXRlKQ0KI2luc3RhbGwucGFja2FnZXMoJ2ZvcmVjYXN0JykNCmxpYnJhcnkoZm9yZWNhc3QpDQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpDQpgYGANCg0KKioqDQoNCiMjIEludHJvZHVjY2nDs24NCg0KDQpFbCB0w6lybWlubyBGb3JlY2FzdGluZyBoYWNlIHJlZmVyZW5jaWEgYSBsYSBwcmV2aXNpw7NuIG8gcHJvbsOzc3RpY28gZGUgc2l0dWFjaW9uZXMgYSBmdXR1cm8uIEVzdGFzIHNpdHVhY2lvbmVzIHNlIGNvbnNpZGVyYW4gZGUgaW5jZXJ0aWR1bWJyZSB5IGEgdHJhdsOpcyBkZSBsYSBlc3RpbWFjacOzbiBkZSBzZXJpZXMgdGVtcG9yYWxlcyBzZSBwdWVkZSBkZXRlcm1pbmFyIGNvbiB1biBhY2llcnRvIG3DoXMgbyBtZW5vcyBhbHRvIChkZXBlbmRpZW5kbyBkZSBsb3MgZGF0b3MgZGUgb3JpZ2VuIGNvbiBxdWUgc2UgdHJhYmFqZSkgbG8gcXVlIHZhIGEgb2N1cnJpciBlbiBlbCBmdXR1cm8gY2VyY2Fuby5Qb3IgZWplbXBsbywgaGFjZXIgdW5hIHByZXZpc2nDs24gZGUgYWJhbmRvbm8gZW4gZWwgcHJvY2VzbyBkZSBjb21wcmEuDQpFcyBtdXkgY29tw7puIGxhIHJlYWxpemFjacOzbiBkZSBmb3JlY2FzdCBkZSB2ZW50YXMgZW4gZGV0ZXJtaW5hZG9zIHNlY3RvcmVzIGNvbW8gcmV0YWlsIG8gY29uc3VtbywgZG9uZGUgc2UgdXRpbGl6YW4gbXVjaGFzIHJlZmVyZW5jaWFzLCBlIGludGVydmllbmVuIG11Y2hvcyBmYWN0b3JlcyBpbnRlcm5vcyBjb21vIHByb21vY2lvbmVzLCBudWV2YXMgcmVmZXJlbmNpYXMgbyBleHRlcm5vcyBjb21vIGVsIGNhbGVuZGFyaW8gbyBsYSBtZXRlb3JvbG9nw61hIHkgdW4gbW9kZWxvIGRlIGZvcmVjYXN0aW5nIHB1ZWRlIGFudGljaXBhciBhY2Npb25lcyBxdWUgaW1wYWN0ZW4gZGlyZWN0YW1lbnRlIGVuIGxhcyB2ZW50YXMsIGV2aXRhciByb3R1cmFzIGRlIHN0b2NrIHkgZW4gZGVmaW5pdGl2YSwgY29udHJvbGFyIGxhIHByb2R1Y2Npw7NuLiBbMV0NCg0KDQoNCj5Tb24gcmVwb3J0ZXMgcXVlIGNvbnRpZW5lbiBsb3MgcHJvbsOzc3RpY29zIGRlIG9jdXBhY2nDs24gZW4gYmFzZSBhIGxvcyBjdWFsZXMgc2UgdG9tYXJhbiBkZWNpc2lvbmVzIHNvYnJlIGVuIGN1YW50byBhIGxhcyB0YXJpZmFzIHF1ZSBzZSB2YW4gYSBjb21lcmNpYWxpemFyLiBFcyBsYSBwcm95ZWNjacOzbiBmdXR1cmEgZXN0aW1hZGEgZW4gZWwgdm9sdW1lbiBkZSBsb3MgbmVnb2Npb3MuKE1hcmNpbyBCYXJyb3MpWzJdDQoNCg0KIyMgU2VyaWVzIGRlIHRpZW1wbw0KDQo+VW4gcHJvbsOzc3RpY28gZGUgc2VyaWUgZGUgdGllbXBvIGxvIHF1ZSBub3MgZGEgZXMgdW5hIGlkZWEgZGUgbG8gcXVlIHB1ZGllcmEgcGFzYXIgZGVzcHXDqXMgc2kgc2lndWUgcGFzYW5kbyBsbyBxdWUgaGEgdmVuaWRvIG9jdXJyaWVuZG8oUmFmYSBHb256YWxlcywyMDIwKVszXQ0KDQoNClBhcmEgZWwgc2lndWllbnRlIGVqZXJjaWNpbyBzZSB1dGlsaXphcsOhIGxvcyBkYXRvcyBkZSBsYSB3ZWIgb2ZpY2lhbCAqKiJFY29iaWNpIioqIDoNCjxodHRwczovL3d3dy5lY29iaWNpLmNkbXguZ29iLm14L2VzL2luZm9ybWFjaW9uLWRlbC1zZXJ2aWNpby9vcGVuLWRhdGE+DQoNCkxvIGN1YWwgZWwgdGllbXBvIGEgYW5hbGl6YXIgc2Vyw6EgZGVsIGHDsW8gMjAyMCBlbiBlbCBtZXMgZGUgZmVicmVybywgcHVlZGUgZGVzY2FyZ2FybG8gZGVsIGVubGFjZSBlbGlnaWVuZG8gbGFzIGZlY2hhcyBtZW5jaW9uYWRhcywgbm8gZXMgbmVjZXNhcmlvIHJlZ2lzdHJhcnNlLg0KDQojIyMgTGVjdHVyYSAgeSBwcm9jZXNhbWllbnRvIGRlIGRhdG9zIA0KDQpQYXJhIGVsbG8gYWN0aXZhcmVtb3MgbGFzIGxpYnJlcmlhcyBhIHV0aWxpemFyIGUgaW5zdGFsYXIgdW4gcGFxdWV0ZSBlbiBjYXNvIG5vIGxvIHRlbmdhLQ0KDQpMaWJyZXJpYXM6DQoNCiQkDQpsXzE6IGxpYnJhcnkodGlkeXZlcnNlKQ0KJCQNCiQkDQpsXzI6IGxpYnJhcnkobHVicmlkYXRlKQ0KJCQNCkVzdGEgbGlicmVyaWEgbGEgdXRpbGl6YXJlbW9zIG3DoXMgZGVsYW50ZSBwZXJvIGxvIGNhcmdhbW9zIGRlIHVuYSB2ZXouDQoNCiQkDQpsXzM6IGxpYnJhcnkoZm9yZWNhc3QpDQokJA0KSW5zdGFsYXIgZWwgc2lndWllbnRlIHBhcXVldGUgc2kgbm8gY3VlbnRhIGNvbiBlbGxvLg0KJCQNCnBfMTogaW5zdGFsbC5wYWNrYWdlcygnZm9yZWNhc3QnKQ0KJCQNCg0KDQoNCmBgYHtyIHJlc3VsdHM9J2hpZGUnLCBjb2xsYXBzZT1UUlVFLCB9DQpyYXdfZGF0YSA8LSByZWFkX2NzdigiQzovVXNlcnMvQWxleFEvRG93bmxvYWRzLzIwMjAtMDIuY3N2IixzaG93X2NvbF90eXBlcz1GQUxTRSkNCnZpYWplc19kaWFyaW9zIDwtIHJhd19kYXRhICU+JSANCiAgbXV0YXRlKGZlY2hhX2hvcmEgPSBkbXlfaG1zKHBhc3RlKEZlY2hhX1JldGlybywgSG9yYV9SZXRpcm8pKSkgJT4lIA0KICBmaWx0ZXIoZmVjaGFfaG9yYSA+PSBhcy5EYXRlKCcyMDIwLTAyLTI0JyksDQogICAgICAgICBmZWNoYV9ob3JhIDw9IGFzLkRhdGUoJzIwMjAtMDItMjcnKSkgJT4lIA0KICBncm91cF9ieShob3JhcyA9IGZsb29yX2RhdGUoZmVjaGFfaG9yYSwgdW5pdCA9ICdob3VyJykpICU+JSANCiAgc3VtbWFyaXNlKGNvbnRlbyA9IG4oKSkNCmhlYWQodmlhamVzX2RpYXJpb3MpDQpgYGANCmBgYHtyfQ0KaG9yYXNfY29tcGxldGFzIDwtIGRhdGEuZnJhbWUoDQogIGhvcmFzID0gc2VxKA0KICAgIGZsb29yX2RhdGUobWluKHZpYWplc19kaWFyaW9zJGhvcmFzKSwgdW5pdCA9ICdob3VyJyksDQogICAgZmxvb3JfZGF0ZShtYXgodmlhamVzX2RpYXJpb3MkaG9yYXMpLCB1bml0ID0gJ2hvdXInKSwNCiAgICBieSA9ICdob3VyJw0KKSkNCmBgYA0KDQoiU2kgb2JzZXJ2YXMsIGhheSB1biBzYWx0byBlbiBsYXMgaG9yYXMgZGUgMDAsIDAxLCAwMiwgYSAwNSEgRXN0byBlcyBwb3JxdWUgbm8gaGF5IGRhdG9zIHBhcmEgbGFzIDAzIHkgMDQgaG9yYXMuIFBhcmEgZWwgYW7DoWxpc2lzIGRlIHNlcmllIGRlIHRpZW1wbyB0ZW5lbW9zIHF1ZSBjb3JyZWdpciBlc3RlIGVycm9yLiBFc3RvIHBvZGVtb3MgaGFjZXJsbyB1dGlsaXphbmRvIGVsIHNpZ3VpZW50ZSBjw7NkaWdvIlszXQ0KDQpgYGB7cn0NCmhlYWQodmlhamVzX2RpYXJpb3MpDQpgYGANCg0KIyMjIFJlbGxlbmFkbyB5IEpvaW4NCg0KU2UgbGxlbmFyw6EgZGUgY2Vyb3MgDQoiTHVlZ28gdGVuZW1vcyBxdWUgaGFjZXIgdW4gbGVmdF9qb2luIHBhcmEgY3J1emFyIGxhcyB0YWJsYXMuIEVzdG8gZXMgcG9zaWJsZSB1dGlsaXphbmRvIGVsIGPDs2RpZ286IlszXQ0KDQpgYGB7cn0NCnZpYWplc19ob3JhIDwtIGhvcmFzX2NvbXBsZXRhcyAlPiUgDQogIGdyb3VwX2J5KGhvcmFzX3JlYWRvbmRlYWRhcyA9IGZsb29yX2RhdGUoaG9yYXMsIHVuaXQgPSAnaG91cicpKSAlPiUgDQogIGxlZnRfam9pbih2aWFqZXNfZGlhcmlvcykgJT4lIA0KICBtdXRhdGUoY29udGVvID0gaWZlbHNlKGlzLm5hKGNvbnRlbyksIDAsIGNvbnRlbykpDQpoZWFkKHZpYWplc19ob3JhKQ0KYGBgDQoNCkFob3JhIHPDrSBpbmNsdXllIGxvcyBjZXJvcyBwYXJhIGxhcyAwMyB5IDA0IGhvcmFzLg0KDQojIyMgR3LDoWZpY28gaW5pY2lhbA0KDQoNCiJQb2RlbW9zIGhhY2VyIHVuYSBncsOhZmljYSBjb24gbG9zIGRhdG9zIHF1ZSBoZW1vcyBvYnRlbmlkb3MgZW4gZ2dwbG90MiB1dGlsaXphbmRvIGVsIHNpZ3VpZW50ZSBjw7NkaWdvLiIiWzNdDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEgPSB2aWFqZXNfZGlhcmlvcywNCiAgICAgICBhZXMoeCA9IGhvcmFzLA0KICAgICAgICAgICB5ID0gY29udGVvKSkgKw0KICBnZW9tX2xpbmUoKQ0KYGBgDQoNCioqKg0KDQojIyBNb2RlbG8gQXJpbWEgRXN0YWNpb25hbCBlbiBSDQoNCiJFbiBlc3RlIGNhc28sIHZhbW9zIGEgdHJhYmFqYXIgZWwgbW9kZWxvIGF1dG8gcmVncmVzaXZvIGludGVncmFkbyBkZSBtZWRpYSBtw7N2aWwgZXN0YWNpb25hbCBvIGFyaW1hIGVzdGFjaW9uYWwgbyBzYXJpbWEuIFRhbWJpw6luIHNlIGxlIGNvbm9jZSBlc3RlIGVzIHVuIG1vZGVsbyBxdWUgdGllbmUgdmFyaWFzIHBhcnRlcyBkaWdhbW9zIHVuaWRhcyB5IGFzw60gcHVlZGUgaGFjZXIgdW5hIG1lam9yIHByZWRpY2Npw7NuIG8gcHJvbsOzc3RpY28uIEVzdGFzIHBhcnRlcyBzb24NCg0KLUFSOiBBdXRvcmVncmVzaXZvIOKAkyBjw7NtbyB1bmEgcmVncmVzacOzbiBzb2JyZSBzw60gbWlzbW8NCi1JOiBJbnRlZ3JhZG8g4oCTIGRpZmVyZW5jaWFzIGNvbiByZXNwZWN0byBhIHZhbG9yZXMgcG9zdGVyaW9yZXMNCi1NQSDigJMgTWVkaWEgbW92aWwgKE1vdmluZyBBdmVyYWdlIGVuIGluZ2zDqXMpIOKAkyB0aWVuZSBxdWUgdmVyIGNvbiBsb3MgwqtlcnJvcmVzwrsgZGUgbGEgcHJlZGljY2nDs24NCi1TOiBFc3RhY2lvbmFsIOKAkyBwYXJhIGZlbsOzbWVub3MgcXVlIHNlIHJlcGl0ZW4uIlszXQ0KDQpQYXLDoW1ldHJvczogKHAsZCxxKSAocF9zLCBkX3MsIHFfcykgW3NdDQoNCiMjIyBDcmVhciBvYmpldG8gdHMNCg0KYGBge3J9DQpjb250ZW9fdHMgPC0gdHModmlhamVzX2hvcmEkY29udGVvLA0KICAgICAgICAgICAgICAgIHN0YXJ0ID0gMSwNCiAgICAgICAgICAgICAgICBmcmVxdWVuY3kgPSAyNCkNCmBgYA0KDQojIyMgQWp1c3RlIGRlbCBtb2RlbG8NCg0KYGBge3J9DQphanVzdGUgPC0gYXV0by5hcmltYSh5ID0gY29udGVvX3RzKQ0Kc3VtbWFyeShhanVzdGUpDQpgYGANCg0KIyMjIFByZWRpY2Npb25lcw0KDQpgYGB7cn0NCnByZWRpY2Npb25lcyA8LSBmb3JlY2FzdChhanVzdGUpDQphdXRvcGxvdChwcmVkaWNjaW9uZXMpDQpgYGANCjxkaXYgY2xhc3M9InRvY2lmeS1leHRlbmQtcGFnZSIgZGF0YS11bmlxdWU9InRvY2lmeS1leHRlbmQtcGFnZSIgc3R5bGU9ImhlaWdodDogMDsiPjwvZGl2Pg0K