library(readxl)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(forecast)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(ggplot2)
library(tseries)
library(MASS)
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
library(DescTools)
##
## Attaching package: 'DescTools'
## The following object is masked from 'package:forecast':
##
## BoxCox
library(Metrics)
##
## Attaching package: 'Metrics'
## The following object is masked from 'package:forecast':
##
## accuracy
data2 = read_excel("C:/Users/user/Desktop/dts.xlsx")
attach(data2)
data_train = subset(x = data2 , year != 1397)
data_test = subset(x = data2 , year == 1397)
data_train = data_train["expenses2"]
data_test = data_test["expenses2"]
data_train = ts(data = data_train , start = c(1394,1) , frequency = 12)
autoplot(data_train , col = "red")
d = decompose(data_train)
plot(d)
ggAcf(data_train) + ggtitle("ACF Plot for expenses")
ggPacf(data_train) + ggtitle("PACF plot for expenses")
ndiffs(data_train)
## [1] 0
Box.test(data_train, type = "Lj")
##
## Box-Ljung test
##
## data: data_train
## X-squared = 6.242, df = 1, p-value = 0.01248
adf.test(data_train)
##
## Augmented Dickey-Fuller Test
##
## data: data_train
## Dickey-Fuller = -2.5139, Lag order = 3, p-value = 0.3732
## alternative hypothesis: stationary
l = BoxCoxLambda(data_train)
d_t = BoxCox(x=data_train, lambda = l )
autoplot(d_t)
adf.test(d_t)
##
## Augmented Dickey-Fuller Test
##
## data: d_t
## Dickey-Fuller = -2.6063, Lag order = 3, p-value = 0.3372
## alternative hypothesis: stationary
ggAcf(d_t) + ggtitle("ACF Plot for expenses")
ggPacf(d_t) + ggtitle("PACF plot for expenses")
Box.test(d_t, type = "Lj")
##
## Box-Ljung test
##
## data: d_t
## X-squared = 4.0313, df = 1, p-value = 0.04466
model_arima = auto.arima(d_t , trace = TRUE, ic = "aic")
##
## ARIMA(2,0,2)(1,1,1)[12] with drift : Inf
## ARIMA(0,0,0)(0,1,0)[12] with drift : Inf
## ARIMA(1,0,0)(1,1,0)[12] with drift : Inf
## ARIMA(0,0,1)(0,1,1)[12] with drift : Inf
## ARIMA(0,0,0)(0,1,0)[12] : 1956.869
## ARIMA(0,0,0)(1,1,0)[12] with drift : Inf
## ARIMA(0,0,0)(0,1,1)[12] with drift : Inf
## ARIMA(0,0,0)(1,1,1)[12] with drift : Inf
## ARIMA(1,0,0)(0,1,0)[12] with drift : Inf
## ARIMA(0,0,1)(0,1,0)[12] with drift : Inf
## ARIMA(1,0,1)(0,1,0)[12] with drift : Inf
##
## Best model: ARIMA(0,0,0)(0,1,0)[12]
p_arima = forecast(model_arima , h = 48)
dd_arima = as.data.frame(p_arima)
checkresiduals(model_arima)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(0,0,0)(0,1,0)[12]
## Q* = 21.304, df = 7, p-value = 0.003345
##
## Model df: 0. Total lags used: 7
shapiro.test(model_arima$residuals)
##
## Shapiro-Wilk normality test
##
## data: model_arima$residuals
## W = 0.92441, p-value = 0.017
mape <- function(actual,pred){
mape <- mean(abs((actual - pred)/actual))*100
return (mape)
}
mape(data_test$expenses2 ,BoxCoxInv(x = dd_arima$`Point Forecast` , lambda = l))
## [1] 43.18765
rmse(data_test$expenses2 ,BoxCoxInv(x = dd_arima$`Point Forecast` , lambda = l))
## [1] 331688206
sem = ses(y = d_t, h = 48)
summary(sem)
##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = d_t, h = 48)
##
## Smoothing parameters:
## alpha = 0.3688
##
## Initial states:
## l = 332543027093098368
##
## sigma: 1.561194e+17
##
## AIC AICc BIC
## 2983.386 2984.136 2988.136
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -1.59083e+16 1.517208e+17 1.127328e+17 -39.1131 58.61838 1.168356
## ACF1
## Training set 0.08295211
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 1397 1.213422e+17 -7.873286e+16 3.214172e+17 -1.846462e+17 4.273305e+17
## Feb 1397 1.213422e+17 -9.190441e+16 3.345888e+17 -2.047903e+17 4.474747e+17
## Mar 1397 1.213422e+17 -1.043084e+17 3.469928e+17 -2.237606e+17 4.664450e+17
## Apr 1397 1.213422e+17 -1.160652e+17 3.587496e+17 -2.417411e+17 4.844255e+17
## May 1397 1.213422e+17 -1.272667e+17 3.699510e+17 -2.588722e+17 5.015566e+17
## Jun 1397 1.213422e+17 -1.379847e+17 3.806691e+17 -2.752641e+17 5.179484e+17
## Jul 1397 1.213422e+17 -1.482770e+17 3.909614e+17 -2.910048e+17 5.336892e+17
## Aug 1397 1.213422e+17 -1.581907e+17 4.008750e+17 -3.061664e+17 5.488508e+17
## Sep 1397 1.213422e+17 -1.677645e+17 4.104489e+17 -3.208084e+17 5.634927e+17
## Oct 1397 1.213422e+17 -1.770314e+17 4.197157e+17 -3.349808e+17 5.776651e+17
## Nov 1397 1.213422e+17 -1.860190e+17 4.287033e+17 -3.487261e+17 5.914104e+17
## Dec 1397 1.213422e+17 -1.947511e+17 4.374354e+17 -3.620807e+17 6.047651e+17
## Jan 1398 1.213422e+17 -2.032484e+17 4.459327e+17 -3.750762e+17 6.177606e+17
## Feb 1398 1.213422e+17 -2.115288e+17 4.542132e+17 -3.877401e+17 6.304245e+17
## Mar 1398 1.213422e+17 -2.196083e+17 4.622926e+17 -4.000965e+17 6.427809e+17
## Apr 1398 1.213422e+17 -2.275006e+17 4.701849e+17 -4.121668e+17 6.548512e+17
## May 1398 1.213422e+17 -2.352183e+17 4.779026e+17 -4.239700e+17 6.666543e+17
## Jun 1398 1.213422e+17 -2.427724e+17 4.854568e+17 -4.355231e+17 6.782074e+17
## Jul 1398 1.213422e+17 -2.501730e+17 4.928574e+17 -4.468413e+17 6.895256e+17
## Aug 1398 1.213422e+17 -2.574290e+17 5.001134e+17 -4.579384e+17 7.006227e+17
## Sep 1398 1.213422e+17 -2.645486e+17 5.072330e+17 -4.688269e+17 7.115112e+17
## Oct 1398 1.213422e+17 -2.715392e+17 5.142236e+17 -4.795181e+17 7.222024e+17
## Nov 1398 1.213422e+17 -2.784076e+17 5.210919e+17 -4.900223e+17 7.327067e+17
## Dec 1398 1.213422e+17 -2.851599e+17 5.278443e+17 -5.003491e+17 7.430335e+17
## Jan 1399 1.213422e+17 -2.918019e+17 5.344863e+17 -5.105072e+17 7.531915e+17
## Feb 1399 1.213422e+17 -2.983388e+17 5.410232e+17 -5.205045e+17 7.631888e+17
## Mar 1399 1.213422e+17 -3.047754e+17 5.474598e+17 -5.303485e+17 7.730328e+17
## Apr 1399 1.213422e+17 -3.111163e+17 5.538006e+17 -5.400459e+17 7.827303e+17
## May 1399 1.213422e+17 -3.173654e+17 5.600498e+17 -5.496032e+17 7.922876e+17
## Jun 1399 1.213422e+17 -3.235269e+17 5.662112e+17 -5.590263e+17 8.017107e+17
## Jul 1399 1.213422e+17 -3.296041e+17 5.722885e+17 -5.683206e+17 8.110050e+17
## Aug 1399 1.213422e+17 -3.356005e+17 5.782849e+17 -5.774914e+17 8.201757e+17
## Sep 1399 1.213422e+17 -3.415193e+17 5.842036e+17 -5.865433e+17 8.292277e+17
## Oct 1399 1.213422e+17 -3.473633e+17 5.900476e+17 -5.954810e+17 8.381653e+17
## Nov 1399 1.213422e+17 -3.531353e+17 5.958197e+17 -6.043085e+17 8.469929e+17
## Dec 1399 1.213422e+17 -3.588380e+17 6.015223e+17 -6.130300e+17 8.557143e+17
## Jan 1400 1.213422e+17 -3.644737e+17 6.071580e+17 -6.216491e+17 8.643334e+17
## Feb 1400 1.213422e+17 -3.700448e+17 6.127291e+17 -6.301693e+17 8.728537e+17
## Mar 1400 1.213422e+17 -3.755534e+17 6.182378e+17 -6.385940e+17 8.812784e+17
## Apr 1400 1.213422e+17 -3.810016e+17 6.236860e+17 -6.469264e+17 8.896107e+17
## May 1400 1.213422e+17 -3.863914e+17 6.290758e+17 -6.551693e+17 8.978537e+17
## Jun 1400 1.213422e+17 -3.917246e+17 6.344089e+17 -6.633257e+17 9.060100e+17
## Jul 1400 1.213422e+17 -3.970028e+17 6.396872e+17 -6.713981e+17 9.140825e+17
## Aug 1400 1.213422e+17 -4.022279e+17 6.449123e+17 -6.793892e+17 9.220735e+17
## Sep 1400 1.213422e+17 -4.074014e+17 6.500857e+17 -6.873013e+17 9.299856e+17
## Oct 1400 1.213422e+17 -4.125247e+17 6.552090e+17 -6.951367e+17 9.378211e+17
## Nov 1400 1.213422e+17 -4.175993e+17 6.602836e+17 -7.028977e+17 9.455820e+17
## Dec 1400 1.213422e+17 -4.226266e+17 6.653109e+17 -7.105862e+17 9.532705e+17
df_s = as.data.frame(sem)
checkresiduals(sem)
##
## Ljung-Box test
##
## data: Residuals from Simple exponential smoothing
## Q* = 12.883, df = 5, p-value = 0.0245
##
## Model df: 2. Total lags used: 7
shapiro.test(sem$residuals)
##
## Shapiro-Wilk normality test
##
## data: sem$residuals
## W = 0.92643, p-value = 0.01954
mape(data_test$expenses2 ,BoxCoxInv(x = df_s$`Point Forecast` , lambda = l))
## [1] 30.67401
rmse(data_test$expenses2 ,BoxCoxInv(x = df_s$`Point Forecast` , lambda = l) )
## [1] 268389083
hom = holt(y = d_t , h = 48)
summary(hom)
##
## Forecast method: Holt's method
##
## Model Information:
## Holt's method
##
## Call:
## holt(y = d_t, h = 48)
##
## Smoothing parameters:
## alpha = 0.3215
## beta = 1e-04
##
## Initial states:
## l = 485023378726680896
## b = -6930247585168800
##
## sigma: 1.616766e+17
##
## AIC AICc BIC
## 2987.721 2989.721 2995.639
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -1.001318e+16 1.524302e+17 1.144527e+17 -36.23619 58.4506 1.18618
## ACF1
## Training set 0.07419709
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 1397 1.119295e+17 -9.526744e+16 3.191265e+17 -2.049509e+17 4.288099e+17
## Feb 1397 1.049632e+17 -1.126840e+17 3.226105e+17 -2.278995e+17 4.378260e+17
## Mar 1397 9.799692e+16 -1.296274e+17 3.256213e+17 -2.501245e+17 4.461183e+17
## Apr 1397 9.103062e+16 -1.461573e+17 3.282186e+17 -2.717170e+17 4.537783e+17
## May 1397 8.406433e+16 -1.623219e+17 3.304505e+17 -2.927509e+17 4.608795e+17
## Jun 1397 7.709803e+16 -1.781606e+17 3.323567e+17 -3.132864e+17 4.674824e+17
## Jul 1397 7.013174e+16 -1.937064e+17 3.339698e+17 -3.333738e+17 4.736373e+17
## Aug 1397 6.316544e+16 -2.089869e+17 3.353177e+17 -3.530556e+17 4.793865e+17
## Sep 1397 5.619915e+16 -2.240257e+17 3.364240e+17 -3.723678e+17 4.847661e+17
## Oct 1397 4.923285e+16 -2.388433e+17 3.373090e+17 -3.913416e+17 4.898073e+17
## Nov 1397 4.226656e+16 -2.534571e+17 3.379902e+17 -4.100038e+17 4.945369e+17
## Dec 1397 3.530026e+16 -2.678827e+17 3.384832e+17 -4.283780e+17 4.989786e+17
## Jan 1398 2.833397e+16 -2.821335e+17 3.388015e+17 -4.464851e+17 5.031531e+17
## Feb 1398 2.136767e+16 -2.962217e+17 3.389571e+17 -4.643434e+17 5.070787e+17
## Mar 1398 1.440138e+16 -3.101579e+17 3.389607e+17 -4.819693e+17 5.107720e+17
## Apr 1398 7.435084e+15 -3.239518e+17 3.388219e+17 -4.993774e+17 5.142475e+17
## May 1398 4.687893e+14 -3.376118e+17 3.385494e+17 -5.165809e+17 5.175185e+17
## Jun 1398 -6.497506e+15 -3.511460e+17 3.381509e+17 -5.335918e+17 5.205968e+17
## Jul 1398 -1.346380e+16 -3.645612e+17 3.376336e+17 -5.504209e+17 5.234933e+17
## Aug 1398 -2.043010e+16 -3.778640e+17 3.370038e+17 -5.670780e+17 5.262178e+17
## Sep 1398 -2.739639e+16 -3.910602e+17 3.362674e+17 -5.835721e+17 5.287793e+17
## Oct 1398 -3.436269e+16 -4.041552e+17 3.354298e+17 -5.999115e+17 5.311861e+17
## Nov 1398 -4.132898e+16 -4.171540e+17 3.344960e+17 -6.161037e+17 5.334457e+17
## Dec 1398 -4.829528e+16 -4.300611e+17 3.334705e+17 -6.321557e+17 5.355651e+17
## Jan 1399 -5.526157e+16 -4.428807e+17 3.323576e+17 -6.480739e+17 5.375508e+17
## Feb 1399 -6.222787e+16 -4.556168e+17 3.311611e+17 -6.638644e+17 5.394086e+17
## Mar 1399 -6.919416e+16 -4.682730e+17 3.298847e+17 -6.795326e+17 5.411443e+17
## Apr 1399 -7.616046e+16 -4.808526e+17 3.285317e+17 -6.950837e+17 5.427628e+17
## May 1399 -8.312675e+16 -4.933589e+17 3.271054e+17 -7.105226e+17 5.442691e+17
## Jun 1399 -9.009305e+16 -5.057946e+17 3.256085e+17 -7.258537e+17 5.456676e+17
## Jul 1399 -9.705934e+16 -5.181626e+17 3.240439e+17 -7.410812e+17 5.469626e+17
## Aug 1399 -1.040256e+17 -5.304655e+17 3.224142e+17 -7.562091e+17 5.481578e+17
## Sep 1399 -1.109919e+17 -5.427056e+17 3.207218e+17 -7.712411e+17 5.492572e+17
## Oct 1399 -1.179582e+17 -5.548853e+17 3.189688e+17 -7.861805e+17 5.502641e+17
## Nov 1399 -1.249245e+17 -5.670066e+17 3.171576e+17 -8.010308e+17 5.511817e+17
## Dec 1399 -1.318908e+17 -5.790717e+17 3.152901e+17 -8.157949e+17 5.520133e+17
## Jan 1400 -1.388571e+17 -5.910823e+17 3.133681e+17 -8.304759e+17 5.527617e+17
## Feb 1400 -1.458234e+17 -6.030404e+17 3.113936e+17 -8.450764e+17 5.534296e+17
## Mar 1400 -1.527897e+17 -6.149475e+17 3.093681e+17 -8.595991e+17 5.540197e+17
## Apr 1400 -1.597560e+17 -6.268054e+17 3.072934e+17 -8.740465e+17 5.545345e+17
## May 1400 -1.667223e+17 -6.386156e+17 3.051710e+17 -8.884208e+17 5.549762e+17
## Jun 1400 -1.736886e+17 -6.503794e+17 3.030022e+17 -9.027243e+17 5.553471e+17
## Jul 1400 -1.806549e+17 -6.620984e+17 3.007886e+17 -9.169592e+17 5.556494e+17
## Aug 1400 -1.876212e+17 -6.737737e+17 2.985314e+17 -9.311274e+17 5.558850e+17
## Sep 1400 -1.945875e+17 -6.854068e+17 2.962318e+17 -9.452308e+17 5.560559e+17
## Oct 1400 -2.015538e+17 -6.969987e+17 2.938912e+17 -9.592714e+17 5.561639e+17
## Nov 1400 -2.085201e+17 -7.085506e+17 2.915105e+17 -9.732508e+17 5.562107e+17
## Dec 1400 -2.154864e+17 -7.200636e+17 2.890909e+17 -9.871707e+17 5.561980e+17
df_h = as.data.frame(hom)
checkresiduals(hom)
##
## Ljung-Box test
##
## data: Residuals from Holt's method
## Q* = 9.1208, df = 3, p-value = 0.02773
##
## Model df: 4. Total lags used: 7
shapiro.test(hom$residuals)
##
## Shapiro-Wilk normality test
##
## data: hom$residuals
## W = 0.95582, p-value = 0.1594
mape(data_test$expenses2 ,BoxCoxInv(x = df_h$`Point Forecast` , lambda = l))
## [1] 125.8402
rmse(data_test$expenses2 ,BoxCoxInv(x = df_h$`Point Forecast` , lambda = l))
## [1] 985735766