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$Infection
y_lab <- "Forecast Third wave infection cases in Chelyabinsk" # input name of data
Actual_date_interval <- c("2020/03/12","2021/05/31")
Forecast_date_interval <- c("2021/06/01","2021/07/30")
validation_data_days <-60
frequency<-"day"
Number_Neural<-10 # Number of Neural For model NNAR Model
NNAR_Model<- FALSE #create new model (TRUE/FALSE)
frequency<-"days"
# Data Preparation & calculate some of statistics measures
summary(original_data) # Summary your time series
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 77.0 119.0 138.6 193.5 317.0
# calculate standard deviation
data.frame(kurtosis=kurtosis(original_data)) # calculate Cofficient of kurtosis
## kurtosis
## 1 2.335134
data.frame(skewness=skewness(original_data)) # calculate Cofficient of skewness
## skewness
## 1 0.5357968
data.frame(Standard.deviation =sd(original_data))
## Standard.deviation
## 1 89.88126
#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
#NNAR Model
if(NNAR_Model==TRUE){
data_series<-ts(training_data)
model_NNAR<-nnetar(data_series, size = Number_Neural)
saveRDS(model_NNAR, file = "model_NNAR.RDS")
my_model <- readRDS("model_NNAR.RDS")
accuracy(model_NNAR) # accuracy on training data #Print Model Parameters
model_NNAR
}
if(NNAR_Model==FALSE){
data_series<-ts(training_data)
#model_NNAR<-nnetar(data_series, size = Number_Numeral)
model_NNAR <- readRDS("model_NNAR.RDS")
accuracy(model_NNAR) # accuracy on training data #Print Model Parameters
model_NNAR
}
## Series: data_series
## Model: NNAR(6,10)
## Call: nnetar(y = data_series, size = Number_Neural)
##
## Average of 20 networks, each of which is
## a 6-10-1 network with 81 weights
## options were - linear output units
##
## sigma^2 estimated as 46.21
# Testing Data Evaluation
forecasting_NNAR <- forecast(model_NNAR, h=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 60 days by using NNAR Model for ==> Forecast Third wave infection cases in Chelyabinsk"
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 60 days in NNAR Model for ==> Forecast Third wave infection cases in Chelyabinsk"
paste(MAPE_Mean_All,"%")
## [1] "1.636 % MAPE 60 days Forecast Third wave infection cases in Chelyabinsk %"
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 60 days in NNAR Model for ==> Forecast Third wave infection cases in Chelyabinsk"
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 | 2021-04-02 | Friday | 129.00 | 129.21 | 0.162 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 2 | 2021-04-03 | Saturday | 128.00 | 128.42 | 0.325 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 3 | 2021-04-04 | Sunday | 125.00 | 127.70 | 2.164 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 4 | 2021-04-05 | Monday | 123.00 | 126.72 | 3.022 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 5 | 2021-04-06 | Tuesday | 122.00 | 125.92 | 3.209 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 6 | 2021-04-07 | Wednesday | 121.00 | 125.20 | 3.472 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 7 | 2021-04-08 | Thursday | 120.00 | 124.48 | 3.736 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 8 | 2021-04-09 | Friday | 119.00 | 123.79 | 4.027 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 9 | 2021-04-10 | Saturday | 120.00 | 123.03 | 2.527 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 10 | 2021-04-11 | Sunday | 119.00 | 122.28 | 2.76 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 11 | 2021-04-12 | Monday | 118.00 | 121.55 | 3.009 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 12 | 2021-04-13 | Tuesday | 117.00 | 120.81 | 3.253 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 13 | 2021-04-14 | Wednesday | 116.00 | 120.06 | 3.499 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 14 | 2021-04-15 | Thursday | 115.00 | 119.29 | 3.727 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 15 | 2021-04-16 | Friday | 116.00 | 118.50 | 2.155 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 16 | 2021-04-17 | Saturday | 115.00 | 117.70 | 2.351 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 17 | 2021-04-18 | Sunday | 114.00 | 116.90 | 2.54 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 18 | 2021-04-19 | Monday | 115.00 | 116.07 | 0.934 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 19 | 2021-04-20 | Tuesday | 114.00 | 115.24 | 1.085 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 20 | 2021-04-21 | Wednesday | 113.00 | 114.39 | 1.227 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 21 | 2021-04-22 | Thursday | 112.00 | 113.53 | 1.362 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 22 | 2021-04-23 | Friday | 111.00 | 112.65 | 1.489 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 23 | 2021-04-24 | Saturday | 112.00 | 111.77 | 0.205 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 24 | 2021-04-25 | Sunday | 110.00 | 110.88 | 0.799 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 25 | 2021-04-26 | Monday | 109.00 | 109.98 | 0.9 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 26 | 2021-04-27 | Tuesday | 108.00 | 109.08 | 0.998 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 27 | 2021-04-28 | Wednesday | 107.00 | 108.17 | 1.094 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 28 | 2021-04-29 | Thursday | 105.00 | 107.26 | 2.156 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 29 | 2021-04-30 | Friday | 104.00 | 106.36 | 2.266 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 30 | 2021-05-01 | Saturday | 106.00 | 105.45 | 0.516 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 31 | 2021-05-02 | Sunday | 105.00 | 104.55 | 0.425 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 32 | 2021-05-03 | Monday | 106.00 | 103.66 | 2.206 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 33 | 2021-05-04 | Tuesday | 105.00 | 102.78 | 2.115 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 34 | 2021-05-05 | Wednesday | 104.00 | 101.91 | 2.013 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 35 | 2021-05-06 | Thursday | 102.00 | 101.05 | 0.935 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 36 | 2021-05-07 | Friday | 103.00 | 100.20 | 2.718 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 37 | 2021-05-08 | Saturday | 101.00 | 99.37 | 1.614 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 38 | 2021-05-09 | Sunday | 99.00 | 98.56 | 0.449 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 39 | 2021-05-10 | Monday | 98.00 | 97.76 | 0.247 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 40 | 2021-05-11 | Tuesday | 98.00 | 96.98 | 1.043 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 41 | 2021-05-12 | Wednesday | 100.00 | 96.22 | 3.783 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 42 | 2021-05-13 | Thursday | 96.00 | 95.47 | 0.548 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 43 | 2021-05-14 | Friday | 97.00 | 94.75 | 2.319 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 44 | 2021-05-15 | Saturday | 96.00 | 94.05 | 2.036 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 45 | 2021-05-16 | Sunday | 94.00 | 93.36 | 0.681 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 46 | 2021-05-17 | Monday | 92.00 | 92.69 | 0.752 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 47 | 2021-05-18 | Tuesday | 93.00 | 92.04 | 1.029 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 48 | 2021-05-19 | Wednesday | 92.00 | 91.41 | 0.64 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 49 | 2021-05-20 | Thursday | 91.00 | 90.80 | 0.222 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 50 | 2021-05-21 | Friday | 90.00 | 90.20 | 0.223 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 51 | 2021-05-22 | Saturday | 89.00 | 89.62 | 0.697 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 52 | 2021-05-23 | Sunday | 89.00 | 89.06 | 0.063 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 53 | 2021-05-24 | Monday | 88.00 | 88.51 | 0.576 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 54 | 2021-05-25 | Tuesday | 89.00 | 87.97 | 1.154 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 55 | 2021-05-26 | Wednesday | 88.00 | 87.45 | 0.622 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 56 | 2021-05-27 | Thursday | 87.00 | 86.95 | 0.061 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 57 | 2021-05-28 | Friday | 88.00 | 86.45 | 1.758 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 58 | 2021-05-29 | Saturday | 88.00 | 85.97 | 2.304 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 59 | 2021-05-30 | Sunday | 87.00 | 85.50 | 1.72 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 60 | 2021-05-31 | Monday | 87.00 | 85.05 | 2.245 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
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 | 2021-06-01 | Tuesday | 84.60 |
## +----+------------+-----------------+---------------------+
## | 2 | 2021-06-02 | Wednesday | 84.17 |
## +----+------------+-----------------+---------------------+
## | 3 | 2021-06-03 | Thursday | 83.74 |
## +----+------------+-----------------+---------------------+
## | 4 | 2021-06-04 | Friday | 83.32 |
## +----+------------+-----------------+---------------------+
## | 5 | 2021-06-05 | Saturday | 82.92 |
## +----+------------+-----------------+---------------------+
## | 6 | 2021-06-06 | Sunday | 82.52 |
## +----+------------+-----------------+---------------------+
## | 7 | 2021-06-07 | Monday | 82.13 |
## +----+------------+-----------------+---------------------+
## | 8 | 2021-06-08 | Tuesday | 81.75 |
## +----+------------+-----------------+---------------------+
## | 9 | 2021-06-09 | Wednesday | 81.38 |
## +----+------------+-----------------+---------------------+
## | 10 | 2021-06-10 | Thursday | 81.01 |
## +----+------------+-----------------+---------------------+
## | 11 | 2021-06-11 | Friday | 80.66 |
## +----+------------+-----------------+---------------------+
## | 12 | 2021-06-12 | Saturday | 80.30 |
## +----+------------+-----------------+---------------------+
## | 13 | 2021-06-13 | Sunday | 79.96 |
## +----+------------+-----------------+---------------------+
## | 14 | 2021-06-14 | Monday | 79.62 |
## +----+------------+-----------------+---------------------+
## | 15 | 2021-06-15 | Tuesday | 79.29 |
## +----+------------+-----------------+---------------------+
## | 16 | 2021-06-16 | Wednesday | 78.96 |
## +----+------------+-----------------+---------------------+
## | 17 | 2021-06-17 | Thursday | 78.64 |
## +----+------------+-----------------+---------------------+
## | 18 | 2021-06-18 | Friday | 78.33 |
## +----+------------+-----------------+---------------------+
## | 19 | 2021-06-19 | Saturday | 78.02 |
## +----+------------+-----------------+---------------------+
## | 20 | 2021-06-20 | Sunday | 77.71 |
## +----+------------+-----------------+---------------------+
## | 21 | 2021-06-21 | Monday | 77.42 |
## +----+------------+-----------------+---------------------+
## | 22 | 2021-06-22 | Tuesday | 77.12 |
## +----+------------+-----------------+---------------------+
## | 23 | 2021-06-23 | Wednesday | 76.83 |
## +----+------------+-----------------+---------------------+
## | 24 | 2021-06-24 | Thursday | 76.54 |
## +----+------------+-----------------+---------------------+
## | 25 | 2021-06-25 | Friday | 76.26 |
## +----+------------+-----------------+---------------------+
## | 26 | 2021-06-26 | Saturday | 75.98 |
## +----+------------+-----------------+---------------------+
## | 27 | 2021-06-27 | Sunday | 75.71 |
## +----+------------+-----------------+---------------------+
## | 28 | 2021-06-28 | Monday | 75.44 |
## +----+------------+-----------------+---------------------+
## | 29 | 2021-06-29 | Tuesday | 75.17 |
## +----+------------+-----------------+---------------------+
## | 30 | 2021-06-30 | Wednesday | 74.91 |
## +----+------------+-----------------+---------------------+
## | 31 | 2021-07-01 | Thursday | 74.65 |
## +----+------------+-----------------+---------------------+
## | 32 | 2021-07-02 | Friday | 74.40 |
## +----+------------+-----------------+---------------------+
## | 33 | 2021-07-03 | Saturday | 74.14 |
## +----+------------+-----------------+---------------------+
## | 34 | 2021-07-04 | Sunday | 73.89 |
## +----+------------+-----------------+---------------------+
## | 35 | 2021-07-05 | Monday | 73.65 |
## +----+------------+-----------------+---------------------+
## | 36 | 2021-07-06 | Tuesday | 73.40 |
## +----+------------+-----------------+---------------------+
## | 37 | 2021-07-07 | Wednesday | 73.16 |
## +----+------------+-----------------+---------------------+
## | 38 | 2021-07-08 | Thursday | 72.93 |
## +----+------------+-----------------+---------------------+
## | 39 | 2021-07-09 | Friday | 72.69 |
## +----+------------+-----------------+---------------------+
## | 40 | 2021-07-10 | Saturday | 72.46 |
## +----+------------+-----------------+---------------------+
## | 41 | 2021-07-11 | Sunday | 72.23 |
## +----+------------+-----------------+---------------------+
## | 42 | 2021-07-12 | Monday | 72.00 |
## +----+------------+-----------------+---------------------+
## | 43 | 2021-07-13 | Tuesday | 71.78 |
## +----+------------+-----------------+---------------------+
## | 44 | 2021-07-14 | Wednesday | 71.56 |
## +----+------------+-----------------+---------------------+
## | 45 | 2021-07-15 | Thursday | 71.34 |
## +----+------------+-----------------+---------------------+
## | 46 | 2021-07-16 | Friday | 71.12 |
## +----+------------+-----------------+---------------------+
## | 47 | 2021-07-17 | Saturday | 70.90 |
## +----+------------+-----------------+---------------------+
## | 48 | 2021-07-18 | Sunday | 70.69 |
## +----+------------+-----------------+---------------------+
## | 49 | 2021-07-19 | Monday | 70.48 |
## +----+------------+-----------------+---------------------+
## | 50 | 2021-07-20 | Tuesday | 70.27 |
## +----+------------+-----------------+---------------------+
## | 51 | 2021-07-21 | Wednesday | 70.06 |
## +----+------------+-----------------+---------------------+
## | 52 | 2021-07-22 | Thursday | 69.86 |
## +----+------------+-----------------+---------------------+
## | 53 | 2021-07-23 | Friday | 69.65 |
## +----+------------+-----------------+---------------------+
## | 54 | 2021-07-24 | Saturday | 69.45 |
## +----+------------+-----------------+---------------------+
## | 55 | 2021-07-25 | Sunday | 69.25 |
## +----+------------+-----------------+---------------------+
## | 56 | 2021-07-26 | Monday | 69.05 |
## +----+------------+-----------------+---------------------+
## | 57 | 2021-07-27 | Tuesday | 68.86 |
## +----+------------+-----------------+---------------------+
## | 58 | 2021-07-28 | Wednesday | 68.66 |
## +----+------------+-----------------+---------------------+
## | 59 | 2021-07-29 | Thursday | 68.47 |
## +----+------------+-----------------+---------------------+
## | 60 | 2021-07-30 | Friday | 68.28 |
## +----+------------+-----------------+---------------------+
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
message("System finished Modelling and Forecasting by using BATS, TBATS, Holt's Linear Trend,ARIMA Model, and SIR Model ==>",y_lab, sep=" ")
## System finished Modelling and Forecasting by using BATS, TBATS, Holt's Linear Trend,ARIMA Model, and SIR Model ==>Forecast Third wave infection cases in Chelyabinsk
message(" Thank you for using our System For Modelling and Forecasting ==> ",y_lab, sep=" ")
## Thank you for using our System For Modelling and Forecasting ==> Forecast Third wave infection cases in Chelyabinsk