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.5 v fma 2.4
## v forecast 8.13 v expsmooth 2.3
## Warning: package 'ggplot2' was built under R version 4.0.5
##
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
## Warning: package 'data.table' was built under R version 4.0.5
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 First wave infection cases in chelyabinsk" # input name of data
Actual_date_interval <- c("2020/03/12","2020/05/31")
Forecast_date_interval <- c("2020/06/01","2020/06/30")
validation_data_days <-7
frequency<-"days"
Number_Neural<-30 # Number of Neural For model NNAR Model
NNAR_Model<- TRUE #create new model (TRUE/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.00 1.00 10.00 34.51 67.00 150.00
# calculate standard deviation
data.frame(kurtosis=kurtosis(original_data)) # calculate Cofficient of kurtosis
## kurtosis
## 1 2.938683
data.frame(skewness=skewness(original_data)) # calculate Cofficient of skewness
## skewness
## 1 0.9287743
data.frame(Standard.deviation =sd(original_data))
## Standard.deviation
## 1 39.75743
#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
}
## Series: data_series
## Model: NNAR(2,30)
## Call: nnetar(y = data_series, size = Number_Neural)
##
## Average of 20 networks, each of which is
## a 2-30-1 network with 121 weights
## options were - linear output units
##
## sigma^2 estimated as 42.4
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
}
# 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 7 days by using NNAR Model for ==> Forecast First 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 7 days in NNAR Model for ==> Forecast First wave infection cases in chelyabinsk"
paste(MAPE_Mean_All,"%")
## [1] "51.69 % MAPE 7 days Forecast First 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 7 days in NNAR Model for ==> Forecast First 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 | 2020-05-25 | Monday | 45.00 | 81.22 | 80.499 % |
## +---+------------+-------------------------+-------------+------------------+-----------------+
## | 2 | 2020-05-26 | Tuesday | 36.00 | 68.58 | 90.507 % |
## +---+------------+-------------------------+-------------+------------------+-----------------+
## | 3 | 2020-05-27 | Wednesday | 70.00 | 72.71 | 3.877 % |
## +---+------------+-------------------------+-------------+------------------+-----------------+
## | 4 | 2020-05-28 | Thursday | 82.00 | 60.98 | 25.629 % |
## +---+------------+-------------------------+-------------+------------------+-----------------+
## | 5 | 2020-05-29 | Friday | 141.00 | 69.74 | 50.54 % |
## +---+------------+-------------------------+-------------+------------------+-----------------+
## | 6 | 2020-05-30 | Saturday | 150.00 | 59.38 | 60.414 % |
## +---+------------+-------------------------+-------------+------------------+-----------------+
## | 7 | 2020-05-31 | Sunday | 136.00 | 67.50 | 50.366 % |
## +---+------------+-------------------------+-------------+------------------+-----------------+
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-06-01 | Monday | 54.97 |
## +----+------------+-----------------+---------------------+
## | 2 | 2020-06-02 | Tuesday | 77.74 |
## +----+------------+-----------------+---------------------+
## | 3 | 2020-06-03 | Wednesday | 57.63 |
## +----+------------+-----------------+---------------------+
## | 4 | 2020-06-04 | Thursday | 85.62 |
## +----+------------+-----------------+---------------------+
## | 5 | 2020-06-05 | Friday | 63.60 |
## +----+------------+-----------------+---------------------+
## | 6 | 2020-06-06 | Saturday | 86.75 |
## +----+------------+-----------------+---------------------+
## | 7 | 2020-06-07 | Sunday | 71.38 |
## +----+------------+-----------------+---------------------+
## | 8 | 2020-06-08 | Monday | 81.16 |
## +----+------------+-----------------+---------------------+
## | 9 | 2020-06-09 | Tuesday | 64.45 |
## +----+------------+-----------------+---------------------+
## | 10 | 2020-06-10 | Wednesday | 79.00 |
## +----+------------+-----------------+---------------------+
## | 11 | 2020-06-11 | Thursday | 67.47 |
## +----+------------+-----------------+---------------------+
## | 12 | 2020-06-12 | Friday | 69.70 |
## +----+------------+-----------------+---------------------+
## | 13 | 2020-06-13 | Saturday | 57.01 |
## +----+------------+-----------------+---------------------+
## | 14 | 2020-06-14 | Sunday | 75.26 |
## +----+------------+-----------------+---------------------+
## | 15 | 2020-06-15 | Monday | 61.30 |
## +----+------------+-----------------+---------------------+
## | 16 | 2020-06-16 | Tuesday | 74.20 |
## +----+------------+-----------------+---------------------+
## | 17 | 2020-06-17 | Wednesday | 64.72 |
## +----+------------+-----------------+---------------------+
## | 18 | 2020-06-18 | Thursday | 64.71 |
## +----+------------+-----------------+---------------------+
## | 19 | 2020-06-19 | Friday | 48.99 |
## +----+------------+-----------------+---------------------+
## | 20 | 2020-06-20 | Saturday | 61.13 |
## +----+------------+-----------------+---------------------+
## | 21 | 2020-06-21 | Sunday | 37.68 |
## +----+------------+-----------------+---------------------+
## | 22 | 2020-06-22 | Monday | 117.63 |
## +----+------------+-----------------+---------------------+
## | 23 | 2020-06-23 | Tuesday | 128.81 |
## +----+------------+-----------------+---------------------+
## | 24 | 2020-06-24 | Wednesday | 116.80 |
## +----+------------+-----------------+---------------------+
## | 25 | 2020-06-25 | Thursday | 113.12 |
## +----+------------+-----------------+---------------------+
## | 26 | 2020-06-26 | Friday | 107.48 |
## +----+------------+-----------------+---------------------+
## | 27 | 2020-06-27 | Saturday | 101.34 |
## +----+------------+-----------------+---------------------+
## | 28 | 2020-06-28 | Sunday | 95.83 |
## +----+------------+-----------------+---------------------+
## | 29 | 2020-06-29 | Monday | 90.51 |
## +----+------------+-----------------+---------------------+
## | 30 | 2020-06-30 | Tuesday | 86.24 |
## +----+------------+-----------------+---------------------+
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"))
