library(fpp3)
## ── Attaching packages ────────────────────────────────────────────── fpp3 0.5 ──
## ✔ tibble 3.2.1 ✔ tsibble 1.1.4
## ✔ dplyr 1.1.3 ✔ tsibbledata 0.4.1
## ✔ tidyr 1.3.0 ✔ feasts 0.3.1
## ✔ lubridate 1.9.3 ✔ fable 0.3.3
## ✔ ggplot2 3.4.4 ✔ fabletools 0.4.0
## ── 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(urca)
library(fabletools)
gafa_stock %>% filter(Symbol == "AMZN") %>%
autoplot(Adj_Close)
gafa_stock %>%
filter(Symbol == "AMZN") %>%
gg_tsdisplay(Adj_Close, plot_type = "partial")
## Warning: Provided data has an irregular interval, results should be treated with caution. Computing ACF by observation.
## Provided data has an irregular interval, results should be treated with caution. Computing ACF by observation.
##Plot the turkish GDP
turkish <- global_economy %>% filter(Country == "Turkey")
global_economy %>% filter(Country == "Turkey") %>%
autoplot(GDP) + labs(title = "Turkish GDP") + xlab("Year")
## Apply box cox transformation:
lambda <- turkish %>% features(GDP , features = guerrero) %>%
pull(lambda_guerrero)
turkish <- turkish %>% mutate(box_cox = box_cox(GDP, lambda))
## Determine the optimal degree for the data:
turkish %>% features(box_cox, unitroot_ndiffs)
## # A tibble: 1 × 2
## Country ndiffs
## <fct> <int>
## 1 Turkey 1
turkish <- turkish %>% mutate(diff_close = difference(box_cox))
turkish %>% autoplot(diff_close)
## Warning: Removed 1 row containing missing values (`geom_line()`).
turkish %>%
gg_tsdisplay(diff_close, plot_type = "partial")
## Warning: Removed 1 row containing missing values (`geom_line()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
tasmania <-aus_accommodation %>% filter(State == "Tasmania")
tasmania %>% autoplot(Takings)
lambda <- tasmania %>% features(Takings , features = guerrero) %>%
pull(lambda_guerrero)
tasmania <- tasmania %>% mutate(box_cox = box_cox(Takings, lambda))
tasmania %>% autoplot(box_cox) + labs(title = "Plot of Tasmania Data with Box-Cox transformation")
tasmania %>% gg_tsdisplay(box_cox, plot_type = "partial")
tasmania %>% features(box_cox, unitroot_ndiffs)
## # A tibble: 1 × 2
## State ndiffs
## <chr> <int>
## 1 Tasmania 1
tasmania %>% features(box_cox, unitroot_nsdiffs)
## # A tibble: 1 × 2
## State nsdiffs
## <chr> <int>
## 1 Tasmania 1
tasmania <- tasmania %>% mutate(diff_takings = difference(box_cox))
tasmania %>% autoplot(diff_takings)
## Warning: Removed 1 row containing missing values (`geom_line()`).
tasmania <- tasmania %>% mutate(seasonal_diff = difference(difference(box_cox,lag = 4)),1)
tasmania %>%
gg_tsdisplay(seasonal_diff, plot_type = "partial")
## Warning: Removed 5 rows containing missing values (`geom_line()`).
## Warning: Removed 5 rows containing missing values (`geom_point()`).
tasmania %>% autoplot(seasonal_diff)
## Warning: Removed 5 rows containing missing values (`geom_line()`).
souvenirs %>%
autoplot(Sales)
lambda <- souvenirs %>% features(Sales , features = guerrero) %>%
pull(lambda_guerrero)
souvenirs <- souvenirs %>% mutate(box_cox = box_cox(Sales, lambda))
souvenirs %>% autoplot(box_cox) + labs(title = "Plot of Souvenir Data with Box-Cox transformation")
souvenirs %>% features(box_cox, unitroot_ndiffs)
## # A tibble: 1 × 1
## ndiffs
## <int>
## 1 1
souvenirs %>% features(box_cox, unitroot_nsdiffs)
## # A tibble: 1 × 1
## nsdiffs
## <int>
## 1 1
souvenirs <- souvenirs %>% mutate(seasonal_dif = difference(difference(box_cox, lag =12), lag= 1))
souvenirs %>% autoplot(seasonal_dif)
## Warning: Removed 13 rows containing missing values (`geom_line()`).
souvenirs %>%
gg_tsdisplay(seasonal_dif, plot_type = "partial")
## Warning: Removed 13 rows containing missing values (`geom_line()`).
## Warning: Removed 13 rows containing missing values (`geom_point()`).
set.seed(123478)
myseries <- aus_retail |>
filter(`Series ID` == sample(aus_retail$`Series ID`,1))
myseries %>% autoplot(Turnover)
lambda <- myseries %>% features(Turnover , features = guerrero) %>%
pull(lambda_guerrero)
myseries <- myseries %>% mutate(box_cox = box_cox(Turnover, lambda))
myseries %>% autoplot(box_cox) + labs(title = "Plot of Turnover Data with Box-Cox transformation")
myseries %>% gg_tsdisplay(Turnover,plot_type = "partial")
myseries %>% features(Turnover, unitroot_ndiffs)
## # A tibble: 1 × 3
## State Industry ndiffs
## <chr> <chr> <int>
## 1 Queensland Supermarket and grocery stores 1
myseries %>% features(Turnover, unitroot_nsdiffs)
## # A tibble: 1 × 3
## State Industry nsdiffs
## <chr> <chr> <int>
## 1 Queensland Supermarket and grocery stores 1
myseries <- myseries %>% mutate(seasonal_dif = difference(box_cox, lag =12))
myseries %>% autoplot(seasonal_dif)
## Warning: Removed 12 rows containing missing values (`geom_line()`).
myseries %>%
gg_tsdisplay(seasonal_dif, plot_type = "partial")
## Warning: Removed 12 rows containing missing values (`geom_line()`).
## Warning: Removed 12 rows containing missing values (`geom_point()`).
y <- numeric(100)
e <- rnorm(100)
for(i in 2:100)
y[i] <- 0.6*y[i-1] + e[i]
sim <- tsibble(idx = seq_len(100), y = y, index = idx)
sim %>% autoplot(y)
y <- numeric(100)
e <- rnorm(100)
for(i in 2:100)
y[i] <- 0.9*y[i-1] + e[i]
sim <- tsibble(idx = seq_len(100), y = y, index = idx)
sim %>% autoplot(y)
y <- numeric(100)
e <- rnorm(100)
for(i in 2:100)
y[i] <- 0.1*y[i-1] + e[i]
sim <- tsibble(idx = seq_len(100), y = y, index = idx)
sim %>% autoplot(y)
y <- numeric(100)
e <- rnorm(100)
for(i in 2:100)
y[i] <- 0.6*e[i-1] + e[i]
sim <- tsibble(idx = seq_len(100), y = y, index = idx)
sim %>% autoplot(y)
y <- numeric(100)
e <- rnorm(100)
for(i in 2:100)
y[i] <- 0.1*e[i-1] + e[i]
sim <- tsibble(idx = seq_len(100), y = y, index = idx)
sim %>% autoplot(y) + labs(title = "Theta at 0.1")
for(i in 2:100)
y[i] <- 0.9*e[i-1] + e[i]
sim <- tsibble(idx = seq_len(100), y = y, index = idx)
sim %>% autoplot(y) + labs(title = "theta at 0.9")
for(i in 2:100)
y[i] <- e[i] + 0.6*e[i-1] + 0.6 * y[i-1]
sim1 <- tsibble(idx = seq_len(100), y = y, index = idx)
sim1 %>% autoplot(y)
for(i in 3:100)
y[i] <- -0.8*y[i-1] +0.3*y[i-2] + e[i]
sim2 <- tsibble(idx = seq_len(100), y = y, index = idx)
sim2 %>% autoplot(y)
sim1 %>%
gg_tsdisplay(y, plot_type = "partial") + labs(title ="ARMA(1,1) model with phi at 0.6 and theta at 0.6")
sim2 %>%
gg_tsdisplay(y, plot_type = "partial") + labs(title ="ARMA(2) model with phi 1 at -0.8 and phi 2 at 0.3")
## The ARMA(1,1) plot is far more stable and stationary, while the the
ARMA(2) model is cLearly not stationary. The ARMA(1,1) model
autocorrelations decrease much faster than the ARMA(2)
passengers <- aus_airpassengers %>% filter(Year < 2012)
fit <- passengers %>% model(ARIMA(Passengers))
report(fit)
## Series: Passengers
## Model: ARIMA(0,2,1)
##
## Coefficients:
## ma1
## -0.8756
## s.e. 0.0722
##
## sigma^2 estimated as 4.671: log likelihood=-87.8
## AIC=179.61 AICc=179.93 BIC=182.99
fit %>% forecast(h = 10) %>%
autoplot(passengers) +
labs(title = "Aircraft passengers using ARIMA(0,2,1) model")
fit %>%
gg_tsresiduals() + labs(title = "ARIMA(0,2,1) Residuals")
fit2 <-passengers %>% model(arima = ARIMA(Passengers ~ pdq(0,1,0)))
fit2 %>% forecast(h = 10) %>%
autoplot(passengers) + labs(title = "Australian Passenger Numbers with ARIMA(0,1,0)")
fit2 %>% gg_tsresiduals() + labs(title = "ARIMA(0,1,0) Residuals")
fit3 <- passengers %>% model(arima = ARIMA(Passengers ~ pdq(2,1,2)))
fit3 %>% forecast(h = 10) %>%
autoplot(passengers) + labs(title = "Australian Passenger Numbers with ARIMA(2,1,2")
fit3 %>% gg_tsresiduals() + labs(title = "ARIMA (2,1,2) Residuals")
fit4 <- passengers %>% model(arima = ARIMA(Passengers ~ pdq(0,2,1)))
fit4 %>%forecast(h = 10) %>%
autoplot(passengers) + labs(title = "Australian Passenger Numbers with ARIMA(0,2,1)")
fit4 %>% gg_tsresiduals() + labs(title = "ARIMA (0,2,1) Residuals")
usa <- global_economy %>% filter(Code == "USA")
usa %>% autoplot(GDP)
## Apply boxcox transormation:
lambda <- usa %>% features(GDP , features = guerrero) %>%
pull(lambda_guerrero)
usa <- usa %>% mutate(box_cox = box_cox(GDP, lambda))
usa %>% autoplot(box_cox) + labs(title ="USA data with boxcox applied")
fit <- usa %>% model(ARIMA(box_cox))
report(fit)
## Series: box_cox
## Model: ARIMA(1,1,0) w/ drift
##
## Coefficients:
## ar1 constant
## 0.4586 118.1822
## s.e. 0.1198 9.5047
##
## sigma^2 estimated as 5479: log likelihood=-325.32
## AIC=656.65 AICc=657.1 BIC=662.78
fit %>% forecast(h = 10) %>%
autoplot(usa) + labs(title = "ARIMA(1,1,0) Model")
fit %>% gg_tsresiduals() + labs(title = "ARIMA (1,1,0) Residuals")
fit <- usa %>% model(arima_110 = ARIMA(box_cox ~ pdq(1,1,0)),
arima_111 = ARIMA(box_cox ~ pdq(1,1,1)),
arima_211 = ARIMA(box_cox ~ pdq(2,1,1)),
arima_212 = ARIMA(box_cox ~ pdq(2,1,2)),
arima_210 = ARIMA(box_cox ~ pdq(2,1,0)),
arima_112 = ARIMA(box_cox ~ pdq(1,1,2)),
arima_120 = ARIMA(box_cox ~ pdq(1,2,0)))
glance(fit) %>% arrange(AICc) %>% select(.model:BIC)
## # A tibble: 7 × 6
## .model sigma2 log_lik AIC AICc BIC
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 arima_120 6780. -326. 656. 656. 660.
## 2 arima_110 5479. -325. 657. 657. 663.
## 3 arima_111 5580. -325. 659. 659. 667.
## 4 arima_210 5580. -325. 659. 659. 667.
## 5 arima_112 5630. -325. 660. 661. 670.
## 6 arima_211 5647. -325. 660. 661. 671.
## 7 arima_212 5734. -325. 662. 664. 674.
fit %>% select(arima_120) %>% gg_tsresiduals() + labs(title = "ARIMA (1,2,0) Residuals")
fit %>% forecast(h = 10) %>% filter(.model == 'arima_120') %>%
autoplot(usa) + labs(title ="USA Data with ARIMA(1,2,0) model applied")
fit2 <- usa %>%
model(ETS(GDP))
report(fit2)
## Series: GDP
## Model: ETS(M,A,N)
## Smoothing parameters:
## alpha = 0.9990876
## beta = 0.5011949
##
## Initial states:
## l[0] b[0]
## 448093333334 64917355687
##
## sigma^2: 7e-04
##
## AIC AICc BIC
## 3190.787 3191.941 3201.089
fit2 %>% forecast(h = 10) %>%
autoplot(usa) + labs(title ="USA Data with ETS model applied")