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)
library(pander)
##
## Attaching package: 'pander'
## The following object is masked from 'package:ascii':
##
## Pandoc
##Global vriable##
Full_original_data <- read.csv("data.csv") # path of your data ( time series data)
original_data<-Full_original_data$daily.infection
y_lab <- "Forecast second infection cases in Chelyabinsk" # input name of data
Actual_date_interval <- c("2020/03/12","2020/11/30")
Forecast_date_interval <- c("2020/12/01","2021/01/31")
validation_data_days <-30
frequency<-"day"
Number_Neural<-5 # 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.00 62.00 89.00 95.64 132.00 276.00
# calculate standard deviation
data.frame(kurtosis=kurtosis(original_data)) # calculate Cofficient of kurtosis
## kurtosis
## 1 2.86046
data.frame(skewness=skewness(original_data)) # calculate Cofficient of skewness
## skewness
## 1 0.4027947
data.frame(Standard.deviation =sd(original_data))
## Standard.deviation
## 1 62.9977
#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,5)
## Call: nnetar(y = data_series, size = Number_Neural)
##
## Average of 20 networks, each of which is
## a 6-5-1 network with 41 weights
## options were - linear output units
##
## sigma^2 estimated as 72.82
# 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 30 days by using NNAR Model for ==> Forecast second 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 30 days in NNAR Model for ==> Forecast second infection cases in Chelyabinsk"
paste(MAPE_Mean_All,"%")
## [1] "22.752 % MAPE 30 days Forecast second 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 30 days in NNAR Model for ==> Forecast second 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-11-01 | Sunday | 164.00 | 146.92 | 10.417 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 2 | 2020-11-02 | Monday | 170.00 | 145.65 | 14.322 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 3 | 2020-11-03 | Tuesday | 169.00 | 144.61 | 14.435 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 4 | 2020-11-04 | Wednesday | 172.00 | 144.26 | 16.13 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 5 | 2020-11-05 | Thursday | 175.00 | 143.36 | 18.081 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 6 | 2020-11-06 | Friday | 179.00 | 142.96 | 20.132 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 7 | 2020-11-07 | Saturday | 181.00 | 142.80 | 21.107 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 8 | 2020-11-08 | Sunday | 185.00 | 142.85 | 22.785 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 9 | 2020-11-09 | Monday | 186.00 | 143.21 | 23.004 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 10 | 2020-11-10 | Tuesday | 189.00 | 143.51 | 24.069 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 11 | 2020-11-11 | Wednesday | 194.00 | 144.11 | 25.715 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 12 | 2020-11-12 | Thursday | 197.00 | 144.85 | 26.471 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 13 | 2020-11-13 | Friday | 201.00 | 145.82 | 27.454 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 14 | 2020-11-14 | Saturday | 207.00 | 147.02 | 28.976 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 15 | 2020-11-15 | Sunday | 209.00 | 148.36 | 29.013 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 16 | 2020-11-16 | Monday | 211.00 | 150.01 | 28.905 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 17 | 2020-11-17 | Tuesday | 210.00 | 151.90 | 27.667 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 18 | 2020-11-18 | Wednesday | 215.00 | 154.13 | 28.31 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 19 | 2020-11-19 | Thursday | 218.00 | 156.75 | 28.098 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 20 | 2020-11-20 | Friday | 219.00 | 159.76 | 27.051 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 21 | 2020-11-21 | Saturday | 213.00 | 163.30 | 23.335 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 22 | 2020-11-22 | Sunday | 218.00 | 167.35 | 23.233 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 23 | 2020-11-23 | Monday | 219.00 | 172.01 | 21.456 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 24 | 2020-11-24 | Tuesday | 223.00 | 177.23 | 20.526 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 25 | 2020-11-25 | Wednesday | 228.00 | 182.90 | 19.782 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 26 | 2020-11-26 | Thursday | 241.00 | 188.92 | 21.609 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 27 | 2020-11-27 | Friday | 252.00 | 195.18 | 22.549 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 28 | 2020-11-28 | Saturday | 261.00 | 201.70 | 22.721 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 29 | 2020-11-29 | Sunday | 272.00 | 208.51 | 23.343 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
## | 30 | 2020-11-30 | Monday | 276.00 | 215.63 | 21.872 % |
## +----+------------+-------------------------+-------------+------------------+-----------------+
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 | 223.04 |
## +----+------------+-----------------+---------------------+
## | 2 | 2020-12-02 | Wednesday | 230.63 |
## +----+------------+-----------------+---------------------+
## | 3 | 2020-12-03 | Thursday | 238.32 |
## +----+------------+-----------------+---------------------+
## | 4 | 2020-12-04 | Friday | 246.02 |
## +----+------------+-----------------+---------------------+
## | 5 | 2020-12-05 | Saturday | 253.63 |
## +----+------------+-----------------+---------------------+
## | 6 | 2020-12-06 | Sunday | 261.08 |
## +----+------------+-----------------+---------------------+
## | 7 | 2020-12-07 | Monday | 268.24 |
## +----+------------+-----------------+---------------------+
## | 8 | 2020-12-08 | Tuesday | 275.05 |
## +----+------------+-----------------+---------------------+
## | 9 | 2020-12-09 | Wednesday | 281.43 |
## +----+------------+-----------------+---------------------+
## | 10 | 2020-12-10 | Thursday | 287.32 |
## +----+------------+-----------------+---------------------+
## | 11 | 2020-12-11 | Friday | 292.68 |
## +----+------------+-----------------+---------------------+
## | 12 | 2020-12-12 | Saturday | 297.46 |
## +----+------------+-----------------+---------------------+
## | 13 | 2020-12-13 | Sunday | 301.64 |
## +----+------------+-----------------+---------------------+
## | 14 | 2020-12-14 | Monday | 305.20 |
## +----+------------+-----------------+---------------------+
## | 15 | 2020-12-15 | Tuesday | 308.13 |
## +----+------------+-----------------+---------------------+
## | 16 | 2020-12-16 | Wednesday | 310.43 |
## +----+------------+-----------------+---------------------+
## | 17 | 2020-12-17 | Thursday | 312.10 |
## +----+------------+-----------------+---------------------+
## | 18 | 2020-12-18 | Friday | 313.14 |
## +----+------------+-----------------+---------------------+
## | 19 | 2020-12-19 | Saturday | 313.56 |
## +----+------------+-----------------+---------------------+
## | 20 | 2020-12-20 | Sunday | 313.35 |
## +----+------------+-----------------+---------------------+
## | 21 | 2020-12-21 | Monday | 312.52 |
## +----+------------+-----------------+---------------------+
## | 22 | 2020-12-22 | Tuesday | 311.06 |
## +----+------------+-----------------+---------------------+
## | 23 | 2020-12-23 | Wednesday | 308.94 |
## +----+------------+-----------------+---------------------+
## | 24 | 2020-12-24 | Thursday | 306.12 |
## +----+------------+-----------------+---------------------+
## | 25 | 2020-12-25 | Friday | 302.52 |
## +----+------------+-----------------+---------------------+
## | 26 | 2020-12-26 | Saturday | 298.02 |
## +----+------------+-----------------+---------------------+
## | 27 | 2020-12-27 | Sunday | 292.39 |
## +----+------------+-----------------+---------------------+
## | 28 | 2020-12-28 | Monday | 285.33 |
## +----+------------+-----------------+---------------------+
## | 29 | 2020-12-29 | Tuesday | 276.28 |
## +----+------------+-----------------+---------------------+
## | 30 | 2020-12-30 | Wednesday | 264.42 |
## +----+------------+-----------------+---------------------+
## | 31 | 2020-12-31 | Thursday | 248.62 |
## +----+------------+-----------------+---------------------+
## | 32 | 2021-01-01 | Friday | 227.94 |
## +----+------------+-----------------+---------------------+
## | 33 | 2021-01-02 | Saturday | 203.71 |
## +----+------------+-----------------+---------------------+
## | 34 | 2021-01-03 | Sunday | 181.89 |
## +----+------------+-----------------+---------------------+
## | 35 | 2021-01-04 | Monday | 168.36 |
## +----+------------+-----------------+---------------------+
## | 36 | 2021-01-05 | Tuesday | 161.32 |
## +----+------------+-----------------+---------------------+
## | 37 | 2021-01-06 | Wednesday | 154.13 |
## +----+------------+-----------------+---------------------+
## | 38 | 2021-01-07 | Thursday | 146.99 |
## +----+------------+-----------------+---------------------+
## | 39 | 2021-01-08 | Friday | 141.58 |
## +----+------------+-----------------+---------------------+
## | 40 | 2021-01-09 | Saturday | 138.01 |
## +----+------------+-----------------+---------------------+
## | 41 | 2021-01-10 | Sunday | 135.32 |
## +----+------------+-----------------+---------------------+
## | 42 | 2021-01-11 | Monday | 132.43 |
## +----+------------+-----------------+---------------------+
## | 43 | 2021-01-12 | Tuesday | 129.78 |
## +----+------------+-----------------+---------------------+
## | 44 | 2021-01-13 | Wednesday | 127.82 |
## +----+------------+-----------------+---------------------+
## | 45 | 2021-01-14 | Thursday | 126.45 |
## +----+------------+-----------------+---------------------+
## | 46 | 2021-01-15 | Friday | 125.36 |
## +----+------------+-----------------+---------------------+
## | 47 | 2021-01-16 | Saturday | 124.34 |
## +----+------------+-----------------+---------------------+
## | 48 | 2021-01-17 | Sunday | 123.44 |
## +----+------------+-----------------+---------------------+
## | 49 | 2021-01-18 | Monday | 122.71 |
## +----+------------+-----------------+---------------------+
## | 50 | 2021-01-19 | Tuesday | 122.12 |
## +----+------------+-----------------+---------------------+
## | 51 | 2021-01-20 | Wednesday | 121.60 |
## +----+------------+-----------------+---------------------+
## | 52 | 2021-01-21 | Thursday | 121.11 |
## +----+------------+-----------------+---------------------+
## | 53 | 2021-01-22 | Friday | 120.64 |
## +----+------------+-----------------+---------------------+
## | 54 | 2021-01-23 | Saturday | 120.20 |
## +----+------------+-----------------+---------------------+
## | 55 | 2021-01-24 | Sunday | 119.78 |
## +----+------------+-----------------+---------------------+
## | 56 | 2021-01-25 | Monday | 119.36 |
## +----+------------+-----------------+---------------------+
## | 57 | 2021-01-26 | Tuesday | 118.95 |
## +----+------------+-----------------+---------------------+
## | 58 | 2021-01-27 | Wednesday | 118.53 |
## +----+------------+-----------------+---------------------+
## | 59 | 2021-01-28 | Thursday | 118.10 |
## +----+------------+-----------------+---------------------+
## | 60 | 2021-01-29 | Friday | 117.67 |
## +----+------------+-----------------+---------------------+
## | 61 | 2021-01-30 | Saturday | 117.23 |
## +----+------------+-----------------+---------------------+
## | 62 | 2021-01-31 | Sunday | 116.78 |
## +----+------------+-----------------+---------------------+
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 second 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 second infection cases in Chelyabinsk