Data 624-Homework 2

library(fpp3)
library(tsibble)
library(cowplot)

3.1

  We can see below that one country clearly has the largest GDP per capita by a comfortable margin.

global_economy %>%
  autoplot(GDP/Population,show.legend=F) +
  labs(title= "GDP per capita", y = "$US") 

  Upon further inspection, that country would appear to be Monaco followed closely by Liechtenstein.

global_economy %>%  mutate(sum = GDP/Population) %>% as.tibble() %>%
  group_by(Country) %>% summarise(Largest_GDP = sum(sum, na.rm = T)) %>% slice_max(Largest_GDP,n=2)

  We can see below that both countries are closely tied together trend wise. Both have Seen a rapid climb since the 1980s and while Monaco is the clear winner for a long period of time, in more recent years it appears that Liechtenstein has surpassed it a few times.

global_economy %>%
filter(Country %in% c("Monaco","Liechtenstein")) %>%
  autoplot(GDP/Population) +
  labs(title= "GDP per capita In Monaco and Liechtenstein", y = "$US") 

3.2

  For the United States, a simple per capita transfomation is all we need.

global_economy %>%
filter(Country == "United States") %>%

  autoplot(GDP/Population,show.legend=F) +
  labs(title= "GDP per capita In the United States", y = "$US") 

| For the slaughter data, we add a moving average to smooth out the trend line in order to have a better understanding of the overall average change overtime.

aus_livestock %>% filter(Animal=="Bulls, bullocks and steers" & State =="Victoria") %>% 
  mutate(
    `5-MA` = slider::slide_dbl(Count, mean,
                .before = 12, .after = 12, .complete = TRUE)
  )  %>% autoplot(Count) +
  geom_line(aes(y = `5-MA`), colour = "#D55E00")  +
  labs( title = "Slaughter of Livestock")

  For the vic_elec data we attempt to use STL Decomposition to see if we can garner some insight from the data as it’s too dense to understand raw. It’s hard to tell if trend shown below is accurate or if this decomposition shouldn’t be used for this data., further investigation is needed. If true though, it would indicate that demand for electricity has gone down overtime, possibly due to using renewable energy sources.

vic_elec %>% 
  model( STL(Demand)) %>%
 components() %>% autoplot()

  We can see tht using Boxcox on the data below normalizes the data more allowing for the trend to be more easily understood.

aus_production %>% autoplot(Gas)

lambda <- aus_production %>%
  features(Gas, features = guerrero) %>%
  pull(lambda_guerrero)
aus_production %>%
  autoplot(box_cox(Gas, lambda)) +
  labs(y = "",
       title = latex2exp::TeX(paste0(
         "Transformed gas production with $\\lambda$ = ",
         round(lambda,2))))

3.3

canadian_gas %>% autoplot()

  We can see below that applying a lambda for Canada gas does not normalize the seasonality over time, it doesn’t help with this data in the slightest and is therefore unhelpful.

lambda_ca <- canadian_gas %>%
  features(Volume, features = guerrero) %>%
  pull(lambda_guerrero)

canadian_gas %>%
  autoplot(box_cox(Volume, lambda_ca)) +
  labs(y = "",
       title = latex2exp::TeX(paste0(
         "Transformed gas production with $\\lambda$ = ",
         round(lambda_ca,2))))

3.4

set.seed(1221)
myseries <- aus_retail %>%
  filter(`Series ID` == sample(aus_retail$`Series ID`,1))

autoplot(myseries,Turnover)

  It would appear that the Box Cox transformation has little to no effect on the retail data

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

myseries %>%
  autoplot(box_cox(Turnover, lambda_retail)) +
  labs(y = "",
       title = latex2exp::TeX(paste0(
         "Transformed retail turnover with $\\lambda$ = ",
         round(lambda_retail,2))))

3.5

aus_production %>%
  autoplot(Tobacco)

lambda_tob <- aus_production %>%
  features(Tobacco, features = guerrero) %>%
  pull(lambda_guerrero)

aus_production %>%
  autoplot(box_cox(Tobacco, lambda_tob)) +
  labs(y = "",
       title = latex2exp::TeX(paste0(
         "Transformed Tobacco Production with $\\lambda$ = ",
         round(lambda_tob,2))))

ansett %>% filter(Class=="Economy" & Airports == "MEL-SYD")  %>% autoplot() 

  We see below that Box does normalize this data allowing us to better understand the trend without hiding the massive dip that occurred in 1988 as well as several other big dips.

lambda_pass <- ansett %>% filter(Class=="Economy" & Airports == "MEL-SYD") %>%
  features(Passengers, features = guerrero) %>%
  pull(lambda_guerrero)

ansett %>% filter(Class=="Economy" & Airports == "MEL-SYD")  %>%
  autoplot(box_cox(Passengers, lambda_pass)) +
  labs(y = "",
       title = latex2exp::TeX(paste0(
         "Transformed Economy Passngr Rate from Melbourne to Sydney  with $\\lambda$ = ",
         round(lambda_pass,2))))

pedestrian %>%
  filter(Sensor=="Southern Cross Station") %>%
  autoplot(Count) 

  As shown below, even with the transformation, the data remains too messy to pull meaning from. Further transfomations is likely required to pull meaningful information from the data.

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

pedestrian %>%
  filter(Sensor=="Southern Cross Station") %>%
  autoplot(box_cox(Count, lamb_ped)) +
  labs(y = "",
       title = latex2exp::TeX(paste0(
         "Transformed Pedestrian Counts with $\\lambda$ = ",
         round(lamb_ped,2))))

3.7

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

a.

Ass seen below, we can see a clear seasonal trend occurring. However, it is certainly difficult to pinpoint the exact Quarter it begins and ends on.

gas %>% autoplot()

b.

gas %>%

 model(
    classical_decomposition(Gas, type = "additive")
  ) %>%
  components() %>%
  autoplot() +
  labs(title = "Classical additive decomposition of total
                  Gas Production ")

c. 

  We can definitely observe the same trend and seasonal pattern in our classical decomposition graphic. It proves to further support our findings in part a.

d

gas %>% 
  model( STL(Gas)) %>%
 components() %>%   as_tsibble()  %>%
  autoplot(Gas, colour = "gray") +
  geom_line(aes(y=season_adjust), colour = "#0072B2") +
  labs( title = "Seasonally Adjusted Gas Production")

## e.

  As shown below, by changing the an observation to 300, the seasonal adjusted line gets changes almost entirely. Some of the original tend is preserved, but overall it looks very different from before.

gas[5,1] <- 300

gas %>% 
  model( STL(Gas)) %>%
 components() %>%   as_tsibble()  %>%
  autoplot(Gas, colour = "gray") +
  geom_line(aes(y=season_adjust), colour = "#0072B2") +
  labs( title = "Seasonally Adjusted Gas Production with outlier")

  As can be seen below, the adjusted line for both are different, indicating that the location of the outlier can heavily influence our resulting graphics. It is clear that classical decomposition is not reliant to outlying values.

mid <- tail(aus_production, 5*4) %>% select(Gas) 

mid[10,1] <- 300 
mid %>% 
  model( STL(Gas)) %>%
 components() %>%   as_tsibble()  %>%
  autoplot(Gas, colour = "gray") +
  geom_line(aes(y=season_adjust), colour = "#0072B2") +
  labs( title = "Seasonally Adjusted Gas Production  with outlier in middle"  )

end <- tail(aus_production, 5*4) %>% select(Gas) 

end[20,1] <- 300 

end %>% 
  model( STL(Gas)) %>%
 components() %>%   as_tsibble()  %>%
  autoplot(Gas, colour = "gray") +
  geom_line(aes(y=season_adjust), colour = "#0072B2") +
  labs( title = "Seasonally Adjusted Gas Production with outlier at end")

3.8

  The X-11 decomposition does reveal some fascinating new insights. We can now clearly notice the massive spike in turnover in the late 1980s followed by a deep decline shortly thereafter. Interestingly, we don’t seem a similar recurrence during the great recession of 2008 however, it would appear that shortly thereafter the overall trend would go downwards, possibly indicating the lasting effect of that time.

myseries %>%
  model(x11 = X_13ARIMA_SEATS(Turnover ~ x11())) %>%
  components() %>% autoplot()

3.9

a.

  The STL decomposition graphic shows us the overall value and tend go from around 6,000 to 9,000 in this span of time. It would appear that overall, the labor force steadily increased, leveling off towards the farthest point of the data. What is interesting to take not of it is the scale of the seasonal and remainder graphic are only a tiny portion of the overall data. Seasonal only goes from -100 to at most 100 while the remainder goes from 100 to -400. There is only one point in which the remainder goes that low however, as the majority of the data appears to fluctuate between -100 and 100. The second graphic further supports this, showing that the monthly variation, while clearly different, does not fluctuate by a large overall number.

b.

  As mentioned in part a, the recession is a clear and evident dip that can be seen in the remainder section, the only remainder of -400 for this data.