library(fpp2)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
## -- Attaching packages ---------------------------------------------- fpp2 2.4 --
## √ ggplot2   3.3.2     √ fma       2.4  
## √ forecast  8.13      √ expsmooth 2.3
## 
library(seasonal)

1 _ , _ , (Y1+Y2+Y3+Y4+Y5)/5, (Y2+Y3+Y4+Y5+Y6)/5, (Y3+Y4+Y5+Y6+Y7)/5, _ , _ 3. 3-MA : _ , _ , _ ,((Y1+Y2+Y3+Y4+Y5)/5 + (Y2+Y3+Y4+Y5+Y6)/5 + (Y3+Y4+Y5+Y6+Y7)/5)/3 , _ , _ , _ = 1/15(Y1) 2/15(Y2) 3/15(Y3) 3/15(Y4) 3/15(Y5) 2/15(Y6) 1/15(Y7) = 0.067 0.133 0.2 0.2 0.2 0.133 0.067

2.a

autoplot(plastics)

The plot shows a upward trend and it seems to have a seasonal trend.

2.b

plastics %>% decompose(type="multiplicative") %>% 
autoplot() + xlab("Year") +
ggtitle("Sales of product A of plastics manufactuer")

2.c yes

2.d

plastic.decomp<-decompose(plastics, type="multiplicative")
plastic.seas_adj<-plastic.decomp$x/plastic.decomp$seasonal
plot(plastic.seas_adj)

2.e

plastics2<-plastics
plastics2[5]<-plastics[5]+500
plastics2
##    Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
## 1  742  697  776  898 1530 1107 1165 1216 1208 1131  971  783
## 2  741  700  774  932 1099 1223 1290 1349 1341 1296 1066  901
## 3  896  793  885 1055 1204 1326 1303 1436 1473 1453 1170 1023
## 4  951  861  938 1109 1274 1422 1486 1555 1604 1600 1403 1209
## 5 1030 1032 1126 1285 1468 1637 1611 1608 1528 1420 1119 1013
plastic.decomp2 <- decompose(plastics2, type="multiplicative")
plastic.seas_adj2 <-plastic.decomp2$x/plastic.decomp$seasonal
plot(plastic.seas_adj2)

There is a sharp change made by an outlier probably.

2.f

plastics3<-plastics
plastics3[25]<-plastics[25]+500
plastics3
##    Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
## 1  742  697  776  898 1030 1107 1165 1216 1208 1131  971  783
## 2  741  700  774  932 1099 1223 1290 1349 1341 1296 1066  901
## 3 1396  793  885 1055 1204 1326 1303 1436 1473 1453 1170 1023
## 4  951  861  938 1109 1274 1422 1486 1555 1604 1600 1403 1209
## 5 1030 1032 1126 1285 1468 1637 1611 1608 1528 1420 1119 1013
plastic.decomp3 <- decompose(plastics3, type="multiplicative")
plastic.seas_adj3 <-plastic.decomp3$x/plastic.decomp$seasonal
plot(plastic.seas_adj3)

plastics4<-plastics
plastics4[55]<-plastics[55]+500
plastics4
##    Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
## 1  742  697  776  898 1030 1107 1165 1216 1208 1131  971  783
## 2  741  700  774  932 1099 1223 1290 1349 1341 1296 1066  901
## 3  896  793  885 1055 1204 1326 1303 1436 1473 1453 1170 1023
## 4  951  861  938 1109 1274 1422 1486 1555 1604 1600 1403 1209
## 5 1030 1032 1126 1285 1468 1637 2111 1608 1528 1420 1119 1013
plastic.decomp4 <- decompose(plastics4, type="multiplicative")
plastic.seas_adj4 <-plastic.decomp4$x/plastic.decomp$seasonal
plot(plastic.seas_adj4)

If the ourlier is near the last of the data the trend will decrease.

3

retaildata <- readxl::read_excel("retail.xlsx", skip=1)
myts <- ts(retaildata[,"A3349399C"],frequency=12, start=c(1982,4))
myts %>% seas(x11="") -> myts_x11
autoplot(myts_x11) +
ggtitle("X11 decomposition of Clothing Sales in New South Wales")

4.a There seems to be an upward trend as time goes. In the year of 1991, 1992 and 1993 there are some outliers. Also the graph did not show a seasonal impact.

4.b Yes As we can see from the graph there seems to be a drop.

5.a

autoplot(cangas)

ggsubseriesplot(cangas)

ggseasonplot(cangas)

There is an increase in production over time. It happens can be due to the increase of demand of traveling or working in urban areas.

5.b

cangas %>%
stl(t.window=13, s.window=13, robust=TRUE) %>%
autoplot()

5.c

cangas %>% seas() %>%
autoplot() +
  ggtitle("Seats decomposition of Cangas")

cangas %>% seas(x11="") %>%
autoplot() +
  ggtitle("x11 decomposition of Cangas")

The graph suggests that the result seems to be silmlar between two models.

6.a

bricksq %>%
  stl(t.window=13, s.window="periodic", robust=TRUE) %>%
  autoplot()

bricksq %>%
 stl(t.window= 13, s.window=13, robust=T) %>%
 autoplot()

6.b

fit5 <- stl(t.window = 13,s.window=13,robust=T,x=bricksq)
autoplot(seasadj(fit5))

6.c

fit5 %>% seasadj() %>% naive() %>% autoplot() + ggtitle(label = "Naive forecast of seasonally adjusted brick data", subtitle = "STL decomposition with changing seasonality")

fit6 <- stl(t.window = 13,s.window='periodic',robust=T,x=bricksq)
fit6 %>% seasadj() %>% naive() %>% autoplot() + ggtitle(label = "Naive forecast of seasonally adjusted brick data", subtitle = "STL decomposition with fixed seasonality")

6.d

stlf_brick <- stlf(bricksq)
autoplot(stlf_brick)

6.e

checkresiduals(stlf_brick)
## Warning in checkresiduals(stlf_brick): The fitted degrees of freedom is based on
## the model used for the seasonally adjusted data.

## 
##  Ljung-Box test
## 
## data:  Residuals from STL +  ETS(M,N,N)
## Q* = 41.128, df = 6, p-value = 2.733e-07
## 
## Model df: 2.   Total lags used: 8

The residuals seem to be correlated with each other

6.f

stlf_brick_robust <- stlf(bricksq, robust = TRUE)
autoplot(stlf_brick_robust)

checkresiduals(stlf_brick_robust)
## Warning in checkresiduals(stlf_brick_robust): The fitted degrees of freedom is
## based on the model used for the seasonally adjusted data.

## 
##  Ljung-Box test
## 
## data:  Residuals from STL +  ETS(M,N,N)
## Q* = 28.163, df = 6, p-value = 8.755e-05
## 
## Model df: 2.   Total lags used: 8

It seems like the autocorrelations lower generally, but there are still some high values left.

6.g

trainset_brick <- subset(bricksq, end = length(bricksq) - 8)
testset_brick <- subset(bricksq, start = length(bricksq) - 7)
snaive_brick <- snaive(trainset_brick)
stlf_brick_part <- stlf(trainset_brick, robust = TRUE)

plot data and forecast results

autoplot(bricksq, series = "Original data") + geom_line(size = 1) + autolayer(stlf_brick_part, PI = FALSE, size = 1, series = "stlf") + autolayer(snaive_brick, PI = FALSE, size = 1, series = "snaive") + scale_color_manual(values = c("yellow", "green", "red"), breaks = c("Original data", "stlf", "snaive")) + scale_x_continuous(limits = c(1990, 1994.5)) + scale_y_continuous(limits = c(300, 600)) + guides(colour = guide_legend(title = "Data")) + ggtitle("Forecast from stlf and snaive functions") + annotate("rect", xmin=1992.75,xmax=1994.5,ymin=-Inf,ymax=Inf, fill="lightgreen",alpha = 0.3)
## Scale for 'x' is already present. Adding another scale for 'x', which will
## replace the existing scale.
## Warning: Removed 136 row(s) containing missing values (geom_path).

It seems like stlf function are more close to the original data than snaive function. Stlf have the advantage in trending seasonality therefore stlf is more suitable.

7

str(writing)
##  Time-Series [1:120] from 1968 to 1978: 563 599 669 598 580 ...
head(writing)
##          Jan     Feb     Mar     Apr     May     Jun
## 1968 562.674 599.000 668.516 597.798 579.889 668.233
autoplot(writing)

Since there is an increasing trend using rwdrift is better to track with nonseasonal data, also using box-cox can make the transformation the same as the whole data.

stlf_writing <- stlf(writing, s.window = 13, robust = TRUE, lambda = BoxCox.lambda(writing), method = "rwdrift")
autoplot(stlf_writing)

8

str(fancy)
##  Time-Series [1:84] from 1987 to 1994: 1665 2398 2841 3547 3753 ...
head(fancy)
##          Jan     Feb     Mar     Apr     May     Jun
## 1987 1664.81 2397.53 2840.71 3547.29 3752.96 3714.74
autoplot(fancy)

Since there is an increasing trend using rwdrift is better to track with nonseasonal data, also using box-cox can make the transformation the same as the whole data.

stlf_fancy <- stlf(fancy, s.window = 13, robust = TRUE, lambda = BoxCox.lambda(fancy), method = "rwdrift")
autoplot(stlf_fancy)