#Load Libaries
library(httr)
library(fpp3)
## ── Attaching packages ──────────────────────────────────────────── fpp3 0.4.0 ──
## ✓ tibble 3.1.4 ✓ tsibble 1.1.1
## ✓ dplyr 1.0.7 ✓ tsibbledata 0.4.0
## ✓ tidyr 1.1.3 ✓ feasts 0.2.2
## ✓ lubridate 1.8.0 ✓ fable 0.3.1
## ✓ ggplot2 3.3.5
## Warning: package 'tsibbledata' was built under R version 4.1.2
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## x lubridate::date() masks base::date()
## x dplyr::filter() masks stats::filter()
## x tsibble::intersect() masks base::intersect()
## x tsibble::interval() masks lubridate::interval()
## x dplyr::lag() masks stats::lag()
## x tsibble::setdiff() masks base::setdiff()
## x tsibble::union() masks base::union()
library(forecast)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
#Load Data
rentals<-read.csv("/Users/Luke/Documents/BC/Predictive Analytics/Discussion 4/Rentals.csv")
rentals$Date<-as.Date(rentals$Date)
#Training and Validation set
rts<- ts(rentals$Vacant, frequency=4, start=c(1956-01-01))
train<- ts(rentals$Vacant[1:212], frequency=4, start=c(1956-01-01))
test<-ts(rentals$Vacant[213:264], frequency=4,start=c(2008-01-01))
Plots below show strong correlation at lag=1
autoplot(rts)
autoplot(acf(rts))
autoplot(pacf(rts))
nsdiffs(rts)
## [1] 0
rts %>% diff(lag=1) %>% ggtsdisplay()
r_arima <- auto.arima(train)
r_ets<- ets(train)
r_predict <- forecast(r_arima, 36)
r_predict2<- forecast(r_ets, 36)
for (i in 1:30){
print(Box.test(r_arima$residuals,lag=i,type='Ljung-Box'))
}
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 0.0098039, df = 1, p-value = 0.9211
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 0.012541, df = 2, p-value = 0.9937
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 0.097232, df = 3, p-value = 0.9922
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 0.13412, df = 4, p-value = 0.9978
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 0.14133, df = 5, p-value = 0.9996
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 0.61352, df = 6, p-value = 0.9962
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 1.4758, df = 7, p-value = 0.9831
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 1.5278, df = 8, p-value = 0.9922
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 2.548, df = 9, p-value = 0.9796
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 5.2309, df = 10, p-value = 0.8752
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 5.9796, df = 11, p-value = 0.8747
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 7.2103, df = 12, p-value = 0.8434
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 7.3484, df = 13, p-value = 0.8833
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 7.3938, df = 14, p-value = 0.9185
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 10.059, df = 15, p-value = 0.816
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 11.046, df = 16, p-value = 0.8066
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 12.227, df = 17, p-value = 0.7862
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 12.305, df = 18, p-value = 0.8311
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 12.703, df = 19, p-value = 0.8534
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 17.416, df = 20, p-value = 0.6258
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 17.717, df = 21, p-value = 0.6668
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 18.745, df = 22, p-value = 0.661
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 18.804, df = 23, p-value = 0.7125
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 18.827, df = 24, p-value = 0.7612
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 21.978, df = 25, p-value = 0.637
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 23.254, df = 26, p-value = 0.6185
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 24.585, df = 27, p-value = 0.5977
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 24.736, df = 28, p-value = 0.6421
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 24.954, df = 29, p-value = 0.6806
##
##
## Box-Ljung test
##
## data: r_arima$residuals
## X-squared = 25.009, df = 30, p-value = 0.7246
checkresiduals(r_ets)
##
## Ljung-Box test
##
## data: Residuals from ETS(A,Ad,A)
## Q* = 30.043, df = 3, p-value = 1.352e-06
##
## Model df: 9. Total lags used: 12
}
library('kableExtra')
##
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
##
## group_rows
acc1=accuracy(r_predict, test)
acc2=accuracy(r_predict2, test)
acc1%>%kbl(caption="Arima")%>%kable_classic(html_font="Cambria")
| ME | RMSE | MAE | MPE | MAPE | MASE | ACF1 | Theil’s U | |
|---|---|---|---|---|---|---|---|---|
| Training set | 0.014776 | 0.2696914 | 0.2146488 | 0.1335032 | 3.044963 | 0.5573902 | -0.0067525 | NA |
| Test set | -2.329023 | 2.6355683 | 2.3738461 | -31.7688303 | 32.193091 | 6.1642945 | 0.8738571 | 8.457245 |
acc2%>%kbl(caption="ETS")%>%kable_classic(html_font="Cambria")
| ME | RMSE | MAE | MPE | MAPE | MASE | ACF1 | Theil’s U | |
|---|---|---|---|---|---|---|---|---|
| Training set | 0.0150688 | 0.2772624 | 0.222431 | 0.1290809 | 3.207821 | 0.5775987 | 0.0597977 | NA |
| Test set | -2.2404990 | 2.5565599 | 2.294501 | -30.6367397 | 31.147147 | 5.9582556 | 0.8819716 | 8.218066 |
autoplot(r_predict)
ets(train)
## ETS(A,Ad,A)
##
## Call:
## ets(y = train)
##
## Smoothing parameters:
## alpha = 0.6382
## beta = 0.1364
## gamma = 1e-04
## phi = 0.8308
##
## Initial states:
## l = 6.0988
## b = 0.0041
## s = -0.0818 0.0625 -0.0118 0.0312
##
## sigma: 0.2833
##
## AIC AICc BIC
## 611.6930 612.7875 645.2589