sarima3
60
90
120
150
2014 Jan 2016 Jan 2018 Jan
Month [1M]
Close
60
90
120
150
2014 Jan 2016 Jan 2018 Jan
Month [1M]
$USD
2013
2014
2015
2016
2017
2018
60
90
120
150
DecJan Feb Mar Apr May Jun Jul Aug Sept Oct Nov
Month
$USD
Jan
Feb
Mar
Apr
May
Jun
Jul
Aug
Sept
Oct
Nov
Dec
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
2014
2016
2018
60
90
120
150
Month
$USD
lag 7
lag 8
lag 9
lag 4
lag 5
lag 6
lag 1
lag 2
lag 3
60 90 120 150 60 90 120 150 60 90 120 150
60
90
120
150
60
90
120
150
60
90
120
150
lag(Close, n)
$USD
season
Jan
Feb
Mar
Apr
May
Jun
Jul
Aug
Sept
Oct
Nov
Dec
(𝑘 = 1 𝑡𝑜 𝑘 = 3)
𝑘 = 9
−0.25
0.00
0.25
0.50
0.75
6 12
lag [1M]
$USD
Close
trend
season_year
remainder
2014 Jan 2016 Jan 2018 Jan
60
90
120
150
60
90
120
150
180
−2
0
2
−10
−5
0
5
10
Month
Close = trend + season_year + remainder
STL decomposition
60
90
120
150
180
2014 Jan 2016 Jan 2018 Jan
Month [1M]
$USD
colour
season_adjust
trend
−0.25
0.00
0.25
0.50
0.75
6 12
lag [1M]
acf
ACF Plot of Close
−0.3
−0.2
−0.1
0.0
0.1
0.2
6 12
lag [1M]
pacf
PACF Plot of Close
(𝜂 = 1.259, 𝑝 = 0.01)
−0.2
−0.1
0.0
0.1
0.2
6 12
lag [1M]
acf
ACF Plot of Differenced
−0.3
−0.2
−0.1
0.0
0.1
0.2
6 12
lag [1M]
pacf
PACF Plot of Differenced
−0.50
−0.25
0.00
0.25
6 12
lag [1M]
acf
−0.25
0.00
0.25
6 12
lag [1M]
pacf
Close
diff_close
diff_sclose
2014 Jan 2016 Jan 2018 Jan 2014 Jan 2016 Jan 2018 Jan 2014 Jan 2016 Jan 2018 Jan
−20
−10
0
10
20
−10
−5
0
5
10
15
60
90
120
150
Month [1M]
Value
Series
Close
diff_close
diff_sclose
ARIMA(0,1,0)(0,0,1)[12]
ARIMA(0,1,0)
sarima3
ARIMA(0,1,1)(0,1,1)[12]
( = 247, = 247.7, = 251.6)
sarima3
sarima3
(𝑙 = −120.5)
sarima3
(𝜎
2
= 38.02)
sarima1 (𝜎
2
= 29.45)
sarima3
ARIMA(0,1,1)(0,1,1)[12]
sarima3
−15
−10
−5
0
5
10
2013 Jan 2014 Jan 2015 Jan 2016 Jan 2017 Jan
Month
Innovation residuals
−0.3
−0.2
−0.1
0.0
0.1
0.2
0.3
6 12
lag [1M]
acf
0
5
10
15
−10 0 10
.resid
count
ARIMA(0,1,1)(0,1,1)[12]
sarima3
sarima3
𝑝
(𝑄
∗
= 18.2, 𝑝 = .7411)
ARIMA(0,1,1)(0,1,1)[12]
( = 23.6)
( = 24.9
( = 23.6)
𝑀𝐴𝑃 𝐸
( = 1.01)
( = .494)
60
90
120
150
2014 Jan 2016 Jan 2018 Jan
Month
$USD
Point Forecast(SARIMA3)
100
150
200
2014 Jan 2016 Jan 2018 Jan
Month
$USD
level
90%
95%
Interval Forecast(SARIMA3)
50
100
150
200
250
2014 Jan 2016 Jan 2018 Jan 2020 Jan
Month
$USD
level
90%
95%
Interval Forecast(SARIMA3)
100
150
200
2014 Jan 2016 Jan 2018 Jan 2020 Jan
Month
$USD
Point Forecast
library(tidyverse)
library(here)
library(fpp3)
library(pander)
library(patchwork)
data <- read_csv("all_stocks_5yr.csv")
pander(head(data, n = 10), caption = "Preview of the data")
data_monthly <- data %>%
as_tsibble(index = date, key = Name) %>%
index_by(Month = yearmonth(date)) %>%
relocate(Month, .before = 1)
ts <- bind_rows(head(data_monthly, n = 6),
tail(data_monthly, n = 6))
pander(ts, caption = "Aggregating the Dataset into Time Series Dataset")
data_close <- data_monthly %>%
filter(Name == "AAPL") %>%
select(Month, Name, close) %>%
summarise(Close = mean(close))
d1 <- data_close %>% head(n = 7)
d2 <- data_close %>% tail(n = 7)
pander(bind_rows(head(d1, n = 7),
tail(d2, n = 7)),
caption = "Adjusted Monthly Apple Close Stock Prices")
data_train <- data_close %>%
filter(yearmonth(Month) < yearmonth("2017 Feb"))
data_test <- data_close %>%
filter(yearmonth(Month) >= yearmonth("2017 Feb"))
autoplot(data_test) +
geom_line(
data = data_train,
mapping = aes(
x = Month,
y = Close
),
colour = "darkblue",
linewidth = 2
)
data_close %>%
autoplot(Close) +
labs(y = "$USD")
p1 <- data_close %>%
gg_season(Close, labels = "right",
labels_repel = T) +
labs(y = "$USD")
p2 <- data_close %>%
gg_subseries(Close) +
labs(y = "$USD")
p1 / p2
data_close %>%
gg_lag(Close, geom = "point") +
labs(
y = "$USD"
)
data_close %>%
ACF(Close, lag_max = 12) %>%
autoplot() +
labs(
y = "$USD"
)
decomp <- data_close %>%
model(stl = STL(Close)) %>%
components()
d1 <- bind_rows(head(decomp, n = 7),
tail(decomp, n = 7))
pander(d1, caption = "STL decomposition of the Apple Closing Stock Prices")
decomp %>% autoplot()
decomp %>%
as_tsibble() %>%
autoplot(Close, colour = "darkgreen") +
geom_line(aes(y = trend, colour = "trend")) +
geom_line(aes(y = season_adjust,
colour = "season_adjust")) +
labs(
y = "$USD"
)
p3 <- data_close %>%
ACF(Close) %>% autoplot() +
labs(title = "ACF Plot of Close")
p4 <- data_close %>%
PACF(difference(Close)) %>% autoplot() +
labs(title = "PACF Plot of Close")
p3 | p4
data_close %>%
features(Close,
unitroot_kpss)%>% pander(caption = "KPSS Test Result")# KPSS test to determine if differencing must be done
d1 <- data_close %>%
ACF(difference(Close)) %>% autoplot() +
labs(title = "ACF Plot of Differenced")
d2 <- data_close %>%
PACF(difference(Close)) %>% autoplot() +
labs(title = "PACF Plot of Differenced")
d1 | d2
data_close <- data_close %>%
mutate(diff_close = difference(Close))
data_sclose <- data_close %>%
mutate(diff_sclose = difference(difference(Close,
lag = 12),
lag = 1))
p11 <- data_close %>%
ACF(difference(difference(Close, lag = 12),
lag = 1)) %>%
autoplot()
p12 <- data_close %>%
PACF(difference(difference(Close,
lag = 12),
lag = 1)) %>%
autoplot()
p11 | p12
data_sclose %>%
pivot_longer(cols = c(Close, diff_close, diff_sclose),
names_to = "Series",
values_to = "Value") %>%
autoplot(Value) +
facet_wrap(~Series, scales = "free_y")
fit <- data_train %>%
model(
sarima1 = ARIMA(Close ~ pdq(0,1,0) + PDQ(0,0,1)),
sarima2 = ARIMA(Close ~ pdq(0,1,1) + PDQ(0,0,1)),
sarima3 = ARIMA(Close ~ pdq(0,1,1) + PDQ(0,1,1)),
arima1 = ARIMA(Close ~ pdq(0,1,0))
)
fit1 <- fit %>% pivot_longer(
everything(),
names_to = "Model",
values_to = "Order")
pander(fit1)
glance(fit) %>%
arrange(AICc) %>%
select(.model:BIC) %>% pander(caption = "Model Evaluation for the fitted models")
fit %>% select(sarima3) %>%
gg_tsresiduals()
ljung <- augment(fit) %>%
features(.innov, ljung_box, lag = 24)# do not reject null
ljung %>% filter(.model == "sarima3") %>% pander(caption = "Ljung-Box Test for SARIMA3 Model")
fc <- fit %>%
forecast(h = 13) %>%
filter(.model == "sarima3")
pander(accuracy(fc, data_close[c(1,2)]), caption = "Pseudo Out-of-Sample Forecasting Accuracy")
forecast(fit, h = 13) |>
filter(.model =='sarima3') |>
autoplot(data_test, level = NULL) +
geom_line(data = data_train, aes(y = Close)) +
labs(y = "$USD",
title = "Point Forecast(SARIMA3)")
pseudo1 <- forecast(fit, h = 13) |>
filter(.model =='sarima3') |>
autoplot(data_test, level = NULL) +
geom_line(data = data_train, aes(y = Close)) +
labs(y = "$USD",
title = "Point Forecast(SARIMA3)")
pseudo2 <- forecast(fit, h = 13) |>
filter(.model == 'sarima3') |>
autoplot(data_test, level = c(90,95)) +
geom_line(data = data_train, aes(y = Close)) +
labs(y = "$USD",
title = "Interval Forecast(SARIMA3)")
pseudo1 | pseudo2
fc %>%
hilo(level = c(90, 95)) %>%
pander(caption = "Pseudo Out of Sample Forecast Values")
fit2 <- data_close %>% model(
sarima3 = ARIMA(Close ~ pdq(0,1,1) + PDQ(0,1,1))
)
fc2 <- fit2 %>%
forecast(h = 24) %>%
filter(.model == "sarima3")
true1 <- forecast(fit2, h = 24) |>
filter(.model == 'sarima3') |>
autoplot(data_close, level = c(90,95)) +
labs(y = "$USD",
title = "Interval Forecast(SARIMA3)")
true2 <- fit2 %>% forecast(h = 24) %>%
filter(.model == "sarima3") %>%
autoplot(data_close, level = NULL) +
labs(
y = "$USD",
title = "Point Forecast"
)
true1 | true2
fc2 %>%
hilo(level = c(90, 95)) %>%
pander(caption = "True Out of Sample Forecast Values")
