Econometrics Week 11
Time Series Decomposition
Putri Angelina Windjaya - 20194920010
April 19, 2021
Email : putriangelina865@gmail.com
Instagram : https://www.instagram.com/putriangelinaw
RPubs : https://rpubs.com/putriangelinaw/
1 Exercise 1
1. Consider the GDP information in global_economy. Plot the GDP per capita for each country over time. Which country has the highest GDP per capita? How has this changed over time?
global_economy %>%
tsibble(key = Code, index = Year)%>%
autoplot(GDP/Population, show.legend = FALSE) +
labs(title= "GDP per capita",
y = "$US")
max_data <- global_economy %>%
mutate(sum = GDP/Population)
grouped <- setkey(setDT(max_data), Country)[,list(sum=sum(sum)), by=list(Country)]
max_value <- grouped[which.max(grouped$sum),]
max_value## Country sum
## 1: Luxembourg 2398911global_economy %>%
tsibble(key = Code, index = Year)%>%
filter(Country=="Luxembourg") %>%
autoplot(GDP/Population)
2 Exercise 2
2. For each of the following series, make a graph of the data. If transforming seems appropriate, do so and describe the effect.
2.1 A
a. United States GDP from global_economy
global_economy %>%
filter(Country == "United States") %>%
autoplot(GDP)+
labs(title = "United States GDP", y = "$US")+
theme_replace()+
geom_line(col = "#1B89D3")
2.2 B
b. Slaughter of Victorian “Bulls, bullocks and steers” in aus_livestock
aus_livestock %>%
filter(Animal == "Bulls, bullocks and steers",
State == "Victoria")%>%
autoplot(Count)+
labs(title = "Slaughter of Victorian “Bulls, bullocks and steers”")+
theme_replace()+
geom_line(col = "#1B89D3")
2.3 C
c. Victorian Electricity Demand from vic_elec.
vic_elec %>%
autoplot(Demand)+
labs(title = "Victorian Electricity Demand",
y = "Demand")+
theme_replace()+
geom_line(col = "#1B89D3")
2.4 D
d. Gas production from aus_production
aus_production %>%
autoplot(Gas)+
labs(title = "Gas production")+
theme_replace()+
geom_line(col = "#1B89D3")
3 Exercise 3
3. Why is a Box-Cox transformation unhelpful for the canadian_gas data?
canadian_gas %>%
autoplot(Volume)+
labs(title = "Canadian Gas Production",
y = "Monthly Canadian Gas Production (billions of cubic meter)")+
theme_replace()+
geom_line(col = "#1B89D3")
lambda_cangas <- canadian_gas %>%
features(Volume, features = guerrero) %>%
pull(lambda_guerrero)
canadian_gas %>%
autoplot(box_cox(Volume, lambda = lambda_cangas))+
labs(title = latex2exp::TeX(paste0(
"Box Cox Transformation of Canadian Gas Production with $\\lambda$ = ",
round(lambda_cangas,2))))+
theme_replace()+
geom_line(col = "#1B89D3")
The plot of monthly Canadian gas production displays a seasonality of one year and a seasonal variance that is relatively low from 1960 through 1978, larger from 1978 through 1988 and smaller from 1988 through 2005. Because the seasonal variation increases and then decreases, the Box Cox transformation cannot be used to make the seasonal variation uniform.
4 Exercise 4
4. What Box-Cox transformation would you select for your retail data (from Exercise 8 in Section 2.10)?
set.seed(12345678)
myseries <- aus_retail %>%
filter(`Series ID` == sample(aus_retail$`Series ID`,1))
myseries %>%
autoplot(Turnover)+
labs(title = "Australian Retail Trade Turnover")+
theme_replace()+
geom_line(col = "#1B89D3")
lambda_retail <- myseries %>%
features(Turnover, features = guerrero) %>%
pull(lambda_guerrero)
myseries %>%
autoplot(box_cox(Turnover, lambda_retail))+
labs(title = latex2exp::TeX(paste0(
"Box Cox Transformation of Australian Retail Trade Turnover with $\\lambda$ = ",
round(lambda_retail,2))))+
theme_replace()+
geom_line(col = "#1B89D3")
The plot of Australian Retail Trade doesn’t show an upward trend and a seasonality of one year. The seasonal variation increases with time.
5 Exercise 5
5. For the following series, find an appropriate Box-Cox transformation in order to stabilise the variance. Tobacco from aus_production, Economy class passengers between Melbourne and Sydney from ansett, and Pedestrian counts at Southern Cross Station from pedestrian.
5.1 Tobacco from aus_production
lambda_tobacco <- aus_production %>%
features(Tobacco, features = guerrero) %>%
pull(lambda_guerrero)
aus_production %>%
autoplot(box_cox(Tobacco, lambda_tobacco)) +
labs(y = "",
title = latex2exp::TeX(paste0(
"Transformed gas production with $\\lambda$ = ",
round(lambda_tobacco,2))))+
theme_replace()+
geom_line(col = "#1B89D3")
5.2 Economy class passengers between Melbourne and Sydney from ansett
lambda_class <- ansett %>%
filter(Class == "Economy",
Airports == "MEL-SYD")%>%
features(Passengers, features = guerrero) %>%
pull(lambda_guerrero)
ansett %>%
filter(Class == "Economy",
Airports == "MEL-SYD")%>%
mutate(Passengers = Passengers/1000) %>%
autoplot(box_cox(Passengers, lambda = lambda_class)) +
labs(y = "Passengers ('000)",
title = latex2exp::TeX(paste0(
"Transformed Ansett Airlines Economy Class with $\\lambda$ = ",
round(lambda_class,2))),
subtitle = "Melbourne-Sydney")+
theme_replace()+
geom_line(col = "#1B89D3")
5.3 Pedestrian counts at Southern Cross Station from pedestrian
lambda_count <- pedestrian %>%
filter(Sensor == "Southern Cross Station") %>%
features(Count, features = guerrero) %>%
pull(lambda_guerrero)
pedestrian %>%
filter(Sensor == "Southern Cross Station") %>%
autoplot(box_cox(Count,lambda_count))+
labs(y = "",
title = latex2exp::TeX(paste0(
"Transformed Pedestrian Counts at Southern Cross Station with $\\lambda$ = ",
round(lambda_count,2))))+
theme_replace()+
geom_line(col = "#1B89D3")
6 Exercise 6
6. Show that a \(3\times5\) MA is equivalent to a 7-term weighted moving average with weights of 0.067, 0.133, 0.200, 0.200, 0.200, 0.133, and 0.067.
\[ \begin{align} 3\times5MA &= \frac{1}{15}Y_1+ \frac{2}{15}Y_2+\frac{3}{15}Y_3+\frac{3}{15}Y_4+\frac{3}{15}Y_5+\frac{2}{15}Y_6+\frac{1}{15}Y_7\\ Weight &= c(0.067, 0.133, 0.200, 0.200, 0.200, 0.133, 0.067) \end{align} \]
7 Exercise 7
7. Consider the last five years of the Gas data from aus_production.
7.1 A
a. Plot the time series. Can you identify seasonal fluctuations and/or a trend-cycle?
gas %>%
autoplot()+
labs(title = "Last Five Years of The Gas Data")+
theme_replace()+
geom_line(col = "#1B89D3")
There is a seasonality with a frequency of 1 year and a trend-cycle that shows an increasing trend.
7.2 B
b. Use classical_decomposition with type=multiplicative to calculate the trend-cycle and seasonal indices.
gas %>%
model(classical_decomposition(Gas,type = "multiplicative")) %>%
components() %>%
autoplot() +
ggtitle("Last Five Years of The Gas Data")
The results of the multiplicative decomposition show a quarterly seasonal component with a frequency of 1 year. There is an increasing trend from year 2006 through middle 2007. After year 2007, there is no trend until early 2008. After that, ther is an increasing trend late 2009.
7.3 C
c. Do the results support the graphical interpretation from part a?
The results support the graphical interpretation from part a, which was a seasonality of frequency 1 year and an increasing trend. And because classical multiplicative decomposition relies on moving averages, there is no data at the beginning and end of the trend-cycle.
7.4 D
d. Compute and plot the seasonally adjusted data.
gas_decom <- gas %>%
model(classical_decomposition(Gas,type = "multiplicative")) %>%
components()
gas_decom %>%
ggplot(aes(x = Quarter)) +
geom_line(aes(y = Gas, colour = "Data")) +
geom_line(aes(y = season_adjust,
colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend")) +
labs(y = "",
title = "Last Five Years of The Gas Data") +
scale_colour_manual(
values = c("gray", "#0072B2", "#D55E00"),
breaks = c("Data", "Seasonally Adjusted", "Trend")
)
7.5 E
e. Change one observation to be an outlier (e.g., add 300 to one observation), and recompute the seasonally adjusted data. What is the effect of the outlier?
new_gas <- gas
new_gas$Gas[10] <- new_gas$Gas[10]+300
new_gas %>%
model(classical_decomposition(Gas,type = "multiplicative")) %>%
components() %>%
autoplot() +
ggtitle("Last Five Years of The Gas Data with 300 added to the 10th observation")
new_gas %>%
model(classical_decomposition(Gas,type = "multiplicative")) %>%
components() %>%
ggplot(aes(x = Quarter)) +
geom_line(aes(y = Gas, colour = "Data")) +
geom_line(aes(y = season_adjust,
colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend")) +
labs(y = "",
title = "Last Five Years of The Gas Data with 300 added to the 10th observation") +
scale_colour_manual(
values = c("gray", "#0072B2", "#D55E00"),
breaks = c("Data", "Seasonally Adjusted", "Trend")
)
when 300 was added to the 10th observation, it caused a large spike in the seasonally adjusted data. The quarterly gas data was taken from a seasonal low point to a relative high point. The addition of 300 to the 10th observation has a relatively small affect on the seasonal component. This is because the seasonal component is uniform for each year and only one data point has changed. It also caused a decreasing trend from early 2008 until middle 2008.
7.6 F
f. Does it make any difference if the outlier is near the end rather than in the middle of the time series?
new_gas2 <- gas
new_gas2$Gas[20] <- new_gas2$Gas[10]+300
new_gas2 %>%
model(classical_decomposition(Gas,type = "multiplicative")) %>%
components() %>%
autoplot() +
ggtitle("Last Five Years of The Gas Data with 300 added to the 10th observation")
new_gas2 %>%
model(classical_decomposition(Gas,type = "multiplicative")) %>%
components() %>%
ggplot(aes(x = Quarter)) +
geom_line(aes(y = Gas, colour = "Data")) +
geom_line(aes(y = season_adjust,
colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend")) +
labs(y = "",
title = "Last Five Years of The Gas Data with 300 added to the last observation") +
scale_colour_manual(
values = c("gray", "#0072B2", "#D55E00"),
breaks = c("Data", "Seasonally Adjusted", "Trend")
)
Adding 300 to the last entry causes a spike at the end of the seasonally adjusted data. The seasonal data is less affected by the change - its pattern more closely matches that of the original data. The trend looks more better, because it looks more increasing and also at the end cause adding 300 at the last observation.
8 Exercise 8
8. Recall your retail time series data (from Exercise 8 in Section 2.10). Decompose the series using X-11. Does it reveal any outliers, or unusual features that you had not noticed previously?
myseries %>%
model(classical_decomposition(Turnover,type = "multiplicative")) %>%
components() %>%
autoplot() +
ggtitle("Multiplicative decomposition of my retail time series data")
myseries %>%
model(x11 = X_13ARIMA_SEATS(Turnover ~ x11())) %>%
components() %>%
autoplot()+
labs(title = "X-11 decomposition of my retail time series data")
Compare both decomposition, the X-11 trend-cycle has captured the sudden fall in the 2000-2010.
9 Exercise 9
9. Figures 3.19 and 3.20 show the result of decomposing the number of persons in the civilian labour force in Australia each month from February 1978 to August 1995.
Figure 3.19: Decomposition of the number of persons in the civilian labour force in Australia each month from February 1978 to August 1995.
Figure 3.20: Seasonal component from the decomposition shown in the previous figure.
9.1 A
a. Write about 3–5 sentences describing the results of the decomposition. Pay particular attention to the scales of the graphs in making your interpretation.
Isolating the trend component from the seasonal component shows that the trend has increased throught the majority of the time frame, with a few stationary periods occuring in the early 90s. The monthly breakdown of the seasonal component shows that a few months show greater velocities in their variations than other months.
9.2 B
b. Is the recession of 1991/1992 visible in the estimated components?
Yes, we see a dip in employment during 1991/1992 that is not explained by seasonality or the positive trend.
10 Exercise 10
10. This exercise uses the canadian_gas data (monthly Canadian gas production in billions of cubic metres, January 1960 – February 2005).
10.1 A
a. Plot the data using autoplot(), gg_subseries() and gg_season() to look at the effect of the changing seasonality over time.1
canadian_gas %>%
autoplot(Volume)+
labs(title = "Monthly Canadian Gas Production",
subtitle = "autoplot()",
y = "billions of cubic meter")+
theme_replace()+
geom_line(col = "#1B89D3")
canadian_gas %>%
gg_subseries(Volume)+
labs(title = "Monthly Canadian Gas Production",
subtitle = "gg_subseries()",
y = "billions of cubic meter")
canadian_gas %>%
gg_season(Volume)+
labs(title = "Monthly Canadian Gas Production",
subtitle = "gg_season()",
y = "billions of cubic meter")
According to the time plot, the canadian_gas data has a clear increasing trend and strong seasonality. This observation is verified in the subseries plot and the seasonal plot as well. In general, the gas production decreases in summer and increases in winter.The seasonality increases dramatically from 1975 to 1990.This results from the larger differences in gas production between summer and winter in those years, shown as the blue and green lines in the seasonal plot.
10.2 B
b. Do an STL decomposition of the data. You will need to choose a seasonal window to allow for the changing shape of the seasonal component.
canadian_gas %>%
model(
STL(Volume ~ trend(window = 21) +
season(window = 13),
robust = TRUE)) %>%
components() %>%
autoplot()+
labs(title = "STL decomposition of Canadian Gas Production")
The results of the STL decomposition are shown above. The trend component adequately represent the trend in the original data. The seasonal component increases from 1975 to 1985, and then decreases. This observation is consistent with the time plot. Besides, the remainder component is around zero.
10.3 C
c. How does the seasonal shape change over time? [Hint: Try plotting the seasonal component using gg_season().]
As shown above, the seasonal shape is flat from beginning and then as the time goes by the seasonal shape increases. In year 1960 there is no trend-cycle, we can say the gas production didn’t really a trend in that time. After year 1975 there is a trend-cycle, hence the gas production increases at that time and so on.
10.4 D
d. Can you produce a plausible seasonally adjusted series?
canadian_gas %>%
model(
STL(Volume ~ trend(window = 21) +
season(window = 13),
robust = TRUE)) %>%
components() %>%
ggplot(aes(x = Month)) +
geom_line(aes(y = Volume, colour = "Data")) +
geom_line(aes(y = season_adjust,
colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend")) +
labs(title = "STL decomposition of Canadian Gas Production") +
scale_colour_manual(
values = c("gray", "#0072B2", "#D55E00"),
breaks = c("Data", "Seasonally Adjusted", "Trend")
)
10.5 E
e. Compare the results with those obtained using SEATS and X-11. How are they different?
canadian_gas %>%
model(x11 = X_13ARIMA_SEATS(Volume ~ x11())) %>%
components() %>%
autoplot()+
labs(title = "X-11 decomposition of Canadian Gas Production")
canadian_gas %>%
model(seats = X_13ARIMA_SEATS(Volume ~ seats())) %>%
components() %>%
autoplot() +
labs(title ="SEATS Decomposition of Canadian Gas Production")
The results of SEATS and X11 decomposition are shown above. The decomposed trend and seasonal components are similar. The changes of seasonality are different from the original data. The differences of seasonally adjusted time series are very minimal between these two method.
In addition, the remainder component of the SEATS decomposition is larger than that of the X11 decomposition, where both remainders are around one. The remainder component of the STL decomposition is smaller. Thus, we can conclude that the STL decomposition fits the cangas data better.