Time Series Decomposition

Lab 2

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?

Assuming the packages have been installed, we can start the libraries:

library(fpp3)
## Warning: package 'fpp3' was built under R version 4.4.2
## Registered S3 method overwritten by 'tsibble':
##   method               from 
##   as_tibble.grouped_df dplyr
## ── Attaching packages ──────────────────────────────────────────── fpp3 1.0.1 ──
## ✔ tibble      3.2.1     ✔ tsibble     1.1.6
## ✔ dplyr       1.1.4     ✔ tsibbledata 0.4.1
## ✔ tidyr       1.3.1     ✔ feasts      0.4.1
## ✔ lubridate   1.9.3     ✔ fable       0.4.1
## ✔ ggplot2     3.5.1
## Warning: package 'tsibble' was built under R version 4.4.2
## Warning: package 'tsibbledata' was built under R version 4.4.2
## Warning: package 'feasts' was built under R version 4.4.2
## Warning: package 'fabletools' was built under R version 4.4.2
## Warning: package 'fable' was built under R version 4.4.2
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date()    masks base::date()
## ✖ dplyr::filter()      masks stats::filter()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval()  masks lubridate::interval()
## ✖ dplyr::lag()         masks stats::lag()
## ✖ tsibble::setdiff()   masks base::setdiff()
## ✖ tsibble::union()     masks base::union()
library(tsibble)
library(dplyr)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0     ✔ readr   2.1.5
## ✔ purrr   1.0.2     ✔ stringr 1.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter()     masks stats::filter()
## ✖ tsibble::interval() masks lubridate::interval()
## ✖ dplyr::lag()        masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(readr)
library(ggplot2)
library(gt)
## Warning: package 'gt' was built under R version 4.4.2
library(seasonal)
## Warning: package 'seasonal' was built under R version 4.4.2
## 
## Attaching package: 'seasonal'
## 
## The following object is masked from 'package:tibble':
## 
##     view

First we load the dataset

data("global_economy")

Then we proceed the calculaute the GDP per capita.

global_economy <- global_economy %>%mutate(GDPXcapita = GDP / Population)

And now we plot it:

global_economy %>% ggplot(aes(x = Year, y = GDPXcapita, color = Country)) +
  geom_line(show.legend = FALSE) +
  labs(title = "GDP per Capita Over Time",
       x = "Year",
       y = "GDP per Capita") +
  theme_minimal()
## Warning: Removed 3242 rows containing missing values or values outside the scale range
## (`geom_line()`).

However, the previous plot does not provide information about which country is represented by each geomline. We can focus on the most recent 10 years of data for sake of simplicity.

last_10_years <- max(global_economy$Year, na.rm = TRUE) - 9

And then get the top 10 countries for each year in the past 10 years

top_10_gdp_table <- global_economy %>%
  filter(Year >= last_10_years) %>%
  index_by(Year) %>%  # Use index_by instead of group_by since it's a tsibble
  arrange(desc(GDPXcapita)) %>%
  slice_head(n = 10) %>%
  select(Year, Country, GDPXcapita) %>%
  as_tibble()  # then convert to a regular tibble for table formatting
## Warning: Current temporal ordering may yield unexpected results.
## ℹ Suggest to sort by `Country`, `Year` first.

And from that we can get a table with a more user-friendly format

top_10_gdp_table %>%
  gt() %>%
  tab_header(
    title = "Top 10 Countries by GDP per Capita (Last 10 Years)"
  )
Top 10 Countries by GDP per Capita (Last 10 Years)
Country GDPXcapita
2008
Monaco 180640.13
Liechtenstein 142973.83
Luxembourg 114293.84
Norway 97007.94
Bermuda 93605.75
San Marino 90682.58
Qatar 82967.37
Isle of Man 75490.88
Switzerland 72487.85
Denmark 64322.07
2009
Monaco 149221.36
Liechtenstein 125945.01
Luxembourg 103198.67
Bermuda 88463.31
Norway 80067.18
San Marino 76918.15
Switzerland 69927.47
Isle of Man 69172.19
Qatar 61478.24
Denmark 58163.29
2010
Monaco 144569.18
Liechtenstein 141165.08
Luxembourg 104965.31
Bermuda 88207.33
Norway 87770.27
Switzerland 74605.72
Isle of Man 73935.68
Qatar 70306.23
San Marino 68758.37
Denmark 58041.41
2011
Monaco 162155.50
Liechtenstein 158283.08
Luxembourg 115761.51
Norway 100711.22
Switzerland 88415.63
Bermuda 85973.16
Qatar 85948.07
Isle of Man 81304.85
Macao SAR, China 66813.35
San Marino 65213.62
2012
Monaco 152000.36
Liechtenstein 149295.65
Luxembourg 106749.01
Norway 101668.17
Qatar 88564.82
Bermuda 85458.46
Switzerland 83538.23
Isle of Man 79028.04
Macao SAR, China 76496.37
Australia 67864.69
2013
Liechtenstein 173528.15
Monaco 172588.88
Luxembourg 113625.13
Norway 103059.25
Macao SAR, China 89524.84
Qatar 88304.88
Bermuda 85748.07
Switzerland 85112.46
Isle of Man 82356.82
Australia 67990.29
2014
Monaco 185152.53
Liechtenstein 179308.08
Luxembourg 119225.38
Norway 97199.92
Macao SAR, China 94004.39
Isle of Man 89941.64
Qatar 86852.71
Switzerland 86605.56
Denmark 62548.99
Australia 62327.56
2015
Liechtenstein 167590.61
Monaco 163369.07
Luxembourg 101446.79
Switzerland 82016.02
Isle of Man 81672.02
Macao SAR, China 75484.29
Norway 74498.14
Qatar 65177.23
Ireland 61807.67
Australia 56561.41
2016
Monaco 168010.91
Liechtenstein 164993.19
Luxembourg 100738.68
Switzerland 79866.03
Isle of Man 78730.16
Macao SAR, China 74017.18
Norway 70890.04
Ireland 64100.43
Iceland 60529.93
Qatar 59044.25
2017
Luxembourg 104103.04
Macao SAR, China 80892.82
Switzerland 80189.70
Norway 75504.57
Iceland 70056.87
Ireland 69330.69
Qatar 63249.42
United States 59531.66
North America 58070.07
Singapore 57714.30

Now we can see with the available data top 10 countries with highest GDP per capita over the past 10 years. But this has not cleared up what happens with the countries that were in the top 10, and then suddenly they are no longer included.

So, finally we can try a different visualization that will allow us to see availabla data and then compare rankings

# Compute the average GDP per capita for each country over the last 10 years
country_order <- top_10_gdp_table %>%
  group_by(Country) %>%
  summarise(avg_GDP_per_capita = mean(GDPXcapita, na.rm = TRUE)) %>%
  arrange(desc(avg_GDP_per_capita)) %>%
  pull(Country)  # Extract ordered country names

# Compute rank for each country per year
ranked_gdp_table <- top_10_gdp_table %>%
  group_by(Year) %>%
  arrange(desc(GDPXcapita)) %>%
  mutate(Rank = row_number()) %>%  # assign rank position, to make the plot way easier to read
  ungroup()

# Plot with rank labels inside rectangles
ggplot(ranked_gdp_table, aes(x = Year, y = factor(Country, levels = rev(country_order)), fill = GDPXcapita)) +
  geom_tile(color = "white") +
  geom_text(aes(label = Rank, color = ifelse(GDPXcapita > 120000, "black", "white")), size = 4, fontface = "bold") +  
  scale_color_identity() +  # this ensures we manually control the color
  scale_fill_viridis_b(option = "plasma", n.breaks = 7) +
  labs(title = "Top 10 Countries by GDP per Capita (Last 10 Years)",
       x = "Year",
       y = "Country (Ranked by Average GDP per Capita)",
       fill = "GDP per Capita") +
theme_minimal(base_size = 12) + 
theme(plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
      legend.position = "right",
      axis.text.x = element_text(angle = 45, hjust = 1))

Now we can finally answer the original question, by finding that Monaco has been consistently the country with highest GDP per capita for at least 7 of the last 10 years, indicating a small but wealthy population

This plot also highlights the problems with missing data, since we could expect Monaco and Liechtenstein to have similar values in 2017 as they did in 2016. However, since we don’t have that information the plot shows that for 2017 Luxembourg had the highest GDP per capita.

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.

We can start by filtering for United States GDP

us_gdp <- global_economy %>%
  filter(Country == "United States") %>%
  select(Year, GDP)

And plotting:

autoplot(us_gdp, GDP) +
  labs(title = "United States GDP Over Time",
       x = "Year", y = "GDP (Billions)") +
  theme_minimal()

However, the since GDP data often grows exponentially a log transformation can help stabilize variance.

us_gdp <- us_gdp %>%
  mutate(log_GDP = log(GDP))

So we have a new plot:

autoplot(us_gdp, log_GDP) +
  labs(title = "United States GDP (Log-Transformed)",
       x = "Year", y = "Log(GDP)") +
  theme_minimal()

In this case we can see that the log transformation reduces variance and made the trend a lot more linear.

Slaughter of Victorian “Bulls, Bullocks and Steers” (aus_livestock)

Let’s filter the data we need first

# Filter data for "Bulls, bullocks and steers" in Victoria
victorian_cattle <- aus_livestock %>%
  filter(State == "Victoria", Animal == "Bulls, bullocks and steers")

And plot it:

autoplot(victorian_cattle, Count) +
  labs(title = "Slaughter of Bulls, Bullocks, and Steers in Victoria",
       x = "Year", y = "Slaughter Count") +
  theme_minimal()

We can check for seasonality

gg_season(victorian_cattle, Count) +
  labs(title = "Seasonal Plot: Victorian Slaughter of Bulls, Bullocks, and Steers",
       x = "Month", y = "Slaughter Count") +
  theme_minimal()

victorian_cattle <- victorian_cattle %>%
  mutate(log_Count = log(Count))
autoplot(victorian_cattle, log_Count)

The variance has stabilized, making trends more apparent and the high values in early years are now more controlled, but seasonality is still present, so seasonal differencing is needed.

# seasonal differencing (lag = 12 for annual cycles)
victorian_cattle <- victorian_cattle %>%
  mutate(Seasonal_Diff = difference(Count, lag = 12))

autoplot(victorian_cattle, Seasonal_Diff) +
  labs(title = "Seasonally Differenced Slaughter of Bulls, Bullocks, and Steers in Victoria",
       x = "Year", y = "Seasonal Difference (Count)") +
  theme_minimal()
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_line()`).

The annual cycles seen in the original plot have been mostly eliminated, with the data now fluctuating around zero, which is a sign that seasonality was effectively differenced out. However, the presence of large swings at the beginning of the graph suggests that the variance may not be fully stabilized.

Victorian Electricity Demand from vic_elec.

Again, we start by plotting electricity demand over time

autoplot(vic_elec, Demand) +
  labs(title = "Victorian Electricity Demand Over Time",
       x = "Time", y = "Electricity Demand (MW)") +
  theme_minimal()

This plot shows high volatility and clear seasonality

# Apply differencing to remove trends
vic_elec <- vic_elec %>%
  mutate(Diff_Demand = difference(Demand))

# Plot differenced data
autoplot(vic_elec, Diff_Demand) +
  labs(title = "Differenced Victorian Electricity Demand",
       x = "Time", y = "Differenced Demand") +
  theme_minimal()
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_line()`).

The second plot (differenced data) removes the trend but still shows seasonality. Differencing helped reduce the long-term trend but seasonality is still present.

vic_elec <- vic_elec %>%
  mutate(log_Demand = log(Demand))
autoplot(vic_elec, log_Demand)

vic_elec <- vic_elec %>%
  mutate(Seasonal_Diff = difference(Demand, lag = 365))
autoplot(vic_elec, Seasonal_Diff)
## Warning: Removed 365 rows containing missing values or values outside the scale range
## (`geom_line()`).

The seasonal differencing helped reduce repeating yearly cycles, so the plot is more “stationary” than before, but the hight volatility in demand shows some extreme spikes remaining.

Gas production from aus_production.

For gas production we start with plotting

# Plot original gas production data
autoplot(aus_production, Gas) +
  labs(title = "Australian Gas Production Over Time",
       x = "Year", y = "Gas Production (Petajoules)") +
  theme_minimal()

We see a strong increasing trend and seasonality. So first we can start by applying a log transformation. We can plot after that to check for changes.

aus_production <- aus_production %>%
  mutate(log_Gas = log(Gas))

autoplot(aus_production, log_Gas) +
  labs(title = "Log-Transformed Australian Gas Production",
       x = "Year", y = "Log(Gas Production)") +
  theme_minimal()

The second plot (log-transformed gas production) makes growth more linear.

# Seasonal decomposition
gas_decomp <- aus_production %>%
  model(STL(Gas ~ season(window = "periodic"))) %>%
  components()

# Plot decomposition
autoplot(gas_decomp) +
  labs(title = "Seasonal Decomposition of Australian Gas Production") +
  theme_minimal()

Finally, the third plot (seasonal decomposition) clearly shows trend and seasonality components.

3.3

Why is a Box-Cox transformation unhelpful for the canadian_gas data?

First we should check the plot

autoplot(canadian_gas)
## Plot variable not specified, automatically selected `.vars = Volume`

We see a consistent range of fluctuations, rather than an increasing spread.

Since the box-cox transformation is most useful when variance increases over time, and the plot does not show a strong increase in variance over time, the box-cox transformation is not necessary. The plot may show strong seasonality but the box-cox transformation does not help with this.

Since seasonality is the most prominent feature, we should try seasonal differencing

canadian_gas <- canadian_gas %>%
  mutate(Seasonal_Diff = difference(Volume, lag = 12))

autoplot(canadian_gas, Seasonal_Diff) +
  labs(title = "Seasonally Differenced Canadian Gas Production",
       x = "Year", y = "Differenced Volume") +
  theme_minimal()
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_line()`).

This effectively removes the repeating annual patterns while preserving important trends.

3.4

What Box-Cox transformation would you select for your retail data (from Exercise 7 in Section 2.10)?

Since this exercise was not previously explored we can quickly take a look a the data

# seed
set.seed(86863)

# Select a random time series from aus_retail
myseries <- aus_retail %>%
  filter(`Series ID` == sample(aus_retail$`Series ID`, 1))

# Check the selected series
glimpse(myseries)
## Rows: 441
## Columns: 5
## Key: State, Industry [1]
## $ State       <chr> "New South Wales", "New South Wales", "New South Wales", "…
## $ Industry    <chr> "Takeaway food services", "Takeaway food services", "Takea…
## $ `Series ID` <chr> "A3349792X", "A3349792X", "A3349792X", "A3349792X", "A3349…
## $ Month       <mth> 1982 Apr, 1982 May, 1982 Jun, 1982 Jul, 1982 Aug, 1982 Sep…
## $ Turnover    <dbl> 85.4, 84.8, 80.7, 82.4, 80.7, 82.1, 87.3, 87.4, 97.2, 93.0…
autoplot(myseries, Turnover) +
  labs(title = "Monthly Retail Turnover",
       x = "Year", y = "Turnover") +
  theme_minimal()

Thankfully, instead of guessing what transformation would be best we can use the Guerrero method to select the optimal transformation parameter (making variance across segments as stable as possible ).

# Compute the optimal Box-Cox transformation parameter (lambda)
lambda <- myseries |> 
  features(Turnover, features = guerrero) |> 
  pull(lambda_guerrero)

# Print the lambda value
lambda
## [1] 0.002144737

We find a lambda of 0.002. Since it’s so close to 0, we should use a log transformation

# Apply the suggested Box-Cox transformation, the log transformation
myseries <- myseries %>%
  mutate(log_Turnover = log(Turnover))

autoplot(myseries, log_Turnover) +
  labs(title = paste("Box-Cox log Transformation (lambda =", round(lambda, 3), ")"),
       x = "Year", y = "Transformed Turnover") +
  theme_minimal()

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?

The x-11 method will decompose the series into 3 components: trend-cycle, seasonal, and irregular.

x11_myseries <- myseries %>%  model(X_11 = X_13ARIMA_SEATS(log_Turnover ~ x11())) %>%  components()

autoplot(x11_myseries) +
  labs(title = "X-11 Decomposition of Retail Turnover") +
  theme_minimal()

The resulting plot shows fluctuations in the irregular component, which indicate potential outliers. We can also see that the seasonal pattern is getting more pronounced over time. The trend shows a little dip around 2000s (economic recession?). And the irregular component shows sharp movements.

3.5

For the following series, find an appropriate Box-Cox transformation in order to stabilise the variance:

Similar to the previous exercise, we can use again the Guerrero method to find optimal lambda for each dataset

Tobacco from aus_production

Finding lambda

lambda_tobacco <- aus_production |> features(Tobacco, features = guerrero) |> pull(lambda_guerrero)

lambda_tobacco
## [1] 0.9264636

As we get a lambda close to 1, it indicates that it either does not need any transformation, or we can simply use a mild power transformation such as:

aus_production <- aus_production %>%
  mutate(Transformed_Tobacco = Tobacco^0.9264636)

Then we plot initial versus transformed data for comparison.

autoplot(aus_production, Tobacco) +
  labs(title = "Original Tobacco Production") +
  theme_minimal()
## Warning: Removed 24 rows containing missing values or values outside the scale range
## (`geom_line()`).

autoplot(aus_production, Transformed_Tobacco) +
  labs(title = "Transformed Tobacco Production (lambda = 0.926)") +
  theme_minimal()
## Warning: Removed 24 rows containing missing values or values outside the scale range
## (`geom_line()`).

In the original plot there is some seasonality and fluctuations in variance, but they are not extreme. After the transformation, since lambda was close to 1, the transformation had a mild effect, resulting in scale that is different, but the general pattern remains the same.

Economy class passengers between Melbourne and Sydney from ansett

Finding lambda

lambda_passengers <- ansett |>   
  filter(Airports == "MEL-SYD") |>  
  features(Passengers, features = guerrero) |>   
  pull(lambda_guerrero)

lambda_passengers
## [1] -0.8999268  1.9999268 -0.8999268

We should use inverse transformation such as:

ansett <- ansett %>%
  filter(Airports == "MEL-SYD") %>%
  mutate(Transformed_Passengers = 1 / Passengers)

Then we plot initial versus transformed data for comparison.

autoplot(ansett, Passengers) +
  labs(title = "Original Economy Class Passengers (Melbourne-Sydney)") +
  theme_minimal()

autoplot(ansett, Transformed_Passengers) +
  labs(title = "Inverse Transformed Passengers (lambda = -0.899)") +
  theme_minimal()

In this case we can see in the original plot that the green line shows significant fluctuations, with a massive drop around 1990 W01, while red and blue lines have relatively lower counts but show some spikes. There is a strong seasonal pattern, but variance increases over time, which is why a transformation was necessary.

After applying the inverse transformation, the variance is now much more stable, but the 1990 drop now appears as a large spike, indicating that this transformation is highly sensitive to values close to 0.

Pedestrian counts at Southern Cross Station from pedestrian

Finding lambda

lambda_pedestrian <- pedestrian |> 
  filter(Sensor == "Southern Cross Station") |> 
  features(Count, features = guerrero) |> 
  pull(lambda_guerrero)

lambda_pedestrian
## [1] -0.2501616

In this case, a square root transformation is recommended.

pedestrian <- pedestrian %>%
  filter(Sensor == "Southern Cross Station") %>%
  mutate(Transformed_Count = 1 / sqrt(Count))
autoplot(pedestrian, Count) +
  labs(title = "Original Pedestrian Counts (Southern Cross Station)") +
  theme_minimal()

autoplot(pedestrian, Transformed_Count) +
  labs(title = "Inverse Square Root Transformed Pedestrian Counts (lambda = -0.250)") +
  theme_minimal()

The original plot shows strong periodicity, with daily and weekly cycles, and very unstable variance.

Since lambda was - 0.250, we applied an inverse square root transformation, which reduced the magnitude of extreme peaks, helping to stabilize variance

3.7

Consider the last five years of the Gas data from aus_production. gas <- tail(aus_production, 5x4)|> select(Gas)

a)

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

After extracting last 5 years (4 quarters each) of data we proceed to plot

gas <- tail(aus_production, 5 * 4) |> select(Gas)

autoplot(gas) +
  labs(title = "Gas Production (2005-Q3 to 2010-Q2)",
       x = "Year", y = "Gas Production") +
  theme_minimal()
## Plot variable not specified, automatically selected `.vars = Gas`

The plot shows clear seasonality: gas production peaks and drops in a regular pattern every year, with Q3 and Q4 having higher production.

b)

Use classical_decomposition with type=multiplicative to calculate the trend-cycle and seasonal indices.

class_decomp_gas <- gas |> model(classical_decomposition(Gas, type = "multiplicative")) |>  components()

autoplot(class_decomp_gas) +
  labs(title = "Multiplicative Classical Decomposition of Gas Production")
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_line()`).

The second panel (trend) shows a slight upward movement over time. The third panel (seasonal) shows a repeating quarterly pattern, meaning seasonality is stable. The third panel (random) is relatively small, meaning most variations are explained by trend and seasonality.

c)

Do the results support the graphical interpretation from part a?

Yes. The decomposition makes evident the observations made, as it shows clear repeating patterns, and slight upward trend.

d)

So, to remove the seasonal component of the data and plot it:

decomp_gas_seasonally_adjusted <- class_decomp_gas |>
  mutate(Seasonally_Adjusted = Gas / seasonal)


autoplot(decomp_gas_seasonally_adjusted, Seasonally_Adjusted) +
  labs(title = "Seasonally Adjusted Gas Production",
       x = "Year", y = "Gas Production (Seasonally Adjusted)") +
  theme_minimal()

This time we can see that the seasonal pattern is no longer visible, allowing us to observe the underlying trend more clearly.

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?

First, introducing an outlier, in this case I wanted to include 800

gas_with_outlier <- gas
gas_with_outlier$Gas[10] <- gas_with_outlier$Gas[10] + 800

Then apply classical decomposition

decomp_gas_with_outlier <- gas_with_outlier |> 
  model(classical_decomposition(Gas, type = "multiplicative")) |> 
  components()

Finally, plot it:

autoplot(decomp_gas_with_outlier) +
  labs(title = "Effect of Outlier on Multiplicative Classical Decomposition",
       x = "Year") +
  theme_minimal()
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_line()`).

The outlier is right in the middle of the plot, creating huge spike in gas production heavily distorting the trend. Although overall shape of seasonality does not change as much, the indices show higher fluctuations, making them less reliable. Finally, the outlier creates a massive spike in the residual component.

f)

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

It should, but we can test this visually by adding an outlier towards the end of the plot

gas_outlier_end <- gas
gas_outlier_end$Gas[nrow(gas_outlier_end)] <- gas_outlier_end$Gas[nrow(gas_outlier_end)] + 800

decomp_gas_outlier_end <- gas_outlier_end |>  model(classical_decomposition(Gas, type = "multiplicative")) |>   components()

autoplot(decomp_gas_outlier_end) +
  labs(title = "Effect of Outlier at the End on Multiplicative Classical Decomposition",
       x = "Year") +
  theme_minimal()
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_line()`).

The trend in this case overreacts near the end, making future values unreliable. Interestingly, seasonality is less affected, possibly because all previous cycles are already complete. Finally, the last remainder values are extreme, which may affect forecasting.

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.

knitr::include_graphics(c(
  "C:/Users/lucho/OneDrive/Documents/labour-1.png",
  "C:/Users/lucho/OneDrive/Documents/labour2-1.png"
))

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.

  • The labor force has been increasing consistently, although the rate of growth changes at different times (trend).
  • There are predictable ups and downs in the labor force that happen every year, likely tied to hiring cycles (Seasonality).
  • Some unusual changes appear in the data, especially around the early 1990s (remainder).
  • Certain months regularly show higher or lower labor force numbers, meaning seasonality plays a role.
  • While seasonal changes exist, the overall growth pattern is much stronger, meaning the labor force is steadily increasing despite short-term ups and downs.

b)

Is the recession of 1991/1992 visible in the estimated components? Indeed, the trend line shows a clear flat (dip?) line around 91 or 92, meaning a decline in labor growth, which would make sense given a recession. Where it is most clear is in the remainder component. The seasonality remained stable, meaning the cyles were not impacted but the overall growth was.