The plot of the GDP for all the countries over time indicates that Luxembourg has the highest GDP per Capita followed by Macao. These two GDPs per capita increased notably since the early 2000s compared with most other GDPs per capita.
plot_data <- global_economy |> drop_na(Year, GDP, Population, Country) |> mutate(gdp_per_capita = GDP / Population)
top5 <- plot_data |> filter(Year == max(Year)) |> slice_max(gdp_per_capita, n = 5, with_ties = FALSE) |> pull(Country)
plot_data |> ggplot(aes(x = Year, y = GDP / Population, colour = Country)
) +
geom_line(na.rm = TRUE) + scale_colour_discrete(breaks = top5) + labs(y = "GDP per capita")
The GDP for the US plotted below without any transformation.
us_data <- global_economy |> filter(Country == "United States")
us_data |> autoplot(GDP) + labs(title = "US GDP")
Below is the plot the US GDP adjusted Per Capita.
us_data |> autoplot(GDP/Population) + labs(title = "US GDP Per Capita")
Below is a plot of Bulls, bullocks and steers slaughtered by month and year. There is no transformation made. A transformation based on days per month might be considered but without knowing more about when slaughtering occurs, this transformation would be not clearly justified by the information available.
bulls <- aus_livestock |> filter(Animal == "Bulls, bullocks and steers", State == "Victoria")
bulls |> autoplot(Count) + labs(x = "Year Month", y = "Number slaughtered"){width=672}
Below is the plot of Victorian electricity demand. The plot shows seasonality and the high peaks are likely meaningful demand data. There does not appear to be a compelling reason to transform this data.
vic_elec |> autoplot(Demand)
The original Gas production data shows variation that increases as the level changes. It will benefit from mathematical transformations.
aus_production |> autoplot(Gas) + labs(title = "Australian Gas Production")
Below is the same data after a Box-Cox transformation.
lambda <- aus_production |> features(Gas, features = guerrero) |> pull(lambda_guerrero)
aus_production |> autoplot(box_cox(Gas, lambda)) + labs(y = "", title = latex2exp::TeX(paste0("Transformed Australia gas production with $\\lambda$ = ", round(lambda,2))))
canadian_gas |> autoplot(Volume) + labs(title = "Canadian Gas Production")
lambda <- canadian_gas |> features(Volume, features = guerrero) |> pull(lambda_guerrero)
canadian_gas |> autoplot(box_cox(Volume, lambda)) + labs(y = "", title = latex2exp::TeX(paste0("Transformed Canadian gas production with $\\lambda$ = ", round(lambda,2))))
The Box-Cox transformation is ineffective because the change in variation increases in the mid-range of the data and then decreases again. The seasonal variation does not maintain a consistent relationship with the series level.
The Australian retail data without transformation is plotted below. There is an increase in variation as the level of the data increases.
set.seed(47)
myseries <- aus_retail |> filter(`Series ID` == sample(aus_retail$`Series ID`, 1))
myseries |> autoplot(Turnover)
After some experimenting it appears that a natural log transformation or a lambda of 0, transforms the seasonal variations so they are more consistent across the dataset.
myseries |> autoplot(box_cox(Turnover, 0.0)) + labs(y = "", title = latex2exp::TeX(paste0("Transformed Australia Retail Turnover with $\\lambda$ = 0.0")))
When using the Guerrero method to calculate lambda, a lambda of -0.08 is calculated, very close to the estimated 0.0.
lambda <- myseries |> features(Turnover, features = guerrero) |> pull(lambda_guerrero)
myseries |> autoplot(box_cox(Turnover, lambda)) + labs(y = "", title = latex2exp::TeX(paste0("Transformed Australia Retail Turnover with $\\lambda$ = ", round(lambda,2))))
There is some variation in the seasonal element of the data as it changes levels.
aus_production |> drop_na() |> autoplot(Tobacco)
The Guerrero method selected a lambda of 0.93.
lambda <- aus_production |> features(Tobacco, features = guerrero) |> pull(lambda_guerrero)
aus_production |> drop_na() |> autoplot(box_cox(Tobacco, lambda)) + labs(y = "", title = latex2exp::TeX(paste0("Transformed Australia Tobacco Production with $\\lambda$ = ", round(lambda,2))))
The data for Economy class passengers travelling from Melbourne to Syndey shows very inconsistent variations in the data.
ansett |> filter(Airports == "MEL-SYD", Class == "Economy") |> autoplot(Passengers)
For economy class passengers, transforming for consistent variation is challenging due to the irregularity of the variation. A lambda of 3, assessed visually, appears to come as close as possible to making the variation consistent.
econ_mel_syd <- ansett |> filter(Airports == "MEL-SYD", Class == "Economy")
econ_mel_syd |> drop_na() |> autoplot(box_cox(Passengers, 3)) + labs(y = "", title = latex2exp::TeX(paste0("Transformed Economy Passenger from Melbourne to Sydney with $\\lambda$ = ", round(lambda,2))))
pedestrian |> filter(Sensor == "Southern Cross Station") |> autoplot(Count)
The Guerrero method indicates a lambda of -0.26 optimizes the variation of the data.
southern_cross_pedestrians <- pedestrian |> filter(Sensor == "Southern Cross Station") |> mutate(Count_plus_one = Count + 1)
lambda <- southern_cross_pedestrians |> features(Count_plus_one, features = guerrero) |> pull(lambda_guerrero)
southern_cross_pedestrians |> autoplot(box_cox(Count_plus_one, lambda)) + labs(y = "", title = latex2exp::TeX(paste0("Transformed Pedestrian Counts for Southern Cross Station with $\\lambda$ = ", round(lambda,2))))
The plot of gas production in Australia for the last five years indicates both an upward trend and a seasonal fluctuation that is lowest at the end of Q4/start of Q1 and highest at the end of Q2/beginning of Q3.
gas <- tail(aus_production, 5*4) |> select(Gas)
autoplot(gas, Gas)
Below is the classical decomposition
classical_dcmp <- gas |> model(classical_decomposition(Gas, type = "multiplicative"))
classical_dcmp |>
components() |> autoplot() + labs(title = "Classical additive decomposition of total US retail employment")
There is support for the initial assertions about trend and seasonal fluctuation in the classical decomposition. The trend line is increasing from left to right, and the seasonal has a consistent fluctuation comparable to the original plot.
classical_dcmp |> components() |>
ggplot(aes(x = Quarter, y = season_adjust)) +
geom_line()
gascopy <- gas
gascopy$Gas[2] = gascopy$Gas[2] + 300
gascopy |> model(classical_decomposition(Gas, type = "multiplicative")) |> components() |>
ggplot(aes(x = Quarter, y = season_adjust)) +
geom_line()
Added an outlier at the 5th observation by adding 300 to the existing value.
gascopy <- gas
gascopy$Gas[5] = gascopy$Gas[5] + 300
gascopy |> model(classical_decomposition(Gas, type = "multiplicative")) |> components() |>
ggplot(aes(x = Quarter, y = season_adjust)) +
geom_line()
Added an outlier at the 10th observation by adding 300 to the existing value.
gascopy <- gas
gascopy$Gas[10] = gascopy$Gas[10] + 300
gascopy |> model(classical_decomposition(Gas, type = "multiplicative")) |> components() |>
ggplot(aes(x = Quarter, y = season_adjust)) +
geom_line()
Added an outlier at the 15th observation by adding 300 to the existing value.
gascopy <- gas
gascopy$Gas[15] = gascopy$Gas[15] + 300
gascopy |> model(classical_decomposition(Gas, type = "multiplicative")) |> components() |>
ggplot(aes(x = Quarter, y = season_adjust)) +
geom_line()
gascopy <- gas
gascopy$Gas[19] = gascopy$Gas[19] + 300
gascopy |> model(classical_decomposition(Gas, type = "multiplicative")) |> components() |>
ggplot(aes(x = Quarter, y = season_adjust)) +
geom_line()
The outlier causes a significant spike in the seasonally adjusted data and also leads to an echo of the seasonal data when placed in a middle or quarterly position. They lead regular dips in all the seasonally adjusted data at the seasonal intervals. It occurs regardless of where the outlier is within the dataset. However, when the outlier appears at the very beginning or the end it causes the seasonal data to flatten notably, eliminating the shape of the seasonally adjusted data.
The retail data from problem 2.10.7.
set.seed(47)
myseries <- aus_retail |> filter(`Series ID` == sample(aus_retail$`Series ID`, 1))
myseries |> autoplot(Turnover)
x11_dcmp <- myseries |> model(x11 = X_13ARIMA_SEATS(Turnover ~ x11())) |> components()
autoplot(x11_dcmp) + labs(title = "Decomposition of Retail Turnover")
The X-11 decomposition of the retail data shows an upward trend, and a seasonal fluctuation that seems to grow over time as well starting around 2011. There is also a notable amount of noise that seems to fluctuate over time. In the irregular data there is a potential outlier spike at 2001.
The decomposition shows several things. An overall upward trend this is particularly notable as the scale indicates that change to this plot is large. A seasonal fluctuation that grows in variation slightly over time. The scale of the seasonal fluctuation is slightly smaller than the trend. Most significantly the remainder section shows a significant negative fluctuation around 1991/1992, however the scale indicates that the changes in this plot are the smallest in scale.
The recession is visible in the estimated components, specifically it is in the remainder portion where this outlier event shows up, while the trend data simultaneously flattens at that time.