Se trabaja con una base de datos para estimar el comportamiento de movimiento de pasajeros por vía aérea en aeropuertos nacionales
pasajeros = read.csv ("pasajeros.csv")
Declarar base de datos en serie de tiempo ST
pas<-ts(pasajeros$Numero.de.Pasajeros, frequency=12, start=c(2005,1))
plot(pas)
plot(pas,type="o",xlab="Año", ylab="Pasajeros", col="darkred")
Se muestra en la serie la presencia de patrones como son:estacionalidad no se puede ser visible con exactitud pero presenta influencia de factores estacionales, tendecia ciclo debido a que en el largo plazo se visuliza un incremento en los datos.
fit<-decompose(pas)
plot(fit, type="o",xlab="Año", col="darkred")
library(forecast)
seasonplot(pas, col=rainbow(12), year.labels=TRUE)
La serie de tiempo presenta estacionalidad en los meses como se observa en la gráfica, los meses de Julio son con mayor incremento de vuelos.
## Loading required package: ggplot2
## Loading required package: fma
## Loading required package: expsmooth
## Jan Feb Mar Apr May Jun Jul Aug
## 2005 NA 3502408 3652284 3854983 3774225 3994170 4124554 4082796
## 2006 3923534 4106340 4353972 4684601 4684549 5035788 5224468 5091845
## 2007 4674547 4704347 4774802 4977273 4864574 5121573 5088016 4835084
## 2008 4517306 4704347 4774802 4977273 4864574 5121573 5088016 4835084
## 2009 4246609 4149620 4149564 3919602 3811339 4024085 4457914 4304169
## 2010 3765815 3761608 3844963 4147775 4122603 4463490 4579028 4360566
## 2011 3741831 3693681 3830342 4151526 4188392 4507385 4598526 4552503
## 2012 4240255 4156633 4246490 4478147 4529848 4921979 5112211 5013743
## 2013 4483677 4392341 4455067 4779002 4855105 5375423 5624759 5536145
## 2014 4954931 4756507 4838584 5230951 5330445 5709651 5890529 5788839
## 2015 5368635 5312388 5515394 5958854 6029806 6476283 6718473 6609844
## 2016 6093649 6056379 6159351 6609519 6673050 7294324 7572634 7492133
## 2017 7001066 6762532 6881467 7357150 7527252 7944282 8145708 7856847
## 2018 7412795 7437007 7649575 8137685 NA
## Sep Oct Nov Dec
## 2005 3928250 3818569 4005252 3988348
## 2006 4754759 4601998 4865316 4798926
## 2007 4461887 4295228 4473817 4519561
## 2008 4461887 4295228 4473817 4413286
## 2009 3999554 3821426 4044270 3981441
## 2010 3988723 3753298 3987281 3918176
## 2011 4305442 4225182 4471773 4414407
## 2012 4702704 4559563 4790194 4732364
## 2013 5131310 4964426 5247553 5243147
## 2014 5497424 5368308 5711236 5647955
## 2015 6261898 6108342 6461694 6395399
## 2016 7110124 6966335 7369726 7368052
## 2017 7492759 7328938 7741537 7714313
## 2018
## Jan Feb Mar Apr May Jun Jul Aug
## 2005 NA NA 3625654 3697568 3943620 3998941 3955876 3987580
## 2006 4069380 4227098 4337599 4487100 4894451 5008476 4929824 4936545
## 2007 4797294 4784902 4775741 4836683 5053118 5005942 4872852 4743886
## 2008 4629675 4690558 4775741 4836683 5053118 5005942 4872852 4743886
## 2009 4296839 4251650 3978721 3935671 4118135 4163697 4028434 4166106
## 2010 3897777 3894344 3908840 3982475 4312949 4399292 4291836 4217517
## 2011 3829085 3867232 3905016 3991215 4326565 4447923 4424512 4418914
## 2012 4313859 4321227 4286474 4383123 4730261 4859821 4843475 4864995
## 2013 4578186 4574390 4552896 4651830 5109437 5292347 5300477 5320822
## 2014 4998873 5016349 4999250 5051251 5469181 5679664 5621405 5629065
## 2015 5511334 5571771 5598829 5740445 6236360 6442480 6397115 6418187
## 2016 6265050 6254948 6268580 6431641 6975354 7178333 7231309 7275717
## 2017 7067995 7102047 7052117 7163515 7667977 7882023 7748743 7749343
## 2018 7593645 7682888 7734292 NA NA
## Sep Oct Nov Dec
## 2005 4025548 3962525 3905856 3929990
## 2006 4958946 4827541 4681220 4708567
## 2007 4664334 4484199 4402813 4473668
## 2008 4664334 4484199 4339048 4311250
## 2009 4169749 4040545 3880222 3846737
## 2010 4177709 4006111 3821006 3806469
## 2011 4469998 4403144 4308442 4282649
## 2012 4877650 4764404 4637087 4559611
## 2013 5357940 5223755 5091855 5009211
## 2014 5702382 5622356 5483520 5450259
## 2015 6489602 6388362 6224343 6179885
## 2016 7354303 7276550 7152968 7059663
## 2017 7763035 7627096 7490505 7496604
## 2018
## Jan Feb Mar Apr May Jun Jul Aug
## 2005 NA NA NA 3754488 3879982 3930710 3936992 3951247
## 2006 4144977 4245125 4358439 4586635 4774890 4859144 4864529 4881188
## 2007 4777672 4821733 4826217 4887496 4945629 4895019 4783585 4740097
## 2008 4609887 4702005 4758828 4887496 4945629 4895019 4783585 4740097
## 2009 4296381 4132705 4069701 4103639 4151832 4094370 4039325 4011201
## 2010 3915423 3964037 3978458 4095088 4220146 4233351 4192423 4180861
## 2011 3877573 3941352 3971602 4100475 4232931 4319032 4362658 4402148
## 2012 4328373 4361681 4397469 4521319 4660740 4728963 4755349 4794914
## 2013 4602710 4639769 4680842 4853523 5022224 5131900 5170224 5240521
## 2014 5037573 5103013 5117464 5235615 5380463 5474854 5553151 5607488
## 2015 5572035 5659093 5716415 5899912 6117887 6248361 6306845 6372008
## 2016 6270460 6357002 6422127 6627302 6861531 7021478 7078907 7207381
## 2017 7115051 7187567 7240487 7361289 7520848 7607251 7674243 7712621
## 2018 7665582 7761238 NA NA NA
## Sep Oct Nov Dec
## 2005 3995111 4028759 3920974 3987305
## 2006 4936593 4913548 4726370 4713685
## 2007 4679252 4635722 4481126 4514822
## 2008 4679252 4590175 4365113 4277082
## 2009 4147799 4112225 3900514 3849382
## 2010 4164567 4104812 3871579 3785133
## 2011 4456281 4459522 4287664 4266898
## 2012 4862697 4842142 4607070 4554182
## 2013 5332708 5336527 5060310 4960599
## 2014 5680690 5689226 5461338 5432915
## 2015 6463864 6463528 6208022 6180110
## 2016 7347281 7376765 7081698 7000094
## 2017 7771988 7754412 7484841 7468259
## 2018
## Jan Feb Mar Apr May Jun Jul Aug
## 2005 NA NA NA NA 3786476 3858235 3932702 3954091
## 2006 4142235 4265380 4459369 4610868 4627578 4714840 4837022 4880570
## 2007 4751273 4811413 4898434 4913279 4801335 4786087 4786839 4724492
## 2008 4596602 4680913 4805312 4860865 4801335 4786087 4786839 4724492
## 2009 4153813 4144925 4195645 4208042 4088376 4057734 4066314 4053259
## 2010 3911672 3976160 4096631 4164206 4081592 4099059 4160034 4156817
## 2011 3882219 3956451 4085301 4163961 4144859 4214390 4325078 4404223
## 2012 4314528 4386084 4527625 4610205 4566741 4623724 4716641 4777928
## 2013 4607414 4679213 4854285 4962480 4927864 4987267 5122729 5212934
## 2014 5050103 5111501 5263794 5358804 5291930 5348553 5496596 5610173
## 2015 5565266 5684477 5879877 6015320 5984013 6084525 6261890 6367114
## 2016 6270503 6397041 6616358 6758600 6740521 6854600 7049496 7178303
## 2017 7108183 7219837 7397934 7501308 7382210 7439503 7610599 7708545
## 2018 7626473 NA NA NA NA
## Sep Oct Nov Dec
## 2005 3970256 3955552 4064796 4090190
## 2006 4863158 4833671 4887170 4776162
## 2007 4701007 4633517 4671083 4585417
## 2008 4665582 4543284 4486174 4341579
## 2009 4001693 4015052 4036682 3941986
## 2010 4123463 4024719 4013842 3912414
## 2011 4409078 4354655 4393636 4322113
## 2012 4785683 4718484 4732093 4630045
## 2013 5249960 5181372 5180068 5071014
## 2014 5618343 5542491 5604155 5553591
## 2015 6377860 6306821 6375972 6272216
## 2016 7257500 7180011 7208130 7119881
## 2017 7717118 7629147 7678464 7618882
## 2018
library(forecast)
library(fpp2)
library(gridExtra)
library(grid)
grid.arrange(p1, p2, p3, p4)
## Warning: Removed 2 rows containing missing values (geom_path).
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 6 rows containing missing values (geom_path).
## Warning: Removed 8 rows containing missing values (geom_path).
dc <- decompose(pas, type='multiplicative')
autoplot(dc)
Es apropiado debido a las fluctuaciones estacionales varean con el tiempo, presenta un factor de tendencia ciclica. #falta interpretacion
library(forecast)
autoplot(pas, series="Data") + autolayer(seasadj(dc), series = "seasonally adj. data") + xlab("año") + ylab("nuevos pasajeros") + ggtitle("Numero de pasajeros aereos")
data(pas)
## Warning in data(pas): data set 'pas' not found
autoplot(pas) + ggtitle("pasajeros en vuelos aereos nacionales") + ylab("pasajeros") + xlab("años")
mes. <- season(pas)
modelo2 <- lm(pas~mes.)
summary(modelo2)
##
## Call:
## lm(formula = pas ~ mes.)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2054926 -926354 -394604 505632 2953726
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4820315 332793 14.484 <2e-16 ***
## mes.February -411650 470641 -0.875 0.3832
## mes.March 414162 470641 0.880 0.3803
## mes.April 349397 470641 0.742 0.4590
## mes.May 474997 470641 1.009 0.3145
## mes.June 227176 479606 0.474 0.6364
## mes.July 1214705 479606 2.533 0.0124 *
## mes.August 764443 479606 1.594 0.1131
## mes.September -203264 479606 -0.424 0.6723
## mes.October 230964 479606 0.482 0.6308
## mes.November 305240 479606 0.636 0.5255
## mes.December 612880 479606 1.278 0.2033
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1245000 on 149 degrees of freedom
## Multiple R-squared: 0.1055, Adjusted R-squared: 0.03951
## F-statistic: 1.598 on 11 and 149 DF, p-value: 0.1046
mes. <- season(pas)
modelo3 <- lm(pas ~ time(pas) * I(time(pas)^2) * mes.)
summary(modelo3)
##
## Call:
## lm(formula = pas ~ time(pas) * I(time(pas)^2) * mes.)
##
## Residuals:
## Min 1Q Median 3Q Max
## -944678 -180338 -45214 230175 900640
##
## Coefficients: (12 not defined because of singularities)
## Estimate Std. Error t value
## (Intercept) 1.463e+11 3.171e+10 4.613
## time(pas) -1.457e+08 3.153e+07 -4.621
## I(time(pas)^2) 3.627e+04 7.837e+03 4.629
## mes.February -7.731e+09 4.484e+10 -0.172
## mes.March 2.925e+10 4.485e+10 0.652
## mes.April 3.199e+10 4.485e+10 0.713
## mes.May 3.397e+10 4.485e+10 0.757
## mes.June 2.704e+10 4.968e+10 0.544
## mes.July 3.194e+10 4.968e+10 0.643
## mes.August 3.568e+10 4.968e+10 0.718
## mes.September 1.871e+10 4.968e+10 0.377
## mes.October 4.410e+10 4.969e+10 0.888
## mes.November 4.212e+10 4.969e+10 0.848
## mes.December 4.546e+10 4.969e+10 0.915
## time(pas):I(time(pas)^2) NA NA NA
## time(pas):mes.February 7.746e+06 4.459e+07 0.174
## time(pas):mes.March -2.905e+07 4.459e+07 -0.651
## time(pas):mes.April -3.179e+07 4.459e+07 -0.713
## time(pas):mes.May -3.378e+07 4.459e+07 -0.757
## time(pas):mes.June -2.687e+07 4.939e+07 -0.544
## time(pas):mes.July -3.179e+07 4.939e+07 -0.643
## time(pas):mes.August -3.549e+07 4.940e+07 -0.718
## time(pas):mes.September -1.857e+07 4.940e+07 -0.376
## time(pas):mes.October -4.384e+07 4.940e+07 -0.887
## time(pas):mes.November -4.187e+07 4.940e+07 -0.848
## time(pas):mes.December -4.520e+07 4.940e+07 -0.915
## I(time(pas)^2):mes.February -1.940e+03 1.108e+04 -0.175
## I(time(pas)^2):mes.March 7.211e+03 1.108e+04 0.651
## I(time(pas)^2):mes.April 7.897e+03 1.108e+04 0.713
## I(time(pas)^2):mes.May 8.395e+03 1.108e+04 0.757
## I(time(pas)^2):mes.June 6.678e+03 1.228e+04 0.544
## I(time(pas)^2):mes.July 7.908e+03 1.228e+04 0.644
## I(time(pas)^2):mes.August 8.825e+03 1.228e+04 0.719
## I(time(pas)^2):mes.September 4.610e+03 1.228e+04 0.375
## I(time(pas)^2):mes.October 1.089e+04 1.228e+04 0.887
## I(time(pas)^2):mes.November 1.041e+04 1.228e+04 0.847
## I(time(pas)^2):mes.December 1.124e+04 1.228e+04 0.915
## time(pas):I(time(pas)^2):mes.February NA NA NA
## time(pas):I(time(pas)^2):mes.March NA NA NA
## time(pas):I(time(pas)^2):mes.April NA NA NA
## time(pas):I(time(pas)^2):mes.May NA NA NA
## time(pas):I(time(pas)^2):mes.June NA NA NA
## time(pas):I(time(pas)^2):mes.July NA NA NA
## time(pas):I(time(pas)^2):mes.August NA NA NA
## time(pas):I(time(pas)^2):mes.September NA NA NA
## time(pas):I(time(pas)^2):mes.October NA NA NA
## time(pas):I(time(pas)^2):mes.November NA NA NA
## time(pas):I(time(pas)^2):mes.December NA NA NA
## Pr(>|t|)
## (Intercept) 9.69e-06 ***
## time(pas) 9.38e-06 ***
## I(time(pas)^2) 9.08e-06 ***
## mes.February 0.863
## mes.March 0.515
## mes.April 0.477
## mes.May 0.450
## mes.June 0.587
## mes.July 0.521
## mes.August 0.474
## mes.September 0.707
## mes.October 0.376
## mes.November 0.398
## mes.December 0.362
## time(pas):I(time(pas)^2) NA
## time(pas):mes.February 0.862
## time(pas):mes.March 0.516
## time(pas):mes.April 0.477
## time(pas):mes.May 0.450
## time(pas):mes.June 0.587
## time(pas):mes.July 0.521
## time(pas):mes.August 0.474
## time(pas):mes.September 0.708
## time(pas):mes.October 0.377
## time(pas):mes.November 0.398
## time(pas):mes.December 0.362
## I(time(pas)^2):mes.February 0.861
## I(time(pas)^2):mes.March 0.516
## I(time(pas)^2):mes.April 0.477
## I(time(pas)^2):mes.May 0.450
## I(time(pas)^2):mes.June 0.587
## I(time(pas)^2):mes.July 0.521
## I(time(pas)^2):mes.August 0.474
## I(time(pas)^2):mes.September 0.708
## I(time(pas)^2):mes.October 0.377
## I(time(pas)^2):mes.November 0.398
## I(time(pas)^2):mes.December 0.362
## time(pas):I(time(pas)^2):mes.February NA
## time(pas):I(time(pas)^2):mes.March NA
## time(pas):I(time(pas)^2):mes.April NA
## time(pas):I(time(pas)^2):mes.May NA
## time(pas):I(time(pas)^2):mes.June NA
## time(pas):I(time(pas)^2):mes.July NA
## time(pas):I(time(pas)^2):mes.August NA
## time(pas):I(time(pas)^2):mes.September NA
## time(pas):I(time(pas)^2):mes.October NA
## time(pas):I(time(pas)^2):mes.November NA
## time(pas):I(time(pas)^2):mes.December NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 422900 on 125 degrees of freedom
## Multiple R-squared: 0.9134, Adjusted R-squared: 0.8892
## F-statistic: 37.69 on 35 and 125 DF, p-value: < 2.2e-16
En este modelo presentamos una mejor estimacion de los coeficientes, se muetsran siginicativos ## (Intercept) 9.69e-06 ## time(pas) 9.38e-06 ## I(time(pas)^2) 9.08e-06 *** \[R^2 ajustada = 0.8892\] Explican las medias estacionales de los pasajeros en 88%
library(forecast)
library(fpp2)
autoplot(pas) + geom_smooth() + ylab("pasajeros") + xlab("años")
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Modelo 1
plot(y=rstandard(modelo1),x=as.vector(time(pas)), xlab="Tiempo", ylab="Residuales estandarizados",type="o")
Modelo 2
plot(y=rstandard(modelo2),x=as.vector(time(pas)), xlab="Tiempo", ylab="Residuales estandarizados",type="o")
Modelo 3
plot(y=rstandard(modelo3),x=as.vector(time(pas)), xlab="Tiempo", ylab="Residuales estandarizados",type="o")
hist(rstandard(modelo3),xlab='Residuales estandarizados')
qqnorm(rstandard(modelo1));qqline(rstandard(modelo1), col='red')
shapiro.test(rstandard(modelo1))
##
## Shapiro-Wilk normality test
##
## data: rstandard(modelo1)
## W = 0.98353, p-value = 0.05277
Muestra la normalidad de los residuos \[Shapiro=0.05277\] Existe normalidad
ggAcf(rstandard(modelo3))
\[ pas=\beta_0*beta_1t*(beta_2t)^2*mes \]
Obtenemos la ecuacion final, podemos observar como al inicio los residuos tiene un comportamiento por arriba de lo esperado, suponiendo que exista correlacion en los primeros años de los datos