Contexto

La base de datos AirPassangers contiene el numero mensueal de pasajeros aereos internacionales entre 1949 y 1960 (144 observaciones mensuales).
Esta base de datos es ampliamente utilizada para el analisis de serues de tiempo, reflejando el crecimiento de la industria de la aviacion comercial despues de la Segunda Guerra Mundial.

Instalar paquetes y librerias

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

Importar bases de datos

df<- as.data.frame(AirPassengers)
serie_de_tiempo <- AirPassengers

Identificar patrones o tendencias

Los 4 componentes de las series de tiempo son:

  • Tendencia Ej. Aumento en las ventas de una tienda en linea debido al crecimiento del comercio electronico.
  • Ciclo Ej. Las fluctuaciones en las ventas de automoviles a lo largo de los ciclos economicos (Expansion y recesion)
  • Patron Estacional Ej. Aumento en las ventas de juguetes durante la navidad.
  • Aleatorio Ej. Caida de las ventas por un desastre natural.

ggplot(df, aes(x=time(serie_de_tiempo), y=serie_de_tiempo))+
  geom_line(color = "darkgreen")+
  labs(title = "Numero de Pasajeros Aereos Internacionales", x="Año", y="Numero")
## Don't know how to automatically pick scale for object of type <ts>. Defaulting
## to continuous.
## Don't know how to automatically pick scale for object of type <ts>. Defaulting
## to continuous.

Podemos concluir de la grafica anterior que la base de datos tiene tendencia creciente y patron estacional

Generar pronostico

# Ajuste del modelo
modelo <- auto.arima(serie_de_tiempo)

# Realizar pronostico a 12 meses
pronostico <- forecast(modelo, h=12)

# Graficar datos historicos y el pronostico
autoplot(pronostico)+
  labs(title = "Numero de Pasajeros Aereos Internacionales", x="Año", y="Numero")

# Generar prediccion para un mes en especifico
df_prediccion <- data.frame(Fecha = time(pronostico$mean), Prediccion = as.numeric(pronostico$mean))

df_prediccion[df_prediccion$Fecha == 1961.0,] #Enero de 1961
##   Fecha Prediccion
## 1  1961   445.6349
LS0tDQp0aXRsZTogIkFpciBQYXNzYW5nZXJzIg0KYXV0aG9yOiAiUGF0cmljaW8gUmR6IEEwMTE3ODA5NyINCmRhdGU6ICIyMDI0LTA5LTEyIg0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6IGx1bWVuDQotLS0NCiFbXShDOlxcVXNlcnNcXHBhdHJpXFxPbmVEcml2ZVxcRG9jdW1lbnRvc1xcQ0FSUkVSQVxcNXRvIFNlbWVzdHJlXFxTRU1BTkEgVEVDIDFcXGF2aW9uLmdpZikNCg0KIyA8c3BhbiBzdHlsZT0gImNvbG9yOmdyZWVuOyI+Q29udGV4dG88L3NwYW4+DQpMYSBiYXNlIGRlIGRhdG9zICpBaXJQYXNzYW5nZXJzKiBjb250aWVuZSBlbCBudW1lcm8gbWVuc3VlYWwgZGUgcGFzYWplcm9zIGFlcmVvcyBpbnRlcm5hY2lvbmFsZXMgZW50cmUgMTk0OSB5IDE5NjAgKDE0NCBvYnNlcnZhY2lvbmVzIG1lbnN1YWxlcykuICANCkVzdGEgYmFzZSBkZSBkYXRvcyBlcyBhbXBsaWFtZW50ZSB1dGlsaXphZGEgcGFyYSBlbCBhbmFsaXNpcyBkZSBzZXJ1ZXMgZGUgdGllbXBvLCByZWZsZWphbmRvIGVsIGNyZWNpbWllbnRvIGRlIGxhIGluZHVzdHJpYSBkZSBsYSBhdmlhY2lvbiBjb21lcmNpYWwgZGVzcHVlcyBkZSBsYSAqKlNlZ3VuZGEgR3VlcnJhIE11bmRpYWwqKi4NCg0KIyA8c3BhbiBzdHlsZT0gImNvbG9yOmdyZWVuOyI+SW5zdGFsYXIgcGFxdWV0ZXMgeSBsaWJyZXJpYXM8L3NwYW4+DQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KI2luc3RhbGwucGFja2FnZXMoImdncGxvdDIiKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KI2luc3RhbGwucGFja2FnZXMoImZvcmVjYXN0IikNCmxpYnJhcnkoZm9yZWNhc3QpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0gImNvbG9yOmdyZWVuOyI+SW1wb3J0YXIgYmFzZXMgZGUgZGF0b3M8L3NwYW4+DQpgYGB7cn0NCmRmPC0gYXMuZGF0YS5mcmFtZShBaXJQYXNzZW5nZXJzKQ0Kc2VyaWVfZGVfdGllbXBvIDwtIEFpclBhc3NlbmdlcnMNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSAiY29sb3I6Z3JlZW47Ij5JZGVudGlmaWNhciBwYXRyb25lcyBvIHRlbmRlbmNpYXM8L3NwYW4+DQpMb3MgNCBjb21wb25lbnRlcyBkZSBsYXMgc2VyaWVzIGRlIHRpZW1wbyBzb246ICANCg0KKiAqKlRlbmRlbmNpYSoqIEVqLiBBdW1lbnRvIGVuIGxhcyB2ZW50YXMgZGUgdW5hIHRpZW5kYSBlbiBsaW5lYSBkZWJpZG8gYWwgY3JlY2ltaWVudG8gZGVsIGNvbWVyY2lvIGVsZWN0cm9uaWNvLiAgDQoqICoqQ2ljbG8qKiBFai4gTGFzIGZsdWN0dWFjaW9uZXMgZW4gbGFzIHZlbnRhcyBkZSBhdXRvbW92aWxlcyBhIGxvIGxhcmdvIGRlIGxvcyBjaWNsb3MgZWNvbm9taWNvcyAoRXhwYW5zaW9uIHkgcmVjZXNpb24pICAgIA0KKiAqKlBhdHJvbiBFc3RhY2lvbmFsKiogRWouIEF1bWVudG8gZW4gbGFzIHZlbnRhcyBkZSBqdWd1ZXRlcyBkdXJhbnRlIGxhIG5hdmlkYWQuICAgIA0KKiAqKkFsZWF0b3JpbyoqIEVqLiBDYWlkYSBkZSBsYXMgdmVudGFzIHBvciB1biBkZXNhc3RyZSBuYXR1cmFsLiAgDQoNCiFbXShodHRwczovL2kueXRpbWcuY29tL3ZpL2FVd1hXR2E4akswL21heHJlc2RlZmF1bHQuanBnKQ0KDQpgYGB7cn0NCmdncGxvdChkZiwgYWVzKHg9dGltZShzZXJpZV9kZV90aWVtcG8pLCB5PXNlcmllX2RlX3RpZW1wbykpKw0KICBnZW9tX2xpbmUoY29sb3IgPSAiZGFya2dyZWVuIikrDQogIGxhYnModGl0bGUgPSAiTnVtZXJvIGRlIFBhc2FqZXJvcyBBZXJlb3MgSW50ZXJuYWNpb25hbGVzIiwgeD0iQcOxbyIsIHk9Ik51bWVybyIpDQpgYGANCg0KUG9kZW1vcyBjb25jbHVpciBkZSBsYSBncmFmaWNhIGFudGVyaW9yIHF1ZSBsYSBiYXNlIGRlIGRhdG9zIHRpZW5lICoqdGVuZGVuY2lhIGNyZWNpZW50ZSoqIHkgKipwYXRyb24gZXN0YWNpb25hbCoqDQoNCiMgPHNwYW4gc3R5bGU9ICJjb2xvcjpncmVlbjsiPkdlbmVyYXIgcHJvbm9zdGljbzwvc3Bhbj4NCmBgYHtyfQ0KIyBBanVzdGUgZGVsIG1vZGVsbw0KbW9kZWxvIDwtIGF1dG8uYXJpbWEoc2VyaWVfZGVfdGllbXBvKQ0KDQojIFJlYWxpemFyIHByb25vc3RpY28gYSAxMiBtZXNlcw0KcHJvbm9zdGljbyA8LSBmb3JlY2FzdChtb2RlbG8sIGg9MTIpDQoNCiMgR3JhZmljYXIgZGF0b3MgaGlzdG9yaWNvcyB5IGVsIHByb25vc3RpY28NCmF1dG9wbG90KHByb25vc3RpY28pKw0KICBsYWJzKHRpdGxlID0gIk51bWVybyBkZSBQYXNhamVyb3MgQWVyZW9zIEludGVybmFjaW9uYWxlcyIsIHg9IkHDsW8iLCB5PSJOdW1lcm8iKQ0KICANCiMgR2VuZXJhciBwcmVkaWNjaW9uIHBhcmEgdW4gbWVzIGVuIGVzcGVjaWZpY28NCmRmX3ByZWRpY2Npb24gPC0gZGF0YS5mcmFtZShGZWNoYSA9IHRpbWUocHJvbm9zdGljbyRtZWFuKSwgUHJlZGljY2lvbiA9IGFzLm51bWVyaWMocHJvbm9zdGljbyRtZWFuKSkNCg0KZGZfcHJlZGljY2lvbltkZl9wcmVkaWNjaW9uJEZlY2hhID09IDE5NjEuMCxdICNFbmVybyBkZSAxOTYxDQpgYGANCg0K