Hi all,
I am trying to run this code to prepare forecast. This is a legacy code. I am new to R. I have made some changes but unable to comprehend most of it and not able to run it. Can some one help me to understand and run it?
Summary: This code is supposed to read the sales history of multiple products from an excel file. create time series, then forecast using multiple methods, also create the MAPE to calculate the error of the forecast and then write the forecasted value in to an excel..
Here is the reprex of the code.
#set directory
setwd("d:\\DemandPlanning")
install.package("reprex")
#loading packages
library(readxl)
library(fpp2)
library(forecast)
library(devtools)
library(ggplot2)
library(fma)
library(expsmooth)
library(tseries)
library(timeSeries)
library(ggseasonplot)
library(data.table)
library(Rcpp)
library(xlsx)
library(openxlsx)
library(naniar)
library(reprex)
# for loop
j <- 1
for (j in 1:length(sku))
{
library(readxl)
Consolidated_ABU_SKU <- read_excel("C:/Users/data.xls",
sheet = j, skip = 2)
# replace blank and NA replacing with 0
clean_data <- Consolidated_ABU_SKU[, -1:-2] %>% replace_with_na_all(condition = ~.x == 0)
tsdataraw <- ts( clean_data, start = c(2013,4), end = c(2019,3),
frequency = 12)
tsdata_ <- matrix(NA, nrow = 72, ncol = ncol(tsdataraw))
i <- 1 # this loop is for outlier removal
for (i in 1:ncol(tsdataraw))
{
tryCatch({
tsdata_[, i] <- tsclean(tsdataraw[, i])
}, error = function(e){cat("ERROR", "SKU",j,"ABU", i, "\n")})
}
#creating time series
tsdata <- ts(tsdata, start = c(2013,4), end = c(2019,3), frequency = 12)
# fcts is used to create the matrix, fcts is 2nd set of same data
fcts <- window(tsdata, start = c(2013, 4), end = c(2018, 3))
fcts2 <- window(tsdata, start = c(2018,4))
#Creating matrix of timeseries data
#
fc_ets <- matrix(NA, nrow = 12, ncol = ncol(fcts))
fc_arima <- matrix(NA, nrow = 12, ncol = ncol(fcts))
fc_autoarima <- matrix(NA, nrow = 12, ncol = ncol(fcts))
fc_naive <- matrix(NA, nrow = 12, ncol = ncol(fcts))
fc_rwdrift <- matrix(NA, nrow = 12, ncol = ncol(fcts))
fc_tbats <- matrix(NA, nrow = 12, ncol = ncol(fcts))
fc_hwadditive <- matrix(NA, nrow = 12, ncol = ncol(fcts))
fc_hwmultiplicative <- matrix(NA, nrow = 12, ncol = ncol(fcts))
fc_stlf <- matrix(NA, nrow = 12, ncol = ncol(fcts))
ma_ <- matrix(NA, nrow = 60, ncol = ncol(fcts))
wma_ <- matrix(NA, nrow = 60, ncol = ncol(fcts))
fc_ma <- matrix(NA, nrow = 1, ncol = ncol(fcts))
fc_wma <- matrix(NA, nrow = 1, ncol = ncol(fcts))
#for MAPE calculation
accuracy_ets <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_arima <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_autoarima <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_drift <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_naive <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_tbats <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_hwa <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_hwm <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_stlf <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_ma <- matrix(NA, nrow = ncol(fcts), ncol = 7)
accuracy_wma <- matrix(NA, nrow = ncol(fcts), ncol = 7)
fitts <- list(ncol(fcts))
mapefc <- matrix(NA, nrow = ncol(fcts), ncol = 11)
skus <- matrix(NA, nrow = 12, ncol = length(sku))
skus[, j] <- c(sku[j])
i <- 1
for (i in 1:ncol(fcts))
{
if (sum(is.na(tsdata_[, i])) == 72){next}
tryCatch({
fitts[[i]] <- stl(fcts[, i], s.window = 36)
#creating forecast
fc_ets[, i] <- forecast(fitts[[i]], method = "ets", h = 12)$mean
fc_arima[, i] <- forecast(fitts[[i]], method = "arima", h = 12)$mean
fc_autoarima[, i] <- forecast(auto.arima(fcts[, i]), h = 12)$mean
fc_rwdrift[, i] <- forecast(fitts[[i]], method = "rwdrift", h = 12)$mean
fc_naive[, i] <- forecast(fitts[[i]], method = "naive", h = 12)$mean
fc_tbats[, i] <- forecast(tbats(fcts[, i]), h = 12)$mean
fc_hwadditive[, i] <- forecast(HoltWinters(fcts[, i], seasonal = "additive"),
h = 12, prediction.interval = TRUE)$mean
fc_hwmultiplicative[, i] <- forecast(HoltWinters(fcts[, i], seasonal = "multiplicative"),
h = 12, prediction.interval = TRUE)$mean
fc_stlf[, i] <- stlf(fcts[, i], h = 12)$mean
ma_[, i] <- filter(fcts[, i], filter = (1/3)*c(0,1,1,1), sides = 1)
wma_[, i] <- filter(fcts[, i], filter = (1/10)*c(0,5,3,2), sides = 1)
fc_ma[, i] <- forecast(ma_[, i], h = 1)$mean
fc_wma[, i] <- forecast(wma_[, i], h = 1)$mean
accuracy_ets[i, ] <- accuracy(fc_ets[, i], fcts2[, i])
accuracy_arima[i, ] <- accuracy(fc_arima[, i], fcts2[, i])
accuracy_autoarima[i, ] <- accuracy(fc_autoarima[, i], fcts2[, i])
accuracy_drift[i, ] <- accuracy(fc_rwdrift[, i], fcts2[, i])
accuracy_naive[i, ] <- accuracy(fc_naive[, i], fcts2[, i])
accuracy_tbats[i, ] <- accuracy(fc_tbats[, i], fcts2[, i])
accuracy_hwa[i, ] <- accuracy(fc_hwadditive[, i], fcts2[, i])
accuracy_hwm[i, ] <- accuracy(fc_hwmultiplicative[, i], fcts2[, i])
accuracy_stlf[i, ] <- accuracy(fc_stlf[, i], fcts2[, i])
accuracy_ma[i, ] <- accuracy(ma_[, i], fcts[, i])
accuracy_wma[i, ] <- accuracy(wma_[, i], fcts[, i])
#creating MAPE to check error
mapefc[i, ] <- c(accuracy_ets[i, 5], accuracy_arima[i, 5], accuracy_autoarima[i, 5], accuracy_drift[i, 5],
accuracy_naive[i, 5], accuracy_tbats[i, 5], accuracy_hwa[i, 5],
accuracy_hwm[i, 5], accuracy_stlf[i, 5], accuracy_ma[i, 5], accuracy_wma[i, 5])
df_1 <- data.frame(SKU = skus[, j],
ABU = abu[i],
Date = c("01-04-2018", "01-05-2018", "01-06-2018",
"01-07-2018", "01-08-2018", "01-09-2018",
"01-10-2018", "01-11-2018", "01-12-2018",
"01-01-2019", "01-02-2019", "01-03-2019"),
ETS = fc_ets[,i],
Arima = fc_arima[, i],
Auto.Arima = fc_autoarima[, i],
Drift = fc_rwdrift[, i],
Naive = fc_naive[, i],
TBATS = fc_tbats[, i],
HoltWinters_Additive = fc_hwadditive[, i],
HoltWinters_Multiplicative = fc_hwmultiplicative[, i],
STLF = fc_stlf[, i],
MA = fc_ma[, i],
WMA = fc_wma[, i])
df_2 <- data.frame(SKU = sku[j],
ABU = abu[i],
Date = "MAPE",
ETS = mapefc[i, 1],
Arima = mapefc[i, 2],
Auto.Arima = mapefc[i, 3],
Drift = mapefc[i, 4],
Naive = mapefc[i, 5],
TBATS = mapefc[i, 6],
HoltWinters_Additive = mapefc[i, 7],
HoltWinters_Multiplicative = mapefc[i, 8],
STLF = mapefc[i, 9],
MA = mapefc[i, 10],
WMA = mapefc[i, 11])
df_ <- rbind(df_1, df_2)
}, error = function(e){cat("ERROR", "SKU",j,"ABU", i, "\n")})
write.table(list(df_),
file = "d:\\result.csv",
append = TRUE, quote = FALSE, sep = ",", col.names = TRUE,
row.names = FALSE)
}
}