-
Notifications
You must be signed in to change notification settings - Fork 23
/
Aviation_Exponential_Smoothing_Forecasting.r
113 lines (94 loc) · 3.68 KB
/
Aviation_Exponential_Smoothing_Forecasting.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
#Forecasting
#Exponential Smoothing Forecasting
install.packages(c("forecast","fpp","smooth","tseries"))
library(forecast)
library(fpp)
library(smooth)
library(tseries)
# Loading Amtrak Data
library(readxl)
aviation<-read.csv(file.choose()) # Aviation.csv
View(aviation)
aviation<-aviation
# Converting data into time series object
amts<-ts(aviation$Sales,frequency = 4,start=c(86))
View(amts)
plot(amts)
# dividing entire data into training and testing data
train<-amts[1:38]
test<-amts[39:42] # Considering only 4 Quarters of data for testing because data itself is Quarterly
# seasonal data
# converting time series object
train<-ts(train,frequency = 4)
test<-ts(test,frequency = 4)
# Plotting time series data
plot(train) # Visualization shows that it has level, trend, seasonality => Additive seasonality
#### USING HoltWinters function ################
# Optimum values
# with alpha = 0.2 which is default value
# Assuming time series data has only level parameter
hw_a<-HoltWinters(train,alpha = 0.2,beta = F,gamma = F)
hw_a
hwa_pred<-data.frame(predict(hw_a,n.ahead=4))
# By looking at the plot the forecasted values are not showing any characters of train data
plot(forecast(hw_a,h=4))
hwa_mape<-MAPE(hwa_pred$fit,test)*100
# with alpha = 0.2, beta = 0.1
# Assuming time series data has level and trend parameter
hw_ab<-HoltWinters(train,alpha = 0.2,beta = 0.1,gamma = F)
hw_ab
hwab_pred<-data.frame(predict(hw_ab,n.ahead = 4))
# by looking at the plot the forecasted values are still missing some characters exhibited by train data
plot(forecast(hw_ab,h=4))
hwab_mape<-MAPE(hwab_pred$fit,test)*100
# with alpha = 0.2, beta = 0.1, gamma = 0.1
# Assuming time series data has level,trend and seasonality
hw_abg<-HoltWinters(train,alpha = 0.2,beta = 0.1,gamma = 0.1)
hw_abg
hwabg_pred<-data.frame(predict(hw_abg,n.ahead = 4))
# by looking at the plot the characters of forecasted values are closely following historical data
plot(forecast(hw_abg,h=4))
hwabg_mape<-MAPE(hwabg_pred$fit,test)*100
# With out optimum values
hw_na<-HoltWinters(train,beta = F,gamma = F)
hw_na
hwna_pred<-data.frame(predict(hw_na,n.ahead = 4))
hwna_pred
plot(forecast(hw_na,h=4))
hwna_mape<-MAPE(hwna_pred$fit,test)*100
hw_nab<-HoltWinters(train,gamma=F)
hw_nab
hwnab_pred<-data.frame(predict(hw_nab,n.ahead=4))
hwnab_pred
plot(forecast(hw_nab,h=4))
hwnab_mape<-MAPE(hwnab_pred$fit,test)*100
hw_nabg<-HoltWinters(train)
hw_nabg
hwnabg_pred<-data.frame(predict(hw_nabg,n.ahead =4))
hwnabg_pred
plot(forecast(hw_nabg,h=4))
hwnabg_mape<-MAPE(hwnabg_pred$fit,test)*100
df_mape<-data.frame(c("hwa_mape","hwab_mape","hwabg_mape","hwna_mape","hwnab_mape","hwnabg_mape"),c(hwa_mape,hwab_mape,hwabg_mape,hwna_mape,hwnab_mape,hwnabg_mape))
colnames(df_mape)<-c("MAPE","VALUES")
View(df_mape)
# Based on the MAPE value who choose holts winter exponential tecnique which assumes the time series
# Data level, trend, seasonality characters with default values of alpha, beta and gamma
new_model <- HoltWinters(amts)
plot(forecast(new_model,n.ahead=4))
# Forecasted values for the next 4 quarters
forecast_new <- data.frame(predict(new_model,n.ahead=4))
#ARIMA Models
plot(train)
acf(train) #for Moving Average(MA) q value
pacf(train) #For Auto Regressive(AR) p value
a<- arima(train, order = c(1,1,8), method = "ML") #Here in Order the first 1 stands for p, the second 1 stands for d i.e the differencing for Integration and the 8 stands for q
#Auto.ARIMA model on the price agg data
library(forecast)
model_AA <- auto.arima(train)
model_AA
pred_AA <- data.frame(forecast(model_AA))
pred_AA
acf(model_AA$residuals) #For finding significance in error data
pacf(model_AA$residuals) #For finding the significance in error data
windows()
plot(forecast(model_AA, h=12),xaxt = "n")