library(fpp2)
## Loading required package: ggplot2
## Loading required package: forecast
## Loading required package: fma
## Loading required package: expsmooth
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(xlsx)
library(seasonal)
  1. The plastics data set consists of the monthly sales (in thousands) of product A for a plastics manufacturer for five years.
  1. Plot the time series of sales of product A. Can you identify seasonal fluctuations and/or a trend-cycle?
autoplot(plastics)

We see the seasonal fluctuations in the data. It is clear from the plot that the sales decrease in the begining of each year and then increasing and reaching the peak after middle of each year and then tends to drop. We can also see the incresing trend in sales data.

  1. 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 Monthly plastics sales")

p_dec <- plastics %>% decompose(type="multiplicative")
p_dec$trend
##         Jan       Feb       Mar       Apr       May       Jun       Jul
## 1        NA        NA        NA        NA        NA        NA  976.9583
## 2 1000.4583 1011.2083 1022.2917 1034.7083 1045.5417 1054.4167 1065.7917
## 3 1117.3750 1121.5417 1130.6667 1142.7083 1153.5833 1163.0000 1170.3750
## 4 1208.7083 1221.2917 1231.7083 1243.2917 1259.1250 1276.5833 1287.6250
## 5 1374.7917 1382.2083 1381.2500 1370.5833 1351.2500 1331.2500        NA
##         Aug       Sep       Oct       Nov       Dec
## 1  977.0417  977.0833  978.4167  982.7083  990.4167
## 2 1076.1250 1084.6250 1094.3750 1103.8750 1112.5417
## 3 1175.5000 1180.5417 1185.0000 1190.1667 1197.0833
## 4 1298.0417 1313.0000 1328.1667 1343.5833 1360.6250
## 5        NA        NA        NA        NA        NA
p_dec$seasonal
##         Jan       Feb       Mar       Apr       May       Jun       Jul
## 1 0.7670466 0.7103357 0.7765294 0.9103112 1.0447386 1.1570026 1.1636317
## 2 0.7670466 0.7103357 0.7765294 0.9103112 1.0447386 1.1570026 1.1636317
## 3 0.7670466 0.7103357 0.7765294 0.9103112 1.0447386 1.1570026 1.1636317
## 4 0.7670466 0.7103357 0.7765294 0.9103112 1.0447386 1.1570026 1.1636317
## 5 0.7670466 0.7103357 0.7765294 0.9103112 1.0447386 1.1570026 1.1636317
##         Aug       Sep       Oct       Nov       Dec
## 1 1.2252952 1.2313635 1.1887444 0.9919176 0.8330834
## 2 1.2252952 1.2313635 1.1887444 0.9919176 0.8330834
## 3 1.2252952 1.2313635 1.1887444 0.9919176 0.8330834
## 4 1.2252952 1.2313635 1.1887444 0.9919176 0.8330834
## 5 1.2252952 1.2313635 1.1887444 0.9919176 0.8330834
  1. Do the results support the graphical interpretation from part a?

Yes. The results from multiplicative decomposition supports the graphical interpretation from plot in part a. As we mentioned, sales are minimum in the begining of the year, the seasonal calculations reveals that sales are minimum in January and February. The peak during the months of August and September are revealed from the calculations, which we expected by exploring the plot in part a.

  1. Compute and plot the seasonally adjusted data.

We will remove the seasonal component from the data to get seasonal adjusted data. We will use multiplicative decomposition for that.

p_dec <- plastics %>% decompose(type="multiplicative")

seas_adj <- p_dec$x/p_dec$seasonal
seas_adj
##         Jan       Feb       Mar       Apr       May       Jun       Jul
## 1  967.3468  981.2262  999.3182  986.4758  985.8925  956.7826 1001.1759
## 2  966.0431  985.4495  996.7427 1023.8257 1051.9377 1057.0417 1108.5982
## 3 1168.1168 1116.3736 1139.6864 1158.9443 1152.4413 1146.0648 1119.7701
## 4 1239.8204 1212.1029 1207.9388 1218.2647 1219.4437 1229.0378 1277.0364
## 5 1342.8129 1452.8342 1450.0416 1411.6051 1405.1361 1414.8628 1384.4587
##         Aug       Sep       Oct       Nov       Dec
## 1  992.4139  981.0263  951.4241  978.9119  939.8819
## 2 1100.9592 1089.0366 1090.2260 1074.6860 1081.5244
## 3 1171.9625 1196.2349 1222.2981 1179.5334 1227.9683
## 4 1269.0820 1302.6210 1345.9580 1414.4319 1451.2352
## 5 1312.3369 1240.9008 1194.5377 1128.1178 1215.9647
autoplot((seas_adj))

  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?
length(plastics)
## [1] 60
plastics <- replace(plastics,60,500)
p_dec_out<- plastics %>% decompose(type="multiplicative")

seas_adj_out <- p_dec_out$x/p_dec_out$seasonal
seas_adj_out
##         Jan       Feb       Mar       Apr       May       Jun       Jul
## 1  967.7498  981.6350  999.7346  986.8868  986.3033  953.0628 1001.5930
## 2  966.4456  985.8601  997.1579 1024.2522 1052.3760 1052.9321 1109.0601
## 3 1168.6035 1116.8387 1140.1612 1159.4272 1152.9215 1141.6091 1120.2367
## 4 1240.3370 1212.6080 1208.4420 1218.7723 1219.9518 1224.2596 1277.5685
## 5 1343.3724 1453.4395 1450.6458 1412.1933 1405.7216 1409.3621 1385.0355
##         Aug       Sep       Oct       Nov       Dec
## 1  992.8274  981.4350  951.8205  979.3198  940.2735
## 2 1101.4179 1089.4904 1090.6802 1075.1338 1081.9750
## 3 1172.4508 1196.7333 1222.8074 1180.0248 1228.4799
## 4 1269.6107 1303.1637 1346.5188 1415.0213 1451.8399
## 5 1312.8836 1241.4178 1195.0354 1128.5879  600.4301
autoplot((seas_adj_out))

plastics <- replace(plastics,30,500)
p_dec_out<- plastics %>% decompose(type="multiplicative")

seas_adj_out <- p_dec_out$x/p_dec_out$seasonal
seas_adj_out
##         Jan       Feb       Mar       Apr       May       Jun       Jul
## 1  951.5148  966.0053  983.7548  971.1918  971.0023 1116.6807  986.9279
## 2  950.2324  970.1631  981.2194 1007.9630 1036.0500 1233.6951 1092.8214
## 3 1148.9990 1099.0562 1121.9369 1140.9881 1135.0357  504.3725 1103.8343
## 4 1219.5290 1193.3007 1189.1263 1199.3894 1201.0261 1434.4353 1258.8625
## 5 1320.8359 1430.2977 1427.4587 1389.7343 1383.9139 1651.3155 1364.7560
##         Aug       Sep       Oct       Nov       Dec
## 1  977.7564  966.3643  937.0044  964.7319  926.1397
## 2 1084.6985 1072.7604 1073.7026 1059.1187 1065.7112
## 3 1154.6532 1178.3565 1203.7731 1162.4473 1210.0139
## 4 1250.3382 1283.1526 1325.5588 1393.9432 1430.0165
## 5 1292.9542 1222.3549 1176.4334 1111.7765  591.4047
autoplot((seas_adj_out))

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

The outlier brings a sharp drop in the seasonaly adjusted data in both cases.

  1. 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?
retaildata <- readxl::read_excel("C:/Users/Gurpreet/Documents/Data624/retail.xlsx", skip=1)

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

autoplot(myts)  +
  ggtitle("time series plot of retail data")

myts %>% seas(x11="") -> fit
autoplot(fit) +
  ggtitle("X11 decomposition of retail data")

Comparing both graphs, trends seems to be increasing in both cases. In the first plot, we see the seasonality but in the X11 decomposition, the seasonality is decreasing as the trend increases. This inference was not evident from the plot before deccomposition.