Homework 2
Hunter Patenaude
Sept 23
Load packages and data
library(dplyr)
library(ggplot2)
library(tidyr)
library(tibble)
library(tsibble)
library(ggfortify)
library(tidyverse)
library(fpp3)
library(moments)
library(zoo)
library(fable)
library(readxl)
library(seasonal)Questions
Exercise 1
USAGE <- global_economy %>%
select(Country, Year, GDP, Population) %>%
filter(Country == "United States")
USAGEpl <- USAGE %>%
autoplot(GDP/Population)
USAGEpl
AUSLS <- aus_livestock %>%
mutate(Month = yearmonth(Month)) %>%
group_by(Animal)%>%
filter(Animal == "Bulls, bullocks and steers") %>%
filter(State == "Victoria")
AUSLS %>%
features(Count, features = guerrero)## # A tibble: 1 × 3
## Animal State lambda_guerrero
## <fct> <fct> <dbl>
## 1 Bulls, bullocks and steers Victoria -0.0720AUSLSpl <- AUSLS %>%
autoplot(box_cox(Count, -0.0720)) +
labs(y = "Box-Cox transformed Victorian Bulls, Bullocks and Steers")
AUSLSpl
VICEL <- vic_elec %>%
select(Demand, Time)
VICEL %>%
features(Demand, features = guerrero)## # A tibble: 1 × 1
## lambda_guerrero
## <dbl>
## 1 0.0999VICELpl <- VICEL %>%
autoplot(box_cox(Demand, 0.0999)) +
labs(y = "Box-Cox transformed Demand")
VICELpl
aus_production %>%
features(Gas, features = guerrero)## # A tibble: 1 × 1
## lambda_guerrero
## <dbl>
## 1 0.121AUSpro <-aus_production %>%
select(Gas, Quarter)
AUSpropl <- AUSpro %>%
autoplot(box_cox(Gas, 0.121)) +
labs(y = "Box-Cox transformed Gas")
AUSpropl
The data for the United States GDP data, I transformed the data to show GDP per person. The data for Australian livestock needs to be transformed. I used a Box-Cox to decrease the random variance in the model. The data for Victorian electricity needed to be transformed, I used a Box-Cox to decrease the random variance.
Exercise 2
autoplot(canadian_gas)## Plot variable not specified, automatically selected `.vars = Volume`
bccadg <- canadian_gas %>%
features(Volume, features = guerrero)
bccadg## # A tibble: 1 × 1
## lambda_guerrero
## <dbl>
## 1 0.392BCcadgaspl <- canadian_gas %>%
autoplot(box_cox(Volume, 0.392)) +
labs(y = "Box-Cox transformed Volume")
BCcadgaspl
The Box-Cox transformation isn’t helpful for this data because the variance isn’t random. This is due to the middle portion of the data varying much more than the lower and upper regions of the data. The max and the min are small, so Box-Cox isn’t helpful.
Exercise 3
Cig <- aus_production %>%
select(Tobacco, Quarter)
Cig## # A tsibble: 218 x 2 [1Q]
## Tobacco Quarter
## <dbl> <qtr>
## 1 5225 1956 Q1
## 2 5178 1956 Q2
## 3 5297 1956 Q3
## 4 5681 1956 Q4
## 5 5577 1957 Q1
## 6 5651 1957 Q2
## 7 5317 1957 Q3
## 8 6152 1957 Q4
## 9 5758 1958 Q1
## 10 5641 1958 Q2
## # … with 208 more rowsCig %>%
features(Tobacco, features = guerrero)## # A tibble: 1 × 1
## lambda_guerrero
## <dbl>
## 1 0.929Cigpl <- Cig %>%
autoplot(box_cox(Tobacco, 0.929)) +
labs(y = "Box-Cox transformed Tobacco")
Cigpl## Warning: Removed 24 row(s) containing missing values (geom_path).
Airr <- ansett %>%
filter(Airports == "MEL-SYD") %>%
filter(Class == "Economy")
Airr## # A tsibble: 282 x 4 [1W]
## # Key: Airports, Class [1]
## Week Airports Class Passengers
## <week> <chr> <chr> <dbl>
## 1 1987 W26 MEL-SYD Economy 20167
## 2 1987 W27 MEL-SYD Economy 20161
## 3 1987 W28 MEL-SYD Economy 19993
## 4 1987 W29 MEL-SYD Economy 20986
## 5 1987 W30 MEL-SYD Economy 20497
## 6 1987 W31 MEL-SYD Economy 20770
## 7 1987 W32 MEL-SYD Economy 21111
## 8 1987 W33 MEL-SYD Economy 20675
## 9 1987 W34 MEL-SYD Economy 22092
## 10 1987 W35 MEL-SYD Economy 20772
## # … with 272 more rowsAirr %>%
features(Passengers, features = guerrero)## # A tibble: 1 × 3
## Airports Class lambda_guerrero
## <chr> <chr> <dbl>
## 1 MEL-SYD Economy 2.00Airrpl <- Airr %>%
autoplot(box_cox(Passengers, 2.00)) +
labs(y = "Box-Cox transformed Passengers")
Airrpl 
Walk <- pedestrian %>%
select(Sensor, Date, Count) %>%
filter(Sensor == "Southern Cross Station")
Walk## # A tsibble: 17,539 x 4 [1h] <Australia/Melbourne>
## # Key: Sensor [1]
## Sensor Date Count Date_Time
## <chr> <date> <int> <dttm>
## 1 Southern Cross Station 2015-01-01 746 2015-01-01 00:00:00
## 2 Southern Cross Station 2015-01-01 312 2015-01-01 01:00:00
## 3 Southern Cross Station 2015-01-01 180 2015-01-01 02:00:00
## 4 Southern Cross Station 2015-01-01 133 2015-01-01 03:00:00
## 5 Southern Cross Station 2015-01-01 44 2015-01-01 04:00:00
## 6 Southern Cross Station 2015-01-01 16 2015-01-01 05:00:00
## 7 Southern Cross Station 2015-01-01 13 2015-01-01 06:00:00
## 8 Southern Cross Station 2015-01-01 21 2015-01-01 07:00:00
## 9 Southern Cross Station 2015-01-01 39 2015-01-01 08:00:00
## 10 Southern Cross Station 2015-01-01 36 2015-01-01 09:00:00
## # … with 17,529 more rowsWalk %>%
features(Count, features = guerrero)## # A tibble: 1 × 2
## Sensor lambda_guerrero
## <chr> <dbl>
## 1 Southern Cross Station -0.226Walkpl <- Walk %>%
autoplot(box_cox(Count, -0.226)) +
labs(y = "Box-Cox transformed SCS Pedestrians")
Walkpl 
Exercise 4
y <- readxl::read_excel("~/Downloads/Book200.xlsx")
MA5 <- y %>%
rollmean(num, k = 5, fill = NA)
MA3 <- MA5 %>%
rollmean(num, k = 3, fill = NA)
MA3## Weights
## [1,] NA
## [2,] NA
## [3,] NA
## [4,] 0.1644
## [5,] NA
## [6,] NA
## [7,] NA z <- c(0.067, 0.133, 0.2, 0.2, 0.2, 0.133, 0.067)
z[1] = 0.067*(1/15)
z[2] = 0.133*(2/15)
z[3] = 0.200*(3/15)
z[4] = 0.200*(3/15)
z[5] = 0.200*(3/15)
z[6] = 0.133*(2/15)
z[7] = 0.067*(1/15)
z_sum <- sum(z)
z_sum## [1] 0.1644Exercise 5
GASSS <- tail(aus_production, 5*4) %>%
select(Gas)
head(GASSS)## # A tsibble: 6 x 2 [1Q]
## Gas Quarter
## <dbl> <qtr>
## 1 221 2005 Q3
## 2 180 2005 Q4
## 3 171 2006 Q1
## 4 224 2006 Q2
## 5 233 2006 Q3
## 6 192 2006 Q4 autoplot(GASSS)## Plot variable not specified, automatically selected `.vars = Gas`
GASSS## # A tsibble: 20 x 2 [1Q]
## Gas Quarter
## <dbl> <qtr>
## 1 221 2005 Q3
## 2 180 2005 Q4
## 3 171 2006 Q1
## 4 224 2006 Q2
## 5 233 2006 Q3
## 6 192 2006 Q4
## 7 187 2007 Q1
## 8 234 2007 Q2
## 9 245 2007 Q3
## 10 205 2007 Q4
## 11 194 2008 Q1
## 12 229 2008 Q2
## 13 249 2008 Q3
## 14 203 2008 Q4
## 15 196 2009 Q1
## 16 238 2009 Q2
## 17 252 2009 Q3
## 18 210 2009 Q4
## 19 205 2010 Q1
## 20 236 2010 Q2 GASS2 <- GASSS %>%
model(classical_decomposition(Gas, type = "multiplicative")) %>%
components() %>%
autoplot() +
labs(title = "Multiplicative decomposition of Gas")
GASS2## Warning: Removed 2 row(s) containing missing values (geom_path).
decompGAS <- as_tsibble(GASSS) %>%
model(classical_decomposition(Gas ~ season(4), type = "multiplicative")) %>%
components()
decompGAS## # A dable: 20 x 7 [1Q]
## # Key: .model [1]
## # : Gas = trend * seasonal * random
## .model Quarter Gas trend seaso…¹ random seaso…²
## <chr> <qtr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 "classical_decomposition(Gas ~ se… 2005 Q3 221 NA 1.13 NA 196.
## 2 "classical_decomposition(Gas ~ se… 2005 Q4 180 NA 0.925 NA 195.
## 3 "classical_decomposition(Gas ~ se… 2006 Q1 171 200. 0.875 0.974 195.
## 4 "classical_decomposition(Gas ~ se… 2006 Q2 224 204. 1.07 1.02 209.
## 5 "classical_decomposition(Gas ~ se… 2006 Q3 233 207 1.13 1.00 207.
## 6 "classical_decomposition(Gas ~ se… 2006 Q4 192 210. 0.925 0.987 208.
## 7 "classical_decomposition(Gas ~ se… 2007 Q1 187 213 0.875 1.00 214.
## 8 "classical_decomposition(Gas ~ se… 2007 Q2 234 216. 1.07 1.01 218.
## 9 "classical_decomposition(Gas ~ se… 2007 Q3 245 219. 1.13 0.996 218.
## 10 "classical_decomposition(Gas ~ se… 2007 Q4 205 219. 0.925 1.01 222.
## 11 "classical_decomposition(Gas ~ se… 2008 Q1 194 219. 0.875 1.01 222.
## 12 "classical_decomposition(Gas ~ se… 2008 Q2 229 219 1.07 0.974 213.
## 13 "classical_decomposition(Gas ~ se… 2008 Q3 249 219 1.13 1.01 221.
## 14 "classical_decomposition(Gas ~ se… 2008 Q4 203 220. 0.925 0.996 219.
## 15 "classical_decomposition(Gas ~ se… 2009 Q1 196 222. 0.875 1.01 224.
## 16 "classical_decomposition(Gas ~ se… 2009 Q2 238 223. 1.07 0.993 222.
## 17 "classical_decomposition(Gas ~ se… 2009 Q3 252 225. 1.13 0.994 224.
## 18 "classical_decomposition(Gas ~ se… 2009 Q4 210 226 0.925 1.00 227.
## 19 "classical_decomposition(Gas ~ se… 2010 Q1 205 NA 0.875 NA 234.
## 20 "classical_decomposition(Gas ~ se… 2010 Q2 236 NA 1.07 NA 220.
## # … with abbreviated variable names ¹seasonal, ²season_adjustDecompGASpl <- decompGAS %>%
ggplot(aes(x = Quarter)) +
geom_line(aes(y = Gas, colour = "Data")) +
geom_line(aes(y = season_adjust, colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend")) +
labs(y = "Gass", title = "Gas Production")
DecompGASpl## Warning: Removed 4 row(s) containing missing values (geom_path).
GASadd <- GASSS
GASadd[1,1]<-GASSS[1,1] +300
GASadd## # A tsibble: 20 x 2 [1Q]
## Gas Quarter
## <dbl> <qtr>
## 1 521 2005 Q3
## 2 180 2005 Q4
## 3 171 2006 Q1
## 4 224 2006 Q2
## 5 233 2006 Q3
## 6 192 2006 Q4
## 7 187 2007 Q1
## 8 234 2007 Q2
## 9 245 2007 Q3
## 10 205 2007 Q4
## 11 194 2008 Q1
## 12 229 2008 Q2
## 13 249 2008 Q3
## 14 203 2008 Q4
## 15 196 2009 Q1
## 16 238 2009 Q2
## 17 252 2009 Q3
## 18 210 2009 Q4
## 19 205 2010 Q1
## 20 236 2010 Q2GASSadfr <- GASadd %>%
model(classical_decomposition(Gas, type = "multiplicative")) %>%
components() %>%
autoplot() +
labs(title = "Multiplicative decomposition of Gas w outlier")
GASSadfr## Warning: Removed 2 row(s) containing missing values (geom_path).
GASdec <- as_tsibble(GASadd) %>%
model(classical_decomposition(Gas ~ season(4), type = "mult")) %>%
components()
GASdec## # A dable: 20 x 7 [1Q]
## # Key: .model [1]
## # : Gas = trend * seasonal * random
## .model Quarter Gas trend seaso…¹ random seaso…²
## <chr> <qtr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 "classical_decomposition(Gas ~ se… 2005 Q3 521 NA 1.14 NA 459.
## 2 "classical_decomposition(Gas ~ se… 2005 Q4 180 NA 0.933 NA 193.
## 3 "classical_decomposition(Gas ~ se… 2006 Q1 171 238 0.849 0.846 201.
## 4 "classical_decomposition(Gas ~ se… 2006 Q2 224 204. 1.08 1.02 207.
## 5 "classical_decomposition(Gas ~ se… 2006 Q3 233 207 1.14 0.992 205.
## 6 "classical_decomposition(Gas ~ se… 2006 Q4 192 210. 0.933 0.979 206.
## 7 "classical_decomposition(Gas ~ se… 2007 Q1 187 213 0.849 1.03 220.
## 8 "classical_decomposition(Gas ~ se… 2007 Q2 234 216. 1.08 1.00 216.
## 9 "classical_decomposition(Gas ~ se… 2007 Q3 245 219. 1.14 0.987 216.
## 10 "classical_decomposition(Gas ~ se… 2007 Q4 205 219. 0.933 1.00 220.
## 11 "classical_decomposition(Gas ~ se… 2008 Q1 194 219. 0.849 1.04 229.
## 12 "classical_decomposition(Gas ~ se… 2008 Q2 229 219 1.08 0.965 211.
## 13 "classical_decomposition(Gas ~ se… 2008 Q3 249 219 1.14 1.00 219.
## 14 "classical_decomposition(Gas ~ se… 2008 Q4 203 220. 0.933 0.987 218.
## 15 "classical_decomposition(Gas ~ se… 2009 Q1 196 222. 0.849 1.04 231.
## 16 "classical_decomposition(Gas ~ se… 2009 Q2 238 223. 1.08 0.985 220.
## 17 "classical_decomposition(Gas ~ se… 2009 Q3 252 225. 1.14 0.986 222.
## 18 "classical_decomposition(Gas ~ se… 2009 Q4 210 226 0.933 0.996 225.
## 19 "classical_decomposition(Gas ~ se… 2010 Q1 205 NA 0.849 NA 242.
## 20 "classical_decomposition(Gas ~ se… 2010 Q2 236 NA 1.08 NA 218.
## # … with abbreviated variable names ¹seasonal, ²season_adjustGASdecpl <- GASdec %>%
ggplot(aes(x = Quarter)) +
geom_line(aes(y = Gas, colour = "Data")) +
geom_line(aes(y = season_adjust, colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend")) +
labs(y = "Gass", title = "Gas Production end outlier")
GASdecpl## Warning: Removed 4 row(s) containing missing values (geom_path).
GASomid <- GASSS
GASomid[11,1]<- GASSS[11,1] +300
GASomid## # A tsibble: 20 x 2 [1Q]
## Gas Quarter
## <dbl> <qtr>
## 1 221 2005 Q3
## 2 180 2005 Q4
## 3 171 2006 Q1
## 4 224 2006 Q2
## 5 233 2006 Q3
## 6 192 2006 Q4
## 7 187 2007 Q1
## 8 234 2007 Q2
## 9 245 2007 Q3
## 10 205 2007 Q4
## 11 494 2008 Q1
## 12 229 2008 Q2
## 13 249 2008 Q3
## 14 203 2008 Q4
## 15 196 2009 Q1
## 16 238 2009 Q2
## 17 252 2009 Q3
## 18 210 2009 Q4
## 19 205 2010 Q1
## 20 236 2010 Q2GASomid2 <- GASomid %>%
model(classical_decomposition(Gas, type = "multiplicative")) %>%
components() %>%
autoplot() +
labs(title = "Multiplicative decomposition of Gas w mid outlier")
GASomid2## Warning: Removed 2 row(s) containing missing values (geom_path).
Decompmid <- as_tsibble(GASomid) %>%
model(classical_decomposition(Gas ~ season(4), type = "multiplicative")) %>%
components()
Decompmid## # A dable: 20 x 7 [1Q]
## # Key: .model [1]
## # : Gas = trend * seasonal * random
## .model Quarter Gas trend seaso…¹ random seaso…²
## <chr> <qtr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 "classical_decomposition(Gas ~ se… 2005 Q3 221 NA 1.05 NA 211.
## 2 "classical_decomposition(Gas ~ se… 2005 Q4 180 NA 0.868 NA 207.
## 3 "classical_decomposition(Gas ~ se… 2006 Q1 171 200. 1.08 0.792 159.
## 4 "classical_decomposition(Gas ~ se… 2006 Q2 224 204. 1.01 1.09 222.
## 5 "classical_decomposition(Gas ~ se… 2006 Q3 233 207 1.05 1.08 223.
## 6 "classical_decomposition(Gas ~ se… 2006 Q4 192 210. 0.868 1.05 221.
## 7 "classical_decomposition(Gas ~ se… 2007 Q1 187 213 1.08 0.815 174.
## 8 "classical_decomposition(Gas ~ se… 2007 Q2 234 216. 1.01 1.07 232.
## 9 "classical_decomposition(Gas ~ se… 2007 Q3 245 256. 1.05 0.915 234.
## 10 "classical_decomposition(Gas ~ se… 2007 Q4 205 294. 0.868 0.804 236.
## 11 "classical_decomposition(Gas ~ se… 2008 Q1 494 294. 1.08 1.56 459.
## 12 "classical_decomposition(Gas ~ se… 2008 Q2 229 294 1.01 0.771 227.
## 13 "classical_decomposition(Gas ~ se… 2008 Q3 249 256. 1.05 0.928 238.
## 14 "classical_decomposition(Gas ~ se… 2008 Q4 203 220. 0.868 1.06 234.
## 15 "classical_decomposition(Gas ~ se… 2009 Q1 196 222. 1.08 0.820 182.
## 16 "classical_decomposition(Gas ~ se… 2009 Q2 238 223. 1.01 1.06 236.
## 17 "classical_decomposition(Gas ~ se… 2009 Q3 252 225. 1.05 1.07 241.
## 18 "classical_decomposition(Gas ~ se… 2009 Q4 210 226 0.868 1.07 242.
## 19 "classical_decomposition(Gas ~ se… 2010 Q1 205 NA 1.08 NA 190.
## 20 "classical_decomposition(Gas ~ se… 2010 Q2 236 NA 1.01 NA 234.
## # … with abbreviated variable names ¹seasonal, ²season_adjustDecompmidpl <- Decompmid %>%
ggplot(aes(x = Quarter)) +
geom_line(aes(y = Gas, colour = "Data")) +
geom_line(aes(y = season_adjust, colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend")) +
labs(y = "Gass", title = "Gas Production end middle outlier")
Decompmidpl## Warning: Removed 4 row(s) containing missing values (geom_path).
5.1) There is a seasonality of 1 year and a trend that is increasing. 5.3) The results support the graph. Because classical multiplicative decomposition relies on moving averages, there is no data at the beginning and end of the trend-cycle. The data represents that there is a seasonality of 1 year and an increasing trend. 5.5) When 300 was added to the 1st observation, it caused a large spike in the seasonally adjusted data. The quarterly gas data was taken from a seasonal low point to a relative high point. The addition of 300 to the 1st observation has a relatively small affect on the seasonal component. This is because the seasonal component is uniform for each year and only one data point has changed. 5.6) The seasonal data is more effected when the outlier is in the middle than at the end or beginning. The pattern matched the original data better when the outlier is on the beginning or end of the data. When the outlier is in the middle it matches the original the least.
Exercise 6
set.seed(69420)
myseries <- aus_retail %>%
filter(`Series ID` == sample(aus_retail$`Series ID`,1))
autoplot(myseries)## Plot variable not specified, automatically selected `.vars = Turnover`
Decompx11 <- myseries %>%
model(x11 = X_13ARIMA_SEATS(Turnover ~ x11())) %>%
components()
Decompx11## # A dable: 441 x 9 [1M]
## # Key: State, Industry, .model [1]
## # : Turnover = trend * seasonal * irregular
## State Indus…¹ .model Month Turno…² trend seaso…³ irreg…⁴ seaso…⁵
## <chr> <chr> <chr> <mth> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Australian Cap… Pharma… x11 1982 Apr 2.5 2.69 0.928 1.00 2.69
## 2 Australian Cap… Pharma… x11 1982 May 2.5 2.69 0.923 1.01 2.71
## 3 Australian Cap… Pharma… x11 1982 Jun 2.5 2.69 0.933 0.994 2.68
## 4 Australian Cap… Pharma… x11 1982 Jul 2.6 2.70 0.982 0.982 2.65
## 5 Australian Cap… Pharma… x11 1982 Aug 2.8 2.70 1.03 1.01 2.73
## 6 Australian Cap… Pharma… x11 1982 Sep 2.8 2.71 1.00 1.03 2.79
## 7 Australian Cap… Pharma… x11 1982 Oct 2.6 2.71 0.991 0.968 2.62
## 8 Australian Cap… Pharma… x11 1982 Nov 3.1 2.72 1.14 1.00 2.72
## 9 Australian Cap… Pharma… x11 1982 Dec 3.9 2.72 1.22 1.17 3.19
## 10 Australian Cap… Pharma… x11 1983 Jan 2.5 2.70 0.932 0.993 2.68
## # … with 431 more rows, and abbreviated variable names ¹Industry, ²Turnover,
## # ³seasonal, ⁴irregular, ⁵season_adjustDecompx11pl <- autoplot(Decompx11) +
labs(title = "Decomposition using X-11.")
Decompx11pl
Decompx11pl2 <- Decompx11 %>%
ggplot(aes(x = Month)) +
geom_line(aes(y = Turnover, colour = "Data")) +
geom_line(aes(y = season_adjust, colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend"))
Decompx11pl2
The x-11 decomposition didn’t do very much, the seasonality is a little more noticeable due to the lines being sharper.
Exercise 7
7.1) When you isolate the trend component from the seasonal component, it shows that the trend has increased throughout the majority of time. There are a few periods occurring in the early 90s that show it being a little stagnate. The monthly breakdown of the seasonal component shows that a few months show greater peaks in their variation. March and December show the largest peaks, this might be due to some factor specific to Australia. 7.2) Yes there was a very large downward spike around 1992 that is shown in the graph. It is large enough to be seen in the remainder. This is not explained by the seasonality or the positive trend.
Exercise 8
autogas <- canadian_gas %>%
autoplot(Volume)+
labs(title = "Monthly Canadian Gas Production", y = "Billions of Cubic Meters")+
geom_line()
autogas
subgas <- canadian_gas %>%
gg_subseries(Volume)+
labs(title = "Monthly Canadian Gas Production", subtitle = "gg_subseries()", y = "billions of cubic meter")
subgas
seasongas <- canadian_gas %>%
gg_season(Volume) +
labs(title = "Monthly Canadian Gas Production", y = "Billions of Cubic Meters")
seasongas
STLgas <- canadian_gas %>%
model(STL(Volume ~ trend(window = 21) + season(window = 13),robust = TRUE)) %>%
components() %>%
autoplot()+
labs(title = "STL decomposition")
STLgas
Seaadjgas <- canadian_gas %>%
model(STL(Volume ~ trend(window = 21) + season(window = 13), robust = TRUE)) %>%
components() %>%
ggplot(aes(x = Month)) +
geom_line(aes(y = Volume, colour = "Data")) +
geom_line(aes(y = season_adjust, colour = "Seasonally Adjusted")) +
geom_line(aes(y = trend, colour = "Trend")) +
labs(title = "STL decomposition")
Seaadjgas
x11gas <- canadian_gas %>%
model(x11 = X_13ARIMA_SEATS(Volume ~ x11())) %>%
components() %>%
autoplot()+
labs(title = "X-11 decomposition")
x11gas
SEATSgas <- canadian_gas %>%
model(seats = X_13ARIMA_SEATS(Volume ~ seats())) %>%
components() %>%
autoplot() +
labs(title ="SEATS Decomposition")
SEATSgas
8.3) The seasonal shape is flat at the beginning and then the seasonal shape increases. In year 1960 there is no trend, we can say the gas production didn’t have a noticeable trend during that time. After year 1975 there is a trend cycle, therefore the gas production increases at that point and continues to increase. 8.5) The decomposed trend and seasonal components are very similar. The differences between the two are very small. They are both different from the original data. The remainder of the SEATS decomposition is bigger than the X11 decomposition. The remainder component of the STL decomposition is smaller than both. Therefore, the STL model fits the data better.
Exercise 9
Goodstuff <- aus_retail%>%
filter(Industry == "Liquor retailing" & year(Month)>= 2000)%>%
summarise(Turnover = sum(Turnover))
Goodstuff## # A tsibble: 228 x 2 [1M]
## Month Turnover
## <mth> <dbl>
## 1 2000 Jan 245.
## 2 2000 Feb 243.
## 3 2000 Mar 256.
## 4 2000 Apr 260
## 5 2000 May 247.
## 6 2000 Jun 268.
## 7 2000 Jul 248.
## 8 2000 Aug 270.
## 9 2000 Sep 281
## 10 2000 Oct 285
## # … with 218 more rowsGoodstuff2 <- ggplot(data = Goodstuff)+
geom_line(aes(x=Month, y=Turnover))
Goodstuff2
liquidgold <- Goodstuff %>%
mutate(`12-MA` = slider::slide_dbl(Turnover, mean,
.before = 5, .after = 6, .complete = TRUE))%>%
mutate(`2x12-MA` = slider::slide_dbl(`12-MA`, mean,
.before = 1, .after = 0, .complete = TRUE))
liquidgold## # A tsibble: 228 x 4 [1M]
## Month Turnover `12-MA` `2x12-MA`
## <mth> <dbl> <dbl> <dbl>
## 1 2000 Jan 245. NA NA
## 2 2000 Feb 243. NA NA
## 3 2000 Mar 256. NA NA
## 4 2000 Apr 260 NA NA
## 5 2000 May 247. NA NA
## 6 2000 Jun 268. 281. NA
## 7 2000 Jul 248. 285. 283.
## 8 2000 Aug 270. 287. 286.
## 9 2000 Sep 281 290. 288.
## 10 2000 Oct 285 292. 291.
## # … with 218 more rowsLiquidgoldpl <- liquidgold %>%
autoplot(Turnover) +
geom_line(aes(y =`2x12-MA`), colour = "red") +
labs(y = "Liquor retailing Turnover",
title = "Total Liquor retailing Turnover")+
guides(colour = guide_legend(title = "series"))
Liquidgoldpl## Warning: Removed 12 row(s) containing missing values (geom_path).
9.2) We should use a 12x2 MA approach because the data set is monthly and has a seasonality of one year.
Exercise 10
Step 1) Smooth the data with a procedure such as moving averages to estimate the trend. One could estimate the trend with a regression. Step 2) Detrend the series. For additive, you should subtract the trend estimate. For multiplicative, you should divide the series by the calculated weight. Step 3) Average the detrended values depending on seasonality. If the seasonality is monthly, average the detrended values for all months. Step 4) Find the remainder component. For additive, remainder = series - trend - seasonal For multiplicative, remainder = series / (trend * seasonal)