Exercise 6.9.2
The plastics dataset consists of the monthly sales (in thousands) of product A for a plastics manufacturer for five years.
help(plastics)
str(plastics)
a. Plot the time series of sales of product A. Can you identify seasonal fluctuations and/or a trend-cycle?
# Set consistent formatting for plots
formatting <- theme(plot.title = element_text(hjust = .5)) +
theme(text = element_text(size = 10))
# Plot the monthly plastics time series together with moving averages of order 3, 5, 7, 9, 11, and 13
autoplot(plastics, main = 'Plastics Product A, Monthly Sales (Five Years)', series = 'Product A', size = .8) +
autolayer(ma(plastics, order = 3), series = '3-MA', size = .7) +
autolayer(ma(plastics, order = 5), series = '5-MA', size = .7) +
autolayer(ma(plastics, order = 7), series = '7-MA', size = .7) +
autolayer(ma(plastics, order = 9), series = '9-MA', size = .7) +
autolayer(ma(plastics, order = 11), series = '11-MA', size = .7) +
autolayer(ma(plastics, order = 13), series = '13-MA', size = .7) +
formatting +
ylab(label = '') +
ylim(0, max(plastics)) +
scale_color_manual(values = c('Product A' = 'black',
'3-MA' = 'red',
'5-MA' = 'rosybrown',
'7-MA' = 'goldenrod3',
'9-MA' = 'olivedrab',
'11-MA' = 'royalblue4',
'13-MA' = 'midnightblue'),
breaks = c('Product A',
'3-MA',
'5-MA',
'7-MA',
'9-MA',
'11-MA',
'13-MA')
)
There’s a clear seasonal fluctuation, exhibiting troughs at the beginning of each year and peaks over August through October. Additionally, there’s a consistent upward trend.
b. Use a classical multiplicative decomposition to calculate the trend cycle and seasonal indices.
# Produce multiplicative decomposition of the monthly plastics time series
plastics_decomp <- plastics %>%
decompose(type = 'multiplicative')
# Plot the multiplicative decomposition
plastics_decomp %>%
autoplot()
# Output the seasonal index
(function(x) print(paste(min(x), max(x))) ) (plastics_decomp$figure)
## [1] "0.710335708434527 1.23136353496152"
# The tsfeatures package provides statistics on strength of trend and seasonality, which doesn't seem to be a built-in feature of the forecast or other time series packages: https://rdrr.io/github/robjhyndman/tsfeatures/man/stl_features.html
# Output the trend strength and seasonal strength metrics
plastics %>%
tsfeatures() %>%
select(trend, seasonal_strength) %>%
rename(trend_str = trend, season_str = seasonal_strength)
## # A tibble: 1 x 2
## trend_str season_str
## <dbl> <dbl>
## 1 0.919 0.964
c. Do the results support the graphical interpretations from part a?
Yes, they do. The multiplicative decomposition, with \(F_S\) of .963 (close to the maximum of 1), substantiates the strong seasonal trend observed in the data. The seaonsal index ranges between .71 and 1.23. The trend is also strong, with \(F_T\) of .92 (also close to the maximum of 1).
d. Compute and plot the seasonally adjusted data.
# Compute the seasonally adjusted monthly plastics time series
plastics_seasadj <- plastics / plastics_decomp$seasonal
# Plot the seasonally adjusted monthly plastics time series
autoplot(plastics_seasadj, main = 'Plastics Product A, Seasonally Adjusted Monthly Sales (Five Years)', series = 'Product A (Seasonally Adjusted)', size = .7, color = 'black') +
formatting +
ylab(label = '') +
ylim(0, max(plastics_seasadj))
e. Change one observation to be an outlier and recompute the seasonally adjusted data. What is the effect of the outlier?
# [UPDATING CODE]
f. Does it make any difference if the outlier is near the end rather than in the middle of the time series?
Yes, outlier vs. leverage point vs. influence. [PULL UP DEFINITIONS]
## R version 3.5.2 (2018-12-20)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18362)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=English_United States.1252
## [2] LC_CTYPE=English_United States.1252
## [3] LC_MONETARY=English_United States.1252
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United States.1252
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] tsfeatures_1.0.1 RCurl_1.95-4.12 bitops_1.0-6 readxl_1.3.1
## [5] dplyr_0.8.0.1 magrittr_1.5 fpp2_2.3 expsmooth_2.3
## [9] fma_2.3 forecast_8.7 ggplot2_3.1.0
##
## loaded via a namespace (and not attached):
## [1] zoo_1.8-5 tidyselect_0.2.5 xfun_0.5
## [4] reshape2_1.4.3 purrr_0.3.0 urca_1.3-0
## [7] lattice_0.20-38 colorspace_1.4-0 htmltools_0.3.6
## [10] yaml_2.2.0 utf8_1.1.4 rlang_0.3.1
## [13] pillar_1.3.1 ForeCA_0.2.4 glue_1.3.0
## [16] withr_2.1.2 splus2R_1.2-2 TTR_0.23-4
## [19] plyr_1.8.4 quantmod_0.4-14 stringr_1.4.0
## [22] timeDate_3043.102 munsell_0.5.0 gtable_0.2.0
## [25] cellranger_1.1.0 evaluate_0.13 labeling_0.3
## [28] knitr_1.21 tseries_0.10-46 lmtest_0.9-36
## [31] parallel_3.5.2 curl_3.3 fansi_0.4.0
## [34] xts_0.11-2 Rcpp_1.0.1 scales_1.0.0
## [37] sapa_2.0-2 fracdiff_1.4-2 digest_0.6.18
## [40] stringi_1.3.1 grid_3.5.2 cli_1.1.0
## [43] quadprog_1.5-7 tools_3.5.2 ifultools_2.0-5
## [46] lazyeval_0.2.1 tibble_2.0.1 crayon_1.3.4
## [49] pkgconfig_2.0.2 MASS_7.3-51.1 assertthat_0.2.0
## [52] rmarkdown_1.11 R6_2.4.0 nnet_7.3-12
## [55] nlme_3.1-137 compiler_3.5.2