DATA624 Spring 2021 HW3 - Decomposition

Question No. 6.9.2:

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

Background Information

ANSWER: The plastics dataset is a monthly time series.

help("plastics")

## starting httpd help server ... done

Sales of plastic product Description Monthly sales of product A for a plastics manufacturer.

Usage plastics Format Time series data

Source Makridakis, Wheelwright and Hyndman (1998) Forecasting: methods and applications, John Wiley & Sons: New York. Exercise 3.5.

head(plastics)

##    Jan  Feb  Mar  Apr  May  Jun
## 1  742  697  776  898 1030 1107

tail(plastics)

##    Jul  Aug  Sep  Oct  Nov  Dec
## 5 1611 1608 1528 1420 1119 1013

a.

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

ANSWER: From the seasonal plot, we can clearly see that there’s is a strong seasonal fluctuation and a trend cycle. We see that sales begin to rise in March and continue to rise until September/October where they fall as the year ends.

Across the entire time series, we see an positive trend upward again with a strong seasonal component. We also see no increase in the variance over time as well.

autoplot(plastics) +
    xlab("Year") +
    ylab("Sales") +
    ggtitle("Monthly Sales (in thousands) of Product A")

ggseasonplot(plastics)

ggseasonplot(plastics, year.labels=FALSE, continuous=TRUE, polar = TRUE)

b.

Use a classical multiplicative decomposition to calculate the trend-cycle and seasonal indices.

plastics %>% decompose(type="multiplicative") %>% 
        autoplot() + xlab("Year")+
        ggtitle("Classical multiplicative decomposition of plastics sales")

c.

Do the results support the graphical interpretation from part a?

ANSWER: Yes. The seasonality and trend lines confirm the analysis from part a. A check of the residuals show that the multiplicative decomposition shows that the residuals are uncorrelated and normally distributed.

checkresiduals(remainder( decompose(plastics, type="multiplicative")))

## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

d. 

Compute and plot the seasonally adjusted data.

plastics %>% decompose(type="multiplicative") -> fit

        autoplot(plastics, series="Data") + 
          autolayer(seasadj(fit), series="Seasonally Adjusted") +
          autolayer(trendcycle(fit), series="Trend") +
          xlab("Year")+ ylab("Sales")+
        ggtitle("Seasonally adjusted plastics sales") +
           scale_colour_manual(values=c("gray","blue","red"),
             breaks=c("Data","Seasonally Adjusted","Trend"))

## Warning: Removed 12 row(s) containing missing values (geom_path).

e.

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?

ANSWER: The effect of introducing an outlier shows a spike in the seasonal trend, but not much of an effect on the overall trend early in the time series.

plastics2 <- plastics

plastics2[24] <- plastics2[24] +500
plastics2[24]

## [1] 1401

plastics2 %>% decompose(type="multiplicative") -> fit2
        autoplot(plastics2, series="Data") + 
          autolayer(seasadj(fit2), series="Seasonally Adjusted") +
          autolayer(trendcycle(fit2), series="Trend") +
          xlab("Year")+ ylab("Sales")+
        ggtitle("Seasonally adjusted plastics sales") +
           scale_colour_manual(values=c("gray","blue","red"),
             breaks=c("Data","Seasonally Adjusted","Trend"))

## Warning: Removed 12 row(s) containing missing values (geom_path).

plastics3 <- plastics

plastics3[48] <- plastics3[48] + 500

plastics3 %>% decompose(type="multiplicative") -> fit3
        autoplot(plastics3, series="Data") + 
          autolayer(seasadj(fit3), series="Seasonally Adjusted") +
          autolayer(trendcycle(fit3), series="Trend") +
          xlab("Year")+ ylab("Sales")+
        ggtitle("Seasonally adjusted plastics sales") +
           scale_colour_manual(values=c("gray","blue","red"),
             breaks=c("Data","Seasonally Adjusted","Trend"))

## Warning: Removed 12 row(s) containing missing values (geom_path).

f. 

Does it make any difference if the outlier is near the end rather than in the middle of the time series?

The Trend line remains the same. However, we do see spikes in the Seasonally Adjusted data no matter where the outlier occurs.

Question No. 6.9.3:

Recall your retail time series data (from Exercise 3 in Section 2.10). Decompose the series using X11. Does it reveal any outliers, or unusual features that you had not noticed previously?

ANSWER: Decomposition using x11 did not reveal any outliers or unusual features.

retaildata <- read_excel("retail.xlsx", skip=1)

liquor_sales <- ts(retaildata[,"A3349414R"],
  frequency=12, start=c(1982,4))

liquor_sales  %>% seas(x11="") -> fit
autoplot(fit) +
  ggtitle("X11 decomposition of Australian Liquor Sales")

checkresiduals(remainder(fit))

## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

autoplot(liquor_sales, series="Data") +
  autolayer(trendcycle(fit), series="Trend") +
  autolayer(seasadj(fit), series="Seasonally Adjusted") +
  xlab("Year") + ylab("Liquor Sales") +
  ggtitle("Australian Liquor Sales") +
  scale_colour_manual(values=c("gray","blue","red"),
             breaks=c("Data","Seasonally Adjusted","Trend"))