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 |>autoplot(GDP / Population, show.legend =FALSE) +labs(title ="GDP per capita for each country over time", x ="Year", y ="GDP per capita ($US)")
Warning: Removed 3242 rows containing missing values or values outside the scale range
(`geom_line()`).
The country Monaco has the highest GDP per capita.
global_economy |>filter(Country =="Monaco") |>autoplot(GDP / Population) +labs(title ="Monaco GDP per capita over time", x ="Year", y ="GDP per capita ($US)")
Warning: Removed 11 rows containing missing values or values outside the scale range
(`geom_line()`).
Monaco’s GDP per capita has drastically changed from below $25,000 in 1970 to more than $150,000 in 2015. This is over a 6x multiplier. There have been some dips in between though so it wasn’t all sunshine and rainbows.
Exercise 3.2
For each of the following series, make a graph of the data. If transforming seems appropriate, do so and describe the effect.
United States GDP from global_economy.
global_economy |>filter(Country =="United States") |>autoplot(GDP) +labs(title="GDP of the United States", y ="$US")
Here is the plot for the GDP of the United States. It looks like the GDP value is increasing exponentially.
global_economy |>filter(Country =="United States") |>autoplot(log(GDP)) +labs(title ="GDP of the United States (Log Scale)", y ="Log $US")
Here I took the log scale of the GDP value and it shows a different picture, the rate of increase slows down over time instead of an exponential increase.
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", y ="Count")
This plot shows that the number of bulls, bullocks and steers are decrease over time in Victoria.
aus_livestock |>filter(Animal =="Bulls, bullocks and steers", State =="Victoria") |>autoplot(log(Count)) +labs(title="Slaughter of Victorian Bulls, bullocks and steers", y ="Count")
aus_livestock |>filter(Animal =="Bulls, bullocks and steers", State =="Victoria") |>features(Count, features = guerrero)
# A tibble: 1 × 3
Animal State lambda_guerrero
<fct> <fct> <dbl>
1 Bulls, bullocks and steers Victoria -0.0446
aus_livestock |>filter(Animal =="Bulls, bullocks and steers", State =="Victoria") |>autoplot(box_cox(Count, -0.04461887)) +labs(y ="Box-Cox transformed Count")
Tried a couple transformations like the log and Box-Cox with an optimal lamba value gotten from the guerrero feature and they don’t seem to change the plot much.
Victorian Electricity Demand from vic_elec.
vic_elec |>autoplot(Demand) +labs(title="Victorian Electricity Demand", y ="MWh")
vic_elec |>features(Demand, features = guerrero)
# A tibble: 1 × 1
lambda_guerrero
<dbl>
1 0.0999
vic_elec |>autoplot(box_cox(Demand, 0.09993089 )) +labs(title="Victorian Electricity Demand", y ="MWh")
Seems no transformation was needed. Using the log scale and Box-Cox seem to have no effect.
Gas production from aus_production.
aus_production |>autoplot(Gas) +labs(title="Gas production", y ="petajoules")
aus_production |>features(Gas, features = guerrero)
# A tibble: 1 × 1
lambda_guerrero
<dbl>
1 0.110
aus_production |>autoplot(box_cox(Gas, 0.1095171 )) +labs(title="Gas production", y ="petajoules")
Using an optimal Box_Cox transformation for the gas production shows a completely different story from the original plot. Instead of a seemingly linear increase from 1970-2010, it is more like a big increase in the 1970s that tapers off into a smaller increase in the 2000s.
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 ="billions of cubic metres")
canadian_gas |>features(Volume, features = guerrero)
# A tibble: 1 × 1
lambda_guerrero
<dbl>
1 0.577
canadian_gas |>autoplot(box_cox(Volume, 0.5767648)) +labs(title="Canadian gas production", y ="billions of cubic metres")
A Box_Cox transformation is not helpful because the variation at the top and bottom ends are already very similar before the transformation. Therefore it looks almost identical to the original plot.
Exercise 3.4
What Box-Cox transformation would you select for your retail data (from Exercise 7 in Section 2.10)?
myseries |>features(Turnover, features = guerrero)
# A tibble: 1 × 3
State Industry lambda_guerrero
<chr> <chr> <dbl>
1 New South Wales Other retailing n.e.c. 0.170
myseries |>autoplot(Turnover) +labs(title="Other retailing n.e.c. in New South Wales", y ="Turnover")
Looking at this plot, the variations are definitely not the same at the upper and lower ends. Therefore I will use a Box_Cox transformation with a lambda value taken from the gurrero feature.
myseries |>autoplot(box_cox(Turnover, 0.1704623)) +labs(title="Other retailing n.e.c. in New South Wales", y ="Turnover")
This transformed plot looks a lot better, the variations are similar on the upper and lower ends now. For this retail data example (seed 8585), I would use a Box_Cox transformation lambda value of 0.1704623.
Exercise 3.5
For the following series, find an appropriate Box-Cox transformation in order to stabilize the variance. Tobacco from aus_production, Economy class passengers between Melbourne and Sydney from ansett, and Pedestrian counts at Southern Cross Station from pedestrian.
Tobacco from aus_production
aus_production |>autoplot(Tobacco) +labs(title="Australian Tobacco Production", y ="tonnes")
Warning: Removed 24 rows containing missing values or values outside the scale range
(`geom_line()`).
aus_production |>features(Tobacco, features = guerrero)
# A tibble: 1 × 1
lambda_guerrero
<dbl>
1 0.926
aus_production |>autoplot(box_cox(Tobacco, 0.9264636)) +labs(title="Australian Tobacco Production", y ="tonnes")
Warning: Removed 24 rows containing missing values or values outside the scale range
(`geom_line()`).
I used the guerrero feature to grab a lambda value of “0.9264636” for the Box_Cox transformation in order to stabilize the variance. It didn’t look like it made much of a difference though as the two plots are very similar.
Economy class passengers between Melbourne and Sydney from ansett
ansett |>filter(Class =="Economy", Airports =="MEL-SYD") |>autoplot(Passengers) +labs(title="Economy class passengers between Melbourne and Sydney", y ="Count")
ansett |>filter(Class =="Economy", Airports =="MEL-SYD") |>features(Passengers, features = guerrero)
# A tibble: 1 × 3
Airports Class lambda_guerrero
<chr> <chr> <dbl>
1 MEL-SYD Economy 2.00
ansett |>filter(Class =="Economy", Airports =="MEL-SYD") |>autoplot(box_cox(Passengers, 1.999927)) +labs(title="Economy class passengers between Melbourne and Sydney", y ="Count")
For this plot, the guerrero feature returned a lambda value of “1.999927” for the Box_Cox transformation in order to stabilize the variance. This also didn’t seem to have much of an effect on the plot since the value is close to 2.
Pedestrian counts at Southern Cross Station from pedestrian
pedestrian |>filter(Sensor =="Southern Cross Station") |>autoplot(Count) +labs(title="Pedestrian counts at Southern Cross Station", y ="Count")
pedestrian |>filter(Sensor =="Southern Cross Station") |>features(Count, features = guerrero)
# A tibble: 1 × 2
Sensor lambda_guerrero
<chr> <dbl>
1 Southern Cross Station -0.250
pedestrian |>filter(Sensor =="Southern Cross Station") |>autoplot(box_cox(Count, -0.2501616)) +labs(title="Pedestrian counts at Southern Cross Station", y ="Count")
For this pedestrian plot, the guerrero feature returned a lambda value of “-0.2501616” for the Box_Cox transformation in order to stabilize the variance. This did make the a noticeable difference compared to the plot pre transformation.
Exercise 3.7
Consider the last five years of the Gas data from aus_production.
gas <- tail(aus_production, 5*4) |> select(Gas)
Plot the time series. Can you identify seasonal fluctuations and/or a trend-cycle?
gas <-tail(aus_production, 5*4) |>select(Gas)gas |>autoplot(Gas) +labs(title ="Last five years of Australian gas production", y ="Gas production in petajoule")
Looking at this graph, there is definitely seasonal fluctuations and it looks like the trend is a slight positive one. The seasonal fluctuations look the it peaks in the middle of the year which is winter for Australia and then drops at the beginning and end of each year which is summer in Australia. This makes sense considering in colder months, gas is used to heat up homes.
Use classical_decomposition with type=multiplicative to calculate the trend-cycle and seasonal indices.
Do the results support the graphical interpretation from part a?
gas |>model(classical_decomposition(Gas, type ="multiplicative") ) |>components() |>autoplot(Gas) +labs(title ="Classical multiplicative decomposition of gas production in Australia for the last 5 years")
Warning: Removed 8 rows containing missing values or values outside the scale range
(`geom_line()`).
The results do support my interpretations above since the trend shows a slight increase and the seasonal shows peaks in the middle of the year and dips at the beginning and end of each year.
Compute and plot the seasonally adjusted data.
gas |>model(classical_decomposition(Gas, type ="multiplicative") ) |>components() |>as_tsibble() |>autoplot(Gas, colour ="gray") +geom_line(aes(y=season_adjust), colour ="blue") +labs(title ="Seasonally adjusted gas production in Australia for the last 5 years", y ="Gas production in petajoule")
The blue seasonally adjusted line shows the trend better because the seasonal ups and downs are flatten out.
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?
gas_outlier <- gas |>mutate(Gas =if_else(row_number() ==1, Gas +300, Gas))gas_outlier |>model(classical_decomposition(Gas, type ="multiplicative") ) |>components() |>as_tsibble() |>autoplot(Gas, colour ="gray") +geom_line(aes(y=season_adjust), colour ="blue") +labs(title ="Seasonally adjusted gas production in Australia for the last 5 years", y ="Gas production in petajoule")
Changing the first value of the data by adding 300 to it, made a massive difference to the plot. Instead of being a gradual rise, the graph turns into a massive fall at the beginning.
Does it make any difference if the outlier is near the end rather than in the middle of the time series?
gas_outlier_end <- gas |>mutate(Gas =if_else(row_number() ==19, Gas +300, Gas))gas_outlier_end |>model(classical_decomposition(Gas, type ="multiplicative") ) |>components() |>as_tsibble() |>autoplot(Gas, colour ="gray") +geom_line(aes(y=season_adjust), colour ="blue") +labs(title ="Seasonally adjusted gas production in Australia for the last 5 years", y ="Gas production in petajoule")
gas_outlier_middle <- gas |>mutate(Gas =if_else(row_number() ==10, Gas +300, Gas))gas_outlier_middle |>model(classical_decomposition(Gas, type ="multiplicative") ) |>components() |>as_tsibble() |>autoplot(Gas, colour ="gray") +geom_line(aes(y=season_adjust), colour ="blue") +labs(title ="Seasonally adjusted gas production in Australia for the last 5 years", y ="Gas production in petajoule")
It does make a difference if the outlier is near the end vs near the middle. It moves the massive spike to wherever the outlier is.
Exercise 3.8
Recall your retail time series data (from Exercise 7 in Section 2.10). Decompose the series using X-11. Does it reveal any outliers, or unusual features that you had not noticed previously?
set.seed(8585)myseries <- aus_retail |>filter(`Series ID`==sample(aus_retail$`Series ID`,1))x11_dcmp <- myseries |>model(x11 =X_13ARIMA_SEATS(Turnover ~x11())) |>components()autoplot(x11_dcmp) +labs(title ="Decomposition of Other retailing n.e.c. in New South Wales using X-11.")
The X-11 decomposition reveals some unusual features. In the irregular panel on the bottom, there is a unusual spike around 2000-2001, and then very high variance in that same panel after 2010. Seems like it was really unpredictable during those times. Also the seasonal panel had smaller spikes after 2010 than it did previously which probably means that retail was becoming less seasonal and more regular.
Exercise 3.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.
Write about 3–5 sentences describing the results of the decomposition. Pay particular attention to the scales of the graphs in making your interpretation.
Looking at the panels, you can tell that it is a regular seasonal time series, with the constant up and down pattern. There is an upward increase for the trend and the value. The remainder panel shows a massive -400 drop around 1991/1992 due to a recession. Looking at the seasonal decomposition, it seems like December is a really good month whereas January and August are both terrible relative to the rest of the year. The rest of the months kind of float in between the highs of December and the lows of January/August.
Is the recession of 1991/1992 visible in the estimated components?
Yes the recession of 1991/1992 is visible in the value and remainder panel. In the value panel, it goes from steady growth to a irregular dip around 1991/1992. Also in the remainder panel, it is very obviously a crash for that year. In the trend panel, it does kind of flatten out in that year. But in the seasonal panel, you can’t really tell if something happened around that time. It’s like the seasons continued on like normal even if it was a recession.
