Assignment Four
Niha Shamim
March 26, 2018
QUESTION ONE
Load Data and Library Packages
Indicate as time series
as4_data = ts(as_4, start=2000, frequency=4)Create a named variable
y = as4_data[,"HD"]Set training data, test data, out of sample
train.end = 2013.99
test.start = 2014
w.start = 2000
train <- window(y,start=w.start, end=train.end)
test <- window(y,start=test.start)Forecast
##h is the number of steps ahead to forecast
h = 1
##n is the number of forecasts
n <- length(test) - h + 1
fc1 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc2 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc3 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc4 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc5 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc6 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc7 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
##rolling forecasts
tic <- Sys.time()
for(i in 1:n)
{
x <- window(y, start=w.start+(i-1)/4, end= train.end + (i-1)/4)
fc1[i] <- snaive(x, h=h)$mean[h]
y.ets <- ets(x, model="ZZZ")
fc2[i] <- forecast(y.ets, h=h)$mean[h]
y.stl <- stl(x, t.window=15, s.window="periodic", robust=TRUE)
fc3[i]<- forecast(y.stl, method="rwdrift",h=h)$mean[h]
tps <- tslm(x ~ trend + season)
fc4[i] = forecast(tps,h=h)$mean[h]
refit <- auto.arima(x)
fc5[i] <- forecast(refit, h=h)$mean[h]
fc6[i] <- forecast(nnetar(x), h=h)$mean[h]
fc7[i] <- hw(x, seasonal="multiplicative", h=h)$mean[h]
}
toc <- Sys.time()
toc.minus.tic = toc - tic
toc.minus.tic## Time difference of 10.19964 secsAccuracy measures
a1 = accuracy(fc1, test)
a2 = accuracy(fc2, test)
a3 = accuracy(fc3, test)
a4 = accuracy(fc4, test)
a5 = accuracy(fc5, test)
a6 = accuracy(fc6, test)
a7 = accuracy(fc7, test)Create a table
##Combine forecast summary statistics into a table with row names
a.table<-rbind(a1, a2, a3, a4, a5, a6, a7)
row.names(a.table)<-c('S. Naive test' ,
'ETS test' ,
'STL test','linear trend test' ,
'ARIMA test',
'ANN test', 'Holt-Winters test')
##Order the table according to RMSE
a.table<-as.data.frame(a.table)
a.table<-a.table[order(a.table$RMSE),]
a.table## ME RMSE MAE MPE MAPE
## Holt-Winters test 136.4844 445.7085 350.9529 0.6552095 1.559001
## ARIMA test 179.0163 463.9962 363.6207 0.7470639 1.636414
## ETS test 295.6147 598.0295 462.7330 1.2708550 2.011210
## STL test 260.7520 648.4714 532.1293 1.0495861 2.305722
## ANN test 910.4704 1142.0016 920.0821 4.0382657 4.079778
## S. Naive test 1324.5714 1366.4500 1324.5714 5.8407351 5.840735
## linear trend test 2207.5442 2458.0269 2207.5442 9.4087915 9.408792
## ACF1 Theil's U
## Holt-Winters test -0.20464419 0.1633698
## ARIMA test -0.02212258 0.1753507
## ETS test -0.28805870 0.2161024
## STL test -0.68040614 0.2397757
## ANN test 0.03625565 0.4470707
## S. Naive test 0.26412816 0.4966301
## linear trend test 0.55349775 0.8771686format( round(a.table, 3) )## ME RMSE MAE MPE MAPE ACF1 Theil's U
## Holt-Winters test 136.484 445.708 350.953 0.655 1.559 -0.205 0.163
## ARIMA test 179.016 463.996 363.621 0.747 1.636 -0.022 0.175
## ETS test 295.615 598.029 462.733 1.271 2.011 -0.288 0.216
## STL test 260.752 648.471 532.129 1.050 2.306 -0.680 0.240
## ANN test 910.470 1142.002 920.082 4.038 4.080 0.036 0.447
## S. Naive test 1324.571 1366.450 1324.571 5.841 5.841 0.264 0.497
## linear trend test 2207.544 2458.027 2207.544 9.409 9.409 0.553 0.877## plot best forecast method for one period ahead
plot(fc7, main = "Forecasts from Holt-Winters", xlab="",ylab="", col ="blue" )
lines(test, col = "black" )
legend("topleft",lty=1,col=c("blue", "black"),
legend=c("Holt-Winters","Actual"),bty="n")
Re-do analysis for 6 period forecast
## h is the number of steps ahead to forecast
h = 6
## n is the number of forecasts
n <- length(test) - h + 1
fc1 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc2 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc3 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc4 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc5 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc6 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc7 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
# rolling forecasts
tic <- Sys.time()
for(i in 1:n)
{
x <- window(y, start=w.start+(i-1)/4, end= train.end + (i-1)/4)
fc1[i] <- snaive(x, h=h)$mean[h]
y.ets <- ets(x, model="ZZZ")
fc2[i] <- forecast(y.ets, h=h)$mean[h]
y.stl <- stl(x, t.window=15, s.window="periodic", robust=TRUE)
fc3[i]<- forecast(y.stl, method="rwdrift",h=h)$mean[h]
tps <- tslm(x ~ trend + season)
fc4[i] = forecast(tps,h=h)$mean[h]
refit <- auto.arima(x)
fc5[i] <- forecast(refit, h=h)$mean[h]
fc6[i] <- forecast(nnetar(x), h=h)$mean[h]
fc7[i] <- hw(x, seasonal="multiplicative", h=h)$mean[h]
}
toc <- Sys.time()
toc.minus.tic = toc - tic
toc.minus.tic## Time difference of 6.645239 secsAccuracy measures
a1 = accuracy(fc1, test)
a2 = accuracy(fc2, test)
a3 = accuracy(fc3, test)
a4 = accuracy(fc4, test)
a5 = accuracy(fc5, test)
a6 = accuracy(fc6, test)
a7 = accuracy(fc7, test)Combining forecast summary statistics into a table with row names
a.table<-rbind(a1, a2, a3, a4, a5, a6, a7)
row.names(a.table)<-c('S. Naive test' ,
'ETS test' ,
'STL test','linear trend test' ,
'ARIMA test',
'ANN test', 'Holt-Winters test')
## order the table according to RMSE
a.table<-as.data.frame(a.table)
a.table<-a.table[order(a.table$RMSE),]
a.table## ME RMSE MAE MPE MAPE
## Holt-Winters test 904.3846 1088.124 1029.596 3.926245 4.371712
## ARIMA test 1072.8628 1226.922 1129.251 4.486509 4.755279
## STL test 1329.4101 1392.183 1329.410 5.504236 5.504236
## ETS test 1655.3704 1766.283 1655.370 7.117203 7.117203
## ANN test 2602.8462 2822.783 2602.846 10.882957 10.882957
## S. Naive test 2848.2222 2869.769 2848.222 12.065019 12.065019
## linear trend test 3006.4170 3150.850 3006.417 12.492276 12.492276
## ACF1 Theil's U
## Holt-Winters test 0.04858149 0.3614226
## ARIMA test 0.35824057 0.4407711
## STL test -0.01625263 0.5073358
## ETS test -0.37427575 0.6838187
## ANN test -0.13543927 1.0673639
## S. Naive test 0.18012999 1.1208808
## linear trend test 0.50434872 1.2372218format( round(a.table, 3) )## ME RMSE MAE MPE MAPE ACF1
## Holt-Winters test 904.385 1088.124 1029.596 3.926 4.372 0.049
## ARIMA test 1072.863 1226.922 1129.251 4.487 4.755 0.358
## STL test 1329.410 1392.183 1329.410 5.504 5.504 -0.016
## ETS test 1655.370 1766.283 1655.370 7.117 7.117 -0.374
## ANN test 2602.846 2822.783 2602.846 10.883 10.883 -0.135
## S. Naive test 2848.222 2869.769 2848.222 12.065 12.065 0.180
## linear trend test 3006.417 3150.850 3006.417 12.492 12.492 0.504
## Theil's U
## Holt-Winters test 0.361
## ARIMA test 0.441
## STL test 0.507
## ETS test 0.684
## ANN test 1.067
## S. Naive test 1.121
## linear trend test 1.237Plot best forecast method for six period ahead
plot(fc7, main = "Forecasts from Holt-Winters", xlab="",ylab="", col ="blue" )
lines(test, col = "black" )
legend("topleft",lty=1,col=c("blue", "black"),
legend=c("Holt-Winters","Actual"),bty="n")
When comparing, and contrasting the best models for forecasting 1 period and 6 periods ahead, it is evident that when forecasting ahead, the Holt-Winters method proves to have the least amount of error, as evident when comparing the RMSE, MPE, MAPE, and MAE.
QUESTION ONE
Load libraries
Indicate as time series
as4_data = ts(as_4, start=2000, frequency=4)Create a named variable
s = as4_data[,"SPLS"]Set training data, test data, out of sample
train.end = 2014.99
test.start = 2015
w.start = 2000
train <- window(s,start=w.start, end=train.end)
test <- window(s,start=test.start)Forecast
## h is the number of steps ahead to forecast
h = 1
## n is the number of forecasts
n <- length(test) - h + 1
fc1 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc2 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc3 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc4 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc5 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc6 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc7 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
# rolling forecasts
tic <- Sys.time()
for(i in 1:n)
{
x <- window(s, start=w.start+(i-1)/4, end= train.end + (i-1)/4)
fc1[i] <- snaive(x, h=h)$mean[h]
y.ets <- ets(x, model="ZZZ")
fc2[i] <- forecast(y.ets, h=h)$mean[h]
y.stl <- stl(x, t.window=15, s.window="periodic", robust=TRUE)
fc3[i]<- forecast(y.stl, method="rwdrift",h=h)$mean[h]
tps <- tslm(x ~ trend + season)
fc4[i] = forecast(tps,h=h)$mean[h]
refit <- auto.arima(x)
fc5[i] <- forecast(refit, h=h)$mean[h]
fc6[i] <- forecast(nnetar(x), h=h)$mean[h]
fc7[i] <- hw(x, seasonal="multiplicative", h=h)$mean[h]
}
toc <- Sys.time()
toc.minus.tic = toc - tic
toc.minus.tic## Time difference of 6.439972 secsAccuracy measures
a1 = accuracy(fc1, test)
a2 = accuracy(fc2, test)
a3 = accuracy(fc3, test)
a4 = accuracy(fc4, test)
a5 = accuracy(fc5, test)
a6 = accuracy(fc6, test)
a7 = accuracy(fc7, test)Combining forecast summary statistics into a table with row names
a.table<-rbind(a1, a2, a3, a4, a5, a6, a7)
row.names(a.table)<-c('S. Naive test' ,
'ETS test' ,
'STL test','linear trend test' ,
'ARIMA test',
'ANN test', 'Holt-Winters test')
## order the table according to RMSE
a.table<-as.data.frame(a.table)
a.table<-a.table[order(a.table$RMSE),]
a.table## ME RMSE MAE MPE MAPE
## ARIMA test -58.06478 284.2823 231.1277 -1.3065107 4.936846
## Holt-Winters test -35.42463 300.6563 224.5586 -0.8953813 4.721853
## ETS test -61.39449 315.6000 251.5771 -1.4316436 5.342281
## STL test -136.04504 374.8556 287.8938 -2.9497084 6.134177
## S. Naive test -458.43600 529.2650 458.4360 -9.9781877 9.978188
## ANN test -589.14133 683.9756 593.4851 -13.2643032 13.346369
## linear trend test -1824.77021 1847.5638 1824.7702 -39.6216199 39.621620
## ACF1 Theil's U
## ARIMA test -0.1309017071 0.4342195
## Holt-Winters test 0.0008629252 0.4778649
## ETS test 0.0007714175 0.4926330
## STL test -0.1889633424 0.5440613
## S. Naive test 0.1567008953 0.7698475
## ANN test -0.1537827356 1.0134823
## linear trend test 0.3138998886 2.7213027format( round(a.table, 3) )## ME RMSE MAE MPE MAPE ACF1
## ARIMA test -58.065 284.282 231.128 -1.307 4.937 -0.131
## Holt-Winters test -35.425 300.656 224.559 -0.895 4.722 0.001
## ETS test -61.394 315.600 251.577 -1.432 5.342 0.001
## STL test -136.045 374.856 287.894 -2.950 6.134 -0.189
## S. Naive test -458.436 529.265 458.436 -9.978 9.978 0.157
## ANN test -589.141 683.976 593.485 -13.264 13.346 -0.154
## linear trend test -1824.770 1847.564 1824.770 -39.622 39.622 0.314
## Theil's U
## ARIMA test 0.434
## Holt-Winters test 0.478
## ETS test 0.493
## STL test 0.544
## S. Naive test 0.770
## ANN test 1.013
## linear trend test 2.721## plot forecasts one period ahead
plot(fc7, main = "Forecasts from Holt-Winters", xlab="",ylab="", col ="blue" )
lines(test, col = "black" )
legend("topleft",lty=1,col=c("blue", "black"),
legend=c("Holt-Winters","Actual"),bty="n")
Re-do analysis to forecast three periods ahead
## h is the number of steps ahead to forecast
h = 3
## n is the number of forecasts
n <- length(test) - h + 1
fc1 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc2 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc3 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc4 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc5 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc6 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)
fc7 <- ts(numeric(n), start=test.start+(h-1)/4, freq=4)Rolling forecasts
tic <- Sys.time()
for(i in 1:n)
{
x <- window(s, start=w.start+(i-1)/4, end= train.end + (i-1)/4)
fc1[i] <- snaive(x, h=h)$mean[h]
y.ets <- ets(x, model="ZZZ")
fc2[i] <- forecast(y.ets, h=h)$mean[h]
y.stl <- stl(x, t.window=15, s.window="periodic", robust=TRUE)
fc3[i]<- forecast(y.stl, method="rwdrift",h=h)$mean[h]
tps <- tslm(x ~ trend + season)
fc4[i] = forecast(tps,h=h)$mean[h]
refit <- auto.arima(x)
fc5[i] <- forecast(refit, h=h)$mean[h]
fc6[i] <- forecast(nnetar(x), h=h)$mean[h]
fc7[i] <- hw(x, seasonal="multiplicative", h=h)$mean[h]
}
toc <- Sys.time()
toc.minus.tic = toc - tic
toc.minus.tic## Time difference of 5.415289 secsAccuracy measures
a1 = accuracy(fc1, test)
a2 = accuracy(fc2, test)
a3 = accuracy(fc3, test)
a4 = accuracy(fc4, test)
a5 = accuracy(fc5, test)
a6 = accuracy(fc6, test)
a7 = accuracy(fc7, test)Combining forecast summary statistics into a table with row names
a.table<-rbind(a1, a2, a3, a4, a5, a6, a7)
row.names(a.table)<-c('S. Naive test' ,
'ETS test' ,
'STL test','linear trend test' ,
'ARIMA test',
'ANN test', 'Holt-Winters test')
## order the table according to RMSE
a.table<-as.data.frame(a.table)
a.table<-a.table[order(a.table$RMSE),]
a.table## ME RMSE MAE MPE MAPE
## Holt-Winters test -143.5170 359.7995 249.4078 -3.347953 5.707532
## ARIMA test -203.6239 377.7911 256.8638 -4.604797 5.872651
## ETS test -218.6501 437.1190 277.8028 -5.141086 6.406163
## S. Naive test -488.4997 566.4178 488.4997 -10.821448 10.821448
## STL test -521.7936 632.3850 521.7936 -12.070037 12.070037
## ANN test -731.6793 814.1627 731.6793 -16.733064 16.733064
## linear trend test -2145.1605 2162.1604 2145.1605 -47.497398 47.497398
## ACF1 Theil's U
## Holt-Winters test 0.42436441 0.5103822
## ARIMA test 0.40300465 0.5321149
## ETS test 0.26653652 0.6263596
## S. Naive test 0.09360533 0.7862954
## STL test 0.21805822 0.9226270
## ANN test -0.07185173 1.1848642
## linear trend test -0.03589817 3.0569446format( round(a.table, 3) )## ME RMSE MAE MPE MAPE ACF1
## Holt-Winters test -143.517 359.800 249.408 -3.348 5.708 0.424
## ARIMA test -203.624 377.791 256.864 -4.605 5.873 0.403
## ETS test -218.650 437.119 277.803 -5.141 6.406 0.267
## S. Naive test -488.500 566.418 488.500 -10.821 10.821 0.094
## STL test -521.794 632.385 521.794 -12.070 12.070 0.218
## ANN test -731.679 814.163 731.679 -16.733 16.733 -0.072
## linear trend test -2145.160 2162.160 2145.160 -47.497 47.497 -0.036
## Theil's U
## Holt-Winters test 0.510
## ARIMA test 0.532
## ETS test 0.626
## S. Naive test 0.786
## STL test 0.923
## ANN test 1.185
## linear trend test 3.057## plot forecasts three period ahead
plot(fc7, main = "Forecasts from Holt-Winters", xlab="",ylab="", col ="blue" )
lines(test, col = "black" )
legend("topleft",lty=1,col=c("blue", "black"),
legend=c("Holt-Winters","Actual"),bty="n")
When comparing, and contrasting the best models for forecasting 1 period and 6 periods ahead, it is evident that when forecasting ahead, the Holt-Winters method proves to have the least amount of error, as evident when comparing the RMSE, MPE, MAPE, and MAE.