2.Book HA

The plastics data set consists of the monthly sales (in thousands) of product A for a plastics manufacturer for five years.

2A .

lot the time series of sales of product A. Can you identify seasonal fluctuations and/or a trend-cycle?

 rm(list=ls())
library(fpp2)
autoplot(plastics) + ggtitle("Sales of Product A for a Plastics Manufacturer")   

Yes there is a strong seasonality in clothing sales each year. Each year, clothing sale start to climb up each month till middle of the year and then drop to its baseline .Then the cycle goes on every year.

Besides this seasonality earch year, there is also a trend-cycle that shows an increasing trend from year 1 to year6. Clothing sales goes up each and every year.

2B

  1. Use a classical multiplicative decomposition to calculate the trend-cycle and seasonal indices.
plastics %>%
  decompose(type="multiplicative") %>% 
  autoplot() +   
    labs (subtitle ="Sales of Product A for a Plastics Manufacturer", 
     title = 'classical multiplicative decomposition',
      x='Year' ,  y='Monthly Sales in Thousands') 

The results of the multiplicative decomposition show a yearly seasonal component with a frequency of 1 year. There is an increasing trend from year 1.5 through 5 years. After 5.2 years, there is a decrease in the trend.

2C

  1. Do the results support the graphical interpretation from part A?

Classical decomposition results are inline with graphical interpretation intuitively from above. The first part shows the data. Second part shows there is an upward trend from year1e to year5 year6. Third part shows each year there is a seasonality within the 12 months. Forth part shows that the residuals of the seasonality are similar each year.

The maximum time we have on this data is 5.2 years. Although this multiplicative decomposition shows a clear seasonality and trend that goes upward. We have to be caution in concluding, because classical multiplicative decomposition relies on moving average. 5 year is relatively short for a strong moving average.

However we are very confident about the seasonality of 12 months within each and every year. There is enough months to support this conclusion.

2D

  1. Compute and plot the seasonally adjusted data.
mult_decomp <- plastics %>%
  decompose(type="multiplicative")

autoplot( seasadj(mult_decomp) )+
ggtitle("No Overlay of Original Data, Seasonally Adjusted Line Only")  +
  ylab("Monthly Sales of Product A in Thousands") +xlab('Years')

autoplot(plastics, series="RAW Data") +
  autolayer(seasadj(mult_decomp), series="Seasonally Adjusted") +
  labs (subtitle ="Sales of Product A for a Plastics Manufacturer", 
  title ='Overlay, Seasonal Ajusted and Raw Data') +
  ylab("Monthly Sales of Product A in Thousands") +xlab('Years')

Two figures were plotted, both by multiplicative type, first plot is the seasonally adjusted plot only, which shows the monthly sales of product A with the seasonal data removed. The fist two years there were not much upward sales trend, which is only obvious from year 2- year5.

The second plot, we plotted both the seasonably adjusted line, with the original data overlay.

The upward trend and remainder make up the seasonally adjusted plot.

2E

  1. Change one observation to be an outlier (e.g., add 500 to one observation), and recompute the seasonally adjusted data. What is the effect of the outlier?
plst49 <- plastics
plst49[49] <- plst49[49]+2000
print (plst49)
##    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 3030 1032 1126 1285 1468 1637 1611 1608 1528 1420 1119 1013
print (plst49[49])
## [1] 3030
mult_decomp49 <- plst49 %>%
  decompose(type="multiplicative") 

autoplot(mult_decomp49) +    
      labs (subtitle ="Sales of Product A for a Plastics Manufacturer", 
            title ='Outlier on Obs49, 2000 Extra Sales Added Onto') +
       ylab("Monthly Sales of Product A in Thousands") +xlab('Years')

plst49.adj <- seasadj(decompose(plst49, type = "multiplicative"))

autoplot( plst49.adj)+
ggtitle("No Overlay of Original Data, Seasonally Adjusted Line Only")  +
  ylab("Monthly Sales of Product A in Thousands") +xlab('Years')

autoplot(plst49, series="Raw Data") +
  autolayer(plst49.adj, series="Seasonally Adjusted") +
   labs (subtitle ="Sales of Product A for a Plastics Manufacturer",
            title ='Outlier on ob49, 2000 added Sales') +
    ylab("Monthly Sales of Product A in Thousands") +xlab('Years')

When 2000 sales was added to the 49th data point, it caused a large spike in the seasonally adjusted data at that point. The monthly sales of product A was taken from a seasonal low point (hoveres around 1000 to 1500) to a sudden high point of 3000 (unajusted within raw data) and to 2200 in the seasonally adjusted data.

The multiplative decomposition shows that the seasonality within each year is relatively unchanged (although the remainder on the 49th datapoint at year5 is extremely high suggesting outlier). This is because the seasonal component is uniform for each year and only one data point has changed.

The upward trend in year to year sales also do not change that much from year 1 to year5 (up to the 49th datapoint), then it shows a sudden uptake.

2F

  1. Does it make any difference if the outlier is near the end rather than in the middle of the time series?
plst09 <- plastics
plst09[09] <- plst09[09]+2000
print (plst09)
##    Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
## 1  742  697  776  898 1030 1107 1165 1216 3208 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
print (plst09[09]) ## extra 2000 added into the 09th obs (early phase)
## [1] 3208
print (plst09[49])  ## back to original data on the 49th obs
## [1] 1030
mult_decomp09 <- plst09 %>%
  decompose(type="multiplicative") 

mult_decomp09  %>% 
    autoplot() +    
      labs (subtitle ="Sales of Product A for a Plastics Manufacturer", 
            title ='Outlier Obs09(early), 2000 Extra Sales Added onto') +
       ylab("Monthly Sales of Product A in Thousands") +xlab('Years')

plst09.adj <- seasadj(decompose(plst09, type = "multiplicative"))

autoplot(plst09.adj) + labs (subtitle ="Sales of Product A for a Plastics Manufacturer", 
            title ='Outlier Obs09(early), 2000 Extra Sales Added Onto') +
       ylab("Monthly Sales of Product A in Thousands") +xlab('Years')

autoplot(plst09, series="Data") +
  autolayer(plst09.adj , series="Seasonally Adjusted") +
  labs (subtitle ="Sales of Product A for a Plastics Manufacturer", 
            title ='Outlier Obs09(early), 2000 Extra Sales Added Onto') +
       ylab("Monthly Sales of Product A in Thousands") +xlab('Years')