Remessas
Fernando Lucambio Pérez
2022-11-02
Descrição
Remessas de produtos de fabricantes de bebidas dos EUA.
Remessas = c(3519,3803,4332,4251,4661,4811,4448,4451,4343,4067,4001,3934,3652,3768,4082,4101,
4628,4898,4476,4728,4458,4004,4095,4056,3641,3966,4417,4367,4821,5190,4638,4904,
4528,4383,4339,4327,3856,4072,4563,4561,4984,5316,4843,5383,4889,4681,4466,4463,
4217,4322,4779,4988,5383,5591,5322,5404,5106,4871,4977,4706,4193,4460,4956,5022,
5408,5565,5360,5490,5286,5257,5002,4897,4577,4764,5052,5251,5558,5931,5476,5603,
5425,5177,4792,4776,4450,4659,5043,5233,5423,5814,5339,5474,5278,5184,4975,4751,
4600,4718,5218,5336,5665,5900,5330,5626,5512,5293,5143,4842,4627,4881,5321,5290,
6002,5811,5671,6102,5482,5429,5356,5167,4608,4889,5352,5441,5970,5750,5670,5860,
5449,5401,5240,5229,4770,5006,5518,5576,6160,6121,5900,5994,5841,5832,5505,5573,
5331,5355,6057,6055,6771,6669,6375,6666,6383,6118,5927,5750,5122,5398,5817,6163,
6763,6835,6678,6821,6421,6338,6265,6291,5540,5822,6318,6268,7270,7096,6505,7039,
6440,6446,6717,6320)
Remessas.de.bebidas = ts(Remessas, start = c(1992,1), frequency = 12)
par(mfrow=c(1,1), mar=c(2,2,3,1), mgp=c(1.6,.6,0), pch=19)
plot(Remessas.de.bebidas, type="b", xlab="", ylab="",
main="Remessas de produtos de fabricantes de bebidas dos EUA \n em milhões de dólares")
grid()
Fonte: Introduction to Time Series Analysis and Forecasting.
Douglas C. Montgomery, Cheryl L. Jennings. and Murat Kulahci
Copyright 2008 John Wiley & Sons, Inc.
Observe o comportamento da função de autocorrelação a seguir, é um caso típico de função não informativa quanto à correlação e sim indicativo de comportamento não constante na esperança.
library(astsa)
acf1(Remessas.de.bebidas, col = 2:7, lwd=4, gg=TRUE)
## [1] 0.89 0.80 0.70 0.56 0.49 0.48 0.46 0.50 0.60 0.67 0.73 0.79 0.71 0.62 0.52
## [16] 0.38 0.32 0.30 0.28 0.32 0.41 0.47 0.54 0.59 0.52 0.44 0.35 0.23 0.17 0.14
## [31] 0.13 0.16 0.24 0.30 0.36 0.40 0.33 0.26 0.18 0.07 0.02 0.01 0.00 0.03 0.11
## [46] 0.17 0.23 0.27par(mfrow=c(1,1), mar=c(2,3,2,1), mgp=c(1.6,.6,0), pch=19)
monthplot(Remessas.de.bebidas)
grid()
O comportamento mensal pode ser apresentado também da seguinte forma.
library(forecast)
par(mfrow=c(1,1), mar=c(3,3,2,1), mgp=c(1.6,.6,0), pch=19)
seasonplot(Remessas.de.bebidas)
grid()
Percebemos que a varabildade não muda nos meses mas existe um comportamento cíclico durante cada ano: de janeiro até maio existe um crescimento, entre maio e agosto se estabiliza e depois decresce lentamente até dezembro.
Primeira forma de trabalhar
Identificando o comportamento da tendência.
par(mfrow=c(1,1), mar=c(2,2,3,1), mgp=c(1.6,.6,0), pch=19)
plot(Remessas.de.bebidas, type="b", xlab="", ylab="",
main="Remessas de produtos de fabricantes de bebidas dos EUA \n em milhões de dólares")
grid()
Tempo = time(Remessas.de.bebidas)
dummy1 = ifelse(Tempo < Tempo[82], 1, 0)
dummy2 = ifelse(Tempo[82]<= Tempo & Tempo <= Tempo[135], 1, 0)
Remessas1 = ts.intersect(Remessas.de.bebidas, Tempo = Tempo, Tempo1 = dummy1, Tempo2 = dummy2, dframe=TRUE)
summary(ajuste <- lm(Remessas.de.bebidas ~ Tempo + Tempo*Tempo1 + Tempo*Tempo2, data = Remessas1, na.action=NULL))##
## Call:
## lm(formula = Remessas.de.bebidas ~ Tempo + Tempo * Tempo1 + Tempo *
## Tempo2, data = Remessas1, na.action = NULL)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1050.65 -275.38 -4.69 305.38 783.50
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -465777.40 111016.08 -4.196 4.33e-05 ***
## Tempo 235.39 55.37 4.251 3.46e-05 ***
## Tempo1 68765.70 120069.24 0.573 0.5676
## Tempo2 283458.71 139378.83 2.034 0.0435 *
## Tempo:Tempo1 -34.07 59.92 -0.569 0.5704
## Tempo:Tempo2 -141.63 69.57 -2.036 0.0433 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 402 on 174 degrees of freedom
## Multiple R-squared: 0.745, Adjusted R-squared: 0.7377
## F-statistic: 101.7 on 5 and 174 DF, p-value: < 2.2e-16lines(ts(fitted(ajuste), start = c(1992,1), frequency = 12), lwd = 2, col = "red")
Utilizando regressão segmentada.
library(segmented)
ajuste0 = lm(Remessas.de.bebidas ~ Tempo, na.action=NULL)
summary(ajuste1 <- segmented(ajuste0, seg.Z = ~ Tempo, psi = c(Tempo[18],Tempo[135])))##
## ***Regression Model with Segmented Relationship(s)***
##
## Call:
## segmented.lm(obj = ajuste0, seg.Z = ~Tempo, psi = c(Tempo[18],
## Tempo[135]))
##
## Estimated Break-Point(s):
## Est. St.Err
## psi1.Tempo 1997.500 1.187
## psi2.Tempo 2002.833 0.675
##
## Meaningful coefficients of the linear terms:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -379486.33 63286.41 -5.996 1.14e-08 ***
## Tempo 192.53 31.73 6.068 7.87e-09 ***
## U1.Tempo -120.50 45.39 -2.655 NA
## U2.Tempo 230.42 59.28 3.887 NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 409.2 on 174 degrees of freedom
## Multiple R-Squared: 0.7358, Adjusted R-squared: 0.7282
##
## Boot restarting based on 6 samples. Last fit:
## Convergence attained in 4 iterations (rel. change 8.7468e-07)par(mfrow=c(1,1), mar=c(2,2,3,1), mgp=c(1.6,.6,0), pch=19)
plot(Remessas.de.bebidas, type="b", xlab="", ylab="",
main="Remessas de produtos de fabricantes de bebidas dos EUA \n em milhões de dólares")
lines(ts(fitted(ajuste1), start = c(1992,1), frequency = 12), lwd = 2, col = "red")
grid()
Eliminando a tendência \[ Y_t = X_t - T_t\cdot \]
par(mfrow=c(1,1), mar=c(2,2,3,1), mgp=c(1.6,.6,0), pch=19)
Remessas.de.bebidas1 = Remessas.de.bebidas - fitted(ajuste1)
plot(Remessas.de.bebidas1, type="b", xlab="", ylab="",
main="Remessas de produtos de fabricantes de bebidas dos EUA \n eliminando a tendência")
abline(h=mean(Remessas.de.bebidas1), col = "red", lwd = 4)
grid()
Observe a modificação produzida na função de autocorrelação pela eliminação da média não constante nos dados iniciais.
acf1(Remessas.de.bebidas1, col = 2:7, lwd=4, gg=TRUE)
## [1] 0.66 0.37 0.04 -0.44 -0.64 -0.67 -0.65 -0.42 0.00 0.31 0.60 0.84
## [13] 0.59 0.34 0.01 -0.42 -0.60 -0.62 -0.61 -0.40 -0.01 0.27 0.54 0.76
## [25] 0.55 0.32 0.01 -0.36 -0.53 -0.58 -0.55 -0.36 -0.02 0.26 0.50 0.70
## [37] 0.51 0.29 0.02 -0.33 -0.50 -0.53 -0.51 -0.34 -0.01 0.25 0.47 0.65Esta função apresenta um comportamento chamado de cíclico ou sazonal, uma outra componentes das séries temporais. Observe isso utilizando a função de decomposição não paramétrica stl.
par(mfrow=c(1,1), mar=c(3,3,1,2)+.5, mgp=c(1.6,.6,0))
remessas2 = stl(Remessas.de.bebidas1, s.window = "periodic")
plot(remessas2, main = "Remessas de produtos de fabricantes de bebidas dos EUA \n eliminando a tendência")
grid()
Sendo que agora podemos identificar as correlações significativas tanto na função de autocorrelação quanto nas correlações defasadas, como na figura a seguir.
lag1.plot(Remessas.de.bebidas1,9)