Exercise 3.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
## # A tsibble: 15,150 x 9 [1Y]
## # Key:       Country [263]
##    Country     Code   Year         GDP Growth   CPI Imports Exports Population
##    <fct>       <fct> <dbl>       <dbl>  <dbl> <dbl>   <dbl>   <dbl>      <dbl>
##  1 Afghanistan AFG    1960  537777811.     NA    NA    7.02    4.13    8996351
##  2 Afghanistan AFG    1961  548888896.     NA    NA    8.10    4.45    9166764
##  3 Afghanistan AFG    1962  546666678.     NA    NA    9.35    4.88    9345868
##  4 Afghanistan AFG    1963  751111191.     NA    NA   16.9     9.17    9533954
##  5 Afghanistan AFG    1964  800000044.     NA    NA   18.1     8.89    9731361
##  6 Afghanistan AFG    1965 1006666638.     NA    NA   21.4    11.3     9938414
##  7 Afghanistan AFG    1966 1399999967.     NA    NA   18.6     8.57   10152331
##  8 Afghanistan AFG    1967 1673333418.     NA    NA   14.2     6.77   10372630
##  9 Afghanistan AFG    1968 1373333367.     NA    NA   15.2     8.90   10604346
## 10 Afghanistan AFG    1969 1408888922.     NA    NA   15.0    10.1    10854428
## # ℹ 15,140 more rows
global_economy |>
  select(Country, Year, GDP) |>   # just the GDP column, with country and year
  head()
## # A tsibble: 6 x 3 [1Y]
## # Key:       Country [1]
##   Country      Year         GDP
##   <fct>       <dbl>       <dbl>
## 1 Afghanistan  1960  537777811.
## 2 Afghanistan  1961  548888896.
## 3 Afghanistan  1962  546666678.
## 4 Afghanistan  1963  751111191.
## 5 Afghanistan  1964  800000044.
## 6 Afghanistan  1965 1006666638.
gdp_pc <- global_economy |>
  mutate(GDP_per_capita = GDP / Population)   # money per person

top <- gdp_pc |>
  as_tibble() |>
  group_by(Country) |>
  summarise(peak = max(GDP_per_capita, na.rm = TRUE)) |>
  slice_max(peak, n = 3) |>
  pull(Country)

ggplot(gdp_pc, aes(x = Year, y = GDP_per_capita, group = Country)) +
  geom_line(colour = "thistle") +
  geom_line(data = filter(gdp_pc, Country %in% top),
            aes(colour = Country), linewidth = 1) +
  labs(title = "GDP per capita by country", y = "US$ per person")

gdp_pc |>
  as_tibble() |>
  group_by(Year) |>
  slice_max(GDP_per_capita, n = 1) |>
  ungroup() |>
  count(Country, sort = TRUE)       # how many years each country was #1
## # A tibble: 6 × 2
##   Country                  n
##   <fct>                <int>
## 1 Monaco                  43
## 2 United States            8
## 3 Kuwait                   2
## 4 Liechtenstein            2
## 5 United Arab Emirates     2
## 6 Luxembourg               1
gdp_pc |>
  as_tibble() |>
  slice_max(GDP_per_capita, n = 1) |>
  select(Year, Country, GDP_per_capita)   # GDP of the leading country
## # A tibble: 1 × 3
##    Year Country GDP_per_capita
##   <dbl> <fct>            <dbl>
## 1  2014 Monaco         185153.

Findings

Monaco has the highest GDP per capita, leading in 43 of the 58 years and peaking at about $185,000 in 2014. Before Monaco’s data begins in 1970, the United States and Kuwait led. From 1970 on, Monaco stays on top almost every year, with Liechtenstein closing the gap and briefly overtaking it in the 2010s, and the United Arab Emirates and Luxembourg each leading briefly as well. Since 2000 these small, wealthy countries (Monaco, Liechtenstein, Luxembourg) have pulled far ahead of the rest of the world. Missing early data means the pre-1970 leaders may partly reflect which countries had records rather than true rankings.

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

us_gdp <- global_economy |> filter(Country == "United States")

us_gdp |> autoplot(GDP) + labs(title = "US GDP", y = "US$")

Slaughter of Victorian “Bulls, bullocks and steers” in aus_livestock

bulls <- aus_livestock |>
  filter(Animal == "Bulls, bullocks and steers", State == "Victoria")

bulls |> autoplot(Count) + labs(title = "Victorian bulls, bullocks and steers")

Victorian Electricity Demand from vic_elec

vic_elec |> autoplot(Demand) + labs(title = "Victorian electricity demand")

vic_elec |>
  index_by(Date) |>                    # group by day
  summarise(Demand = sum(Demand)) |>
  autoplot(Demand) + labs(title = "Daily electricity demand")

Gas production from aus_production

aus_production |> autoplot(Gas) + labs(title = "Australian gas production")

lambda <- aus_production |>
  features(Gas, features = guerrero) |>   # the lambda that makes the seasonal
                                          # swings most uniform
  pull(lambda_guerrero)

lambda
## [1] 0.1095171
aus_production |>
  autoplot(box_cox(Gas, lambda)) +
  labs(title = paste("Transformed gas, lambda =", round(lambda, 2)))

Findings

US GDP. Demonstrates a smooth upward rise, no seasonality, and stable variation. No transformation needed.

Bulls, bullocks and steers. Downward trend with steady seasonal swings. No transformation needed.

Electricity demand. Half-hourly data is too dense to read, so daily totals are plotted instead. Strong seasonality, stable variation, no transformation needed.

Gas production. Seasonal swings get larger as the series rises, so the variance is unstable. The Guerrero method picks lambda about 0.11, close to a log. After transforming, the swings are about the same size throughout.

Exercise 3.3

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

canadian_gas |>
  autoplot(Volume) +                    # the whole series
  labs(title = "Canadian gas production", y = "Billion cubic metres")

canadian_gas |>
  gg_subseries(Volume)                  # one mini-panel per month

canadian_gas |>
  gg_season(Volume)                     # one line per year, all overlaid

lambda <- canadian_gas |>
  features(Volume, features = guerrero) |>   # the lambda
  pull(lambda_guerrero)                      # the bare number

lambda
## [1] 0.5767648
canadian_gas |>
  autoplot(box_cox(Volume, lambda)) +
  labs(title = paste("Transformed, lambda =", round(lambda, 2)))

Findings

The seasonal variation in canadian_gas does not move consistently with the level. The swings are small in the 1960s, widen through the 1970s and 1980s, then narrow again in the 1990s while the level keeps rising. A Box-Cox transformation assumes variation that changes in one direction with the level, so no single lambda (here 0.58) fixes the whole series. The transformed plot still shows wider swings in the middle years.

Exercise 3.4

What Box-Cox transformation would you select for your retail data?

Exercise 2.7 was not part of Assignment 1, so the retail series is created here using the method given in Section 2.10.

set.seed(2026)

myseries <- aus_retail |>
  filter(`Series ID` == sample(aus_retail$`Series ID`, 1))

myseries |> distinct(State, Industry)
## # A tibble: 1 × 2
##   State           Industry        
##   <chr>           <chr>           
## 1 South Australia Liquor retailing
myseries |> autoplot(Turnover) + labs(title = "Retail turnover")

lambda_retail <- myseries |>
  features(Turnover, features = guerrero) |>
  pull(lambda_guerrero)

lambda_retail
## [1] 0.01610485
myseries |>
  autoplot(box_cox(Turnover, lambda_retail)) +
  labs(title = paste("Transformed, lambda =", round(lambda_retail, 2)))

Findings

The series shows seasonal spikes that grow in proportion to the level, so the variance is unstable. Guerrero selects lambda about 0.02. After transforming, the spikes are about the same size across the series.

Exercise 3.5

Find an appropriate Box-Cox transformation to stabilise the variance for Tobacco from aus_production, Economy class passengers between Melbourne and Sydney from ansett, and Pedestrian counts at Southern Cross Station from pedestrian.

# Tobacco
lam_tob <- aus_production |>
  features(Tobacco, features = guerrero) |> pull(lambda_guerrero)
lam_tob
## [1] 0.9264636
aus_production |>
  autoplot(box_cox(Tobacco, lam_tob)) +
  labs(title = paste("Tobacco, lambda =", round(lam_tob, 2)))

# Economy class, Melbourne-Sydney
econ <- ansett |> filter(Class == "Economy", Airports == "MEL-SYD")

lam_econ <- econ |>
  features(Passengers, features = guerrero) |> pull(lambda_guerrero)
lam_econ
## [1] 1.999927
econ |>
  autoplot(box_cox(Passengers, lam_econ)) +
  labs(title = paste("Economy MEL-SYD, lambda =", round(lam_econ, 2)))

# Southern Cross pedestrians
sx <- pedestrian |> filter(Sensor == "Southern Cross Station")

lam_sx <- sx |>
  features(Count, features = guerrero) |> pull(lambda_guerrero)
lam_sx
## [1] -0.2501616
sx |>
  autoplot(box_cox(Count, lam_sx)) +
  labs(title = paste("Southern Cross, lambda =", round(lam_sx, 2)))

Findings

Tobacco. Lambda is about 0.93, close to 1, so the transformation barely changes the series. The variation is already fairly stable, so no transformation is really needed.

Economy MEL-SYD. Lambda is about 2, at the upper limit of the search range, meaning Guerrero found no useful variance-stabilising transformation. The main features are the zero-passenger period during the 1989 pilots’ dispute and sudden level shifts, neither of which Box-Cox addresses.

Southern Cross. Lambda is about -0.25, stronger than a log. It stabilizes the variance across the two years, but the series is dominated by a strong daily cycle with near-zero overnight counts, so at hourly resolution the plot is too dense to read either way. The transformation is technically appropriate but doesn’t make the series easier to interpret.

Exercise 3.7

Consider the last five years of the Gas data from aus_production.

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

# (a) plot
gas |> autoplot(Gas) + labs(title = "Gas production, last 5 years")

# (b) classical multiplicative decomposition
gas |>
  model(classical_decomposition(Gas, type = "multiplicative")) |>
  components() |>
  autoplot()

# (d) seasonally adjusted data
gas_comp <- gas |>
  model(classical_decomposition(Gas, type = "multiplicative")) |>
  components()

gas_comp |>
  as_tsibble() |>
  autoplot(season_adjust) +
  labs(title = "Seasonally adjusted")

# (e) outlier in the middle
gas_out <- gas |> mutate(Gas = if_else(row_number() == 10, Gas + 300, Gas))

gas_out |>
  model(classical_decomposition(Gas, type = "multiplicative")) |>
  components() |>
  as_tsibble() |>
  autoplot(season_adjust) +
  labs(title = "Outlier in the middle")

# (f) outlier near the end
gas_end <- gas |> mutate(Gas = if_else(row_number() == 19, Gas + 300, Gas))

gas_end |>
  model(classical_decomposition(Gas, type = "multiplicative")) |>
  components() |>
  as_tsibble() |>
  autoplot(season_adjust) +
  labs(title = "Outlier near the end")

Findings

(a) Clear yearly seasonality, lowest in Q1 and peaking in Q3, plus a mild upward trend-cycle: both troughs and peaks rise from 2006 to 2010.

(c) Yes. The trend component rises from about 200 to 230, and the seasonal indices run from 1.12 in Q3 to 0.88 in Q1, matching the plot. The remainder stays within about 2%.

(d) With seasonality removed, the sawtooth disappears and the underlying rise from about 195 to 234 is clear. The remaining wiggles are trend-cycle and random variation.

(e) The outlier creates a spike to about 450, but it also distorts the whole series: the adjusted values turn jagged in years with no outlier. Classical decomposition averages each quarter across all years, so one extreme value contaminates that quarter’s index everywhere.

(f) Yes. Near the end, the earlier years stay smooth and the damage is local to the spike. In the middle, the outlier falls inside many more moving-average windows, so it corrupts the trend and seasonal estimates across the whole series.

Exercise 3.8

Decompose your retail series using X-11. Does it reveal any outliers or unusual features?

myseries |>
  model(x11 = X_13ARIMA_SEATS(Turnover ~ x11())) |>
  components() |>
  autoplot() +
  geom_vline(xintercept = as.Date(c("1995-01-01", "2017-01-01")),
             colour = "firebrick", linetype = "dashed") +
  labs(title = "X-11 decomposition of retail turnover")

Findings

The X-11 decomposition demonstrates a rising trend with a noticeable step around 1995 and a flattening after about 2017. The seasonal component is dominated by a December peak that grows over time, from roughly 1.5 times the trend in the 1980s to about 1.7 times in recent years, so the seasonal pattern is not constant. The irregular component mostly stays within about 5%, but a cluster of unusually large spikes appears around 1988 to 1990, reaching roughly 0.8 and 1.25. These outliers were not visible in the original plot, where they are hidden by the strong seasonal spikes.

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.

  1. Write about 3-5 sentences describing the results of the decomposition.
  2. Is the recession of 1991/1992 visible in the estimated components?

Findings

(a) The STL shows the split of the series into trend, seasonal, and remainder. The trend rises from about 6,500 to 9,000 thousand persons over the period, with a visible plateau in the early 1990s. The seasonal component is small by comparison, swinging roughly +/-100 thousand against a level near 8,000, which the grey scale bars confirm. Figure 3.20 shows this seasonality is not fixed: December is the strongest positive month and January and August the strongest negative, while March weakens noticeably after the mid-1980s. The remainder is mostly within +/-100 except for one large negative episode in the early 1990s.

(b) Yes it is. The recession shows in both components: the trend flattens around 1991 to 1992, and the remainder drops to close to -400, far outside its usual range. The size of that remainder means the fall in the labour force was too abrupt for the smooth trend to absorb.