South ural state university, Chelyabinsk, Russian federation
#Import
library(fpp2)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## -- Attaching packages ---------------------------------------------- fpp2 2.4 --
## v ggplot2 3.3.2 v fma 2.4
## v forecast 8.13 v expsmooth 2.3
##
library(forecast)
library(ggplot2)
library("readxl")
library(moments)
library(forecast)
require(forecast)
require(tseries)
## Loading required package: tseries
require(markovchain)
## Loading required package: markovchain
## Package: markovchain
## Version: 0.8.5-3
## Date: 2020-12-03
## BugReport: https://github.com/spedygiorgio/markovchain/issues
require(data.table)
## Loading required package: data.table
library(Hmisc)
## Loading required package: lattice
## Loading required package: survival
## Loading required package: Formula
##
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:base':
##
## format.pval, units
library(ascii)
##Global vriable##
Full_original_data <- read.csv("data.csv") # path of your data ( time series data)
original_data<-Full_original_data$cases
y_lab <- "Forecast Second wave infection cases in Russia" # input name of data
Actual_date_interval <- c("2020/03/01","2020/11/30")
Forecast_date_interval <- c("2020/12/01","2020/12/31")
validation_data_days <-25
frequency<-"days"
Number_Neural<-3 # Number of Neural For model NNAR Model
NNAR_Model<- TRUE #create new model (TRUE/FALSE)
frequency<-"days"
number_bootstrapped<-3
# Data Preparation & calculate some of statistics measures
summary(original_data) # Summary your time series
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0 163 5841 6894 8952 27543
# calculate standard deviation
data.frame(kurtosis=kurtosis(original_data)) # calculate Cofficient of kurtosis
## kurtosis
## 1 3.859814
data.frame(skewness=skewness(original_data)) # calculate Cofficient of skewness
## skewness
## 1 1.144149
data.frame(Standard.deviation =sd(original_data))
## Standard.deviation
## 1 6655.426
#processing on data (input data)
rows <- NROW(original_data) # calculate number of rows in time series (number of days)
training_data<-original_data[1:(rows-validation_data_days)] # Training data
testing_data<-original_data[(rows-validation_data_days+1):rows] #testing data
AD<-fulldate<-seq(as.Date(Actual_date_interval[1]),as.Date(Actual_date_interval[2]), frequency) #input range for actual date
FD<-seq(as.Date(Forecast_date_interval[1]),as.Date(Forecast_date_interval[2]), frequency) #input range forecasting date
N_forecasting_days<-nrow(data.frame(FD)) #calculate number of days that you want to forecasting
validation_dates<-tail(AD,validation_data_days) # select validation_dates
validation_data_by_name<-weekdays(validation_dates) # put names of validation dates
forecasting_data_by_name<-weekdays(FD) # put names of Forecasting dates
## Bootstrapping and bagging NNAR model
model_NNAR <- baggedModel(original_data,bootstrapped_series= bld.mbb.bootstrap(original_data,number_bootstrapped), fn = nnetar,size = Number_Neural)
forecasting_NNAR <- forecast(model_NNAR,N_forecasting_days+validation_data_days)
validation_forecast<-head(forecasting_NNAR$mean,validation_data_days)
MAPE_Per_Day<-round( abs(((testing_data-validation_forecast)/testing_data)*100) ,3)
paste ("MAPE % For ",validation_data_days,frequency,"by using NNAR Model for ==> ",y_lab, sep=" ")
## [1] "MAPE % For 25 days by using NNAR Model for ==> Forecast Second wave infection cases in Russia"
MAPE_Mean_All<-paste(round(mean(MAPE_Per_Day),3),"% MAPE ",validation_data_days,frequency,y_lab,sep=" ")
MAPE_Mean_All_NNAR<-round(mean(MAPE_Per_Day),3)
MAPE_NNAR<-paste(round(MAPE_Per_Day,3),"%")
MAPE_NNAR_Model<-paste(MAPE_Per_Day ,"%")
paste (" MAPE that's Error of Forecasting for ",validation_data_days," days in NNAR Model for ==> ",y_lab, sep=" ")
## [1] " MAPE that's Error of Forecasting for 25 days in NNAR Model for ==> Forecast Second wave infection cases in Russia"
paste(MAPE_Mean_All,"%")
## [1] "17.232 % MAPE 25 days Forecast Second wave infection cases in Russia %"
paste ("MAPE that's Error of Forecasting day by day for ",validation_data_days," days in NNAR Model for ==> ",y_lab, sep=" ")
## [1] "MAPE that's Error of Forecasting day by day for 25 days in NNAR Model for ==> Forecast Second wave infection cases in Russia"
print(ascii(data.frame(date_NNAR=validation_dates,validation_data_by_name,actual_data=testing_data,forecasting_NNAR=validation_forecast,MAPE_NNAR_Model)), type = "rest")
##
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | | date_NNAR | validation_data_by_name | actual_data | forecasting_NNAR | MAPE_NNAR_Model |
## +====+============+=========================+=============+==================+=================+
## | 1 | 2020-11-06 | Friday | 20582.00 | 26696.55 | 29.708 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 2 | 2020-11-07 | Saturday | 20396.00 | 26758.54 | 31.195 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 3 | 2020-11-08 | Sunday | 20498.00 | 26815.19 | 30.819 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 4 | 2020-11-09 | Monday | 21798.00 | 26866.55 | 23.252 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 5 | 2020-11-10 | Tuesday | 20977.00 | 26912.80 | 28.297 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 6 | 2020-11-11 | Wednesday | 19851.00 | 26954.23 | 35.783 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 7 | 2020-11-12 | Thursday | 21608.00 | 26991.14 | 24.913 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 8 | 2020-11-13 | Friday | 21983.00 | 27023.89 | 22.931 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 9 | 2020-11-14 | Saturday | 22702.00 | 27052.85 | 19.165 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 10 | 2020-11-15 | Sunday | 22572.00 | 27078.36 | 19.964 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 11 | 2020-11-16 | Monday | 22778.00 | 27100.79 | 18.978 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 12 | 2020-11-17 | Tuesday | 22410.00 | 27120.45 | 21.019 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 13 | 2020-11-18 | Wednesday | 20985.00 | 27137.65 | 29.319 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 14 | 2020-11-19 | Thursday | 23610.00 | 27152.67 | 15.005 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 15 | 2020-11-20 | Friday | 24318.00 | 27165.77 | 11.711 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 16 | 2020-11-21 | Saturday | 24822.00 | 27177.18 | 9.488 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 17 | 2020-11-22 | Sunday | 24581.00 | 27187.10 | 10.602 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 18 | 2020-11-23 | Monday | 25173.00 | 27195.72 | 8.035 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 19 | 2020-11-24 | Tuesday | 24326.00 | 27203.21 | 11.828 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 20 | 2020-11-25 | Wednesday | 23675.00 | 27209.70 | 14.93 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 21 | 2020-11-26 | Thursday | 25487.00 | 27215.33 | 6.781 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 22 | 2020-11-27 | Friday | 27543.00 | 27220.21 | 1.172 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 23 | 2020-11-28 | Saturday | 27100.00 | 27224.44 | 0.459 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 24 | 2020-11-29 | Sunday | 26683.00 | 27228.10 | 2.043 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 25 | 2020-11-30 | Monday | 26338.00 | 27231.27 | 3.392 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
print(ascii(data.frame(FD,forecating_date=forecasting_data_by_name,forecasting_by_NNAR=tail(forecasting_NNAR$mean,N_forecasting_days))), type = "rest")
##
## +----+------------+-----------------+---------------------+
## | | FD | forecating_date | forecasting_by_NNAR |
## +====+============+=================+=====================+
## | 1 | 2020-12-01 | Tuesday | 27234.02 |
## +----+------------+-----------------+---------------------+
## | 2 | 2020-12-02 | Wednesday | 27236.39 |
## +----+------------+-----------------+---------------------+
## | 3 | 2020-12-03 | Thursday | 27238.44 |
## +----+------------+-----------------+---------------------+
## | 4 | 2020-12-04 | Friday | 27240.22 |
## +----+------------+-----------------+---------------------+
## | 5 | 2020-12-05 | Saturday | 27241.76 |
## +----+------------+-----------------+---------------------+
## | 6 | 2020-12-06 | Sunday | 27243.09 |
## +----+------------+-----------------+---------------------+
## | 7 | 2020-12-07 | Monday | 27244.24 |
## +----+------------+-----------------+---------------------+
## | 8 | 2020-12-08 | Tuesday | 27245.23 |
## +----+------------+-----------------+---------------------+
## | 9 | 2020-12-09 | Wednesday | 27246.09 |
## +----+------------+-----------------+---------------------+
## | 10 | 2020-12-10 | Thursday | 27246.84 |
## +----+------------+-----------------+---------------------+
## | 11 | 2020-12-11 | Friday | 27247.48 |
## +----+------------+-----------------+---------------------+
## | 12 | 2020-12-12 | Saturday | 27248.04 |
## +----+------------+-----------------+---------------------+
## | 13 | 2020-12-13 | Sunday | 27248.52 |
## +----+------------+-----------------+---------------------+
## | 14 | 2020-12-14 | Monday | 27248.93 |
## +----+------------+-----------------+---------------------+
## | 15 | 2020-12-15 | Tuesday | 27249.29 |
## +----+------------+-----------------+---------------------+
## | 16 | 2020-12-16 | Wednesday | 27249.61 |
## +----+------------+-----------------+---------------------+
## | 17 | 2020-12-17 | Thursday | 27249.88 |
## +----+------------+-----------------+---------------------+
## | 18 | 2020-12-18 | Friday | 27250.11 |
## +----+------------+-----------------+---------------------+
## | 19 | 2020-12-19 | Saturday | 27250.31 |
## +----+------------+-----------------+---------------------+
## | 20 | 2020-12-20 | Sunday | 27250.49 |
## +----+------------+-----------------+---------------------+
## | 21 | 2020-12-21 | Monday | 27250.64 |
## +----+------------+-----------------+---------------------+
## | 22 | 2020-12-22 | Tuesday | 27250.77 |
## +----+------------+-----------------+---------------------+
## | 23 | 2020-12-23 | Wednesday | 27250.88 |
## +----+------------+-----------------+---------------------+
## | 24 | 2020-12-24 | Thursday | 27250.98 |
## +----+------------+-----------------+---------------------+
## | 25 | 2020-12-25 | Friday | 27251.06 |
## +----+------------+-----------------+---------------------+
## | 26 | 2020-12-26 | Saturday | 27251.14 |
## +----+------------+-----------------+---------------------+
## | 27 | 2020-12-27 | Sunday | 27251.20 |
## +----+------------+-----------------+---------------------+
## | 28 | 2020-12-28 | Monday | 27251.26 |
## +----+------------+-----------------+---------------------+
## | 29 | 2020-12-29 | Tuesday | 27251.30 |
## +----+------------+-----------------+---------------------+
## | 30 | 2020-12-30 | Wednesday | 27251.34 |
## +----+------------+-----------------+---------------------+
## | 31 | 2020-12-31 | Thursday | 27251.38 |
## +----+------------+-----------------+---------------------+
plot(forecasting_NNAR,xlab = paste ("Time in", frequency ,y_lab , sep=" "), ylab=y_lab)
x1_test <- ts(testing_data, start =(rows-validation_data_days+1) )
lines(x1_test, col='red',lwd=2)
graph1<-autoplot(forecasting_NNAR,xlab = paste ("Time in", frequency ,y_lab , sep=" "), ylab=y_lab)
graph1+scale_y_continuous(labels = scales::comma)+
forecast::autolayer(forecasting_NNAR$mean, series="NNAR Model",size = 0.7) +
guides(colour=guide_legend(title="Forecasts"),fill = "black")+
theme(legend.position="bottom")+
theme(legend.background = element_rect(fill="white",
size=0.7, linetype="solid",
colour ="gray"))
