Library Import
library(readxl)
library(magrittr)
library(tibble)
library(plyr)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:plyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(splusTimeDate)
##
## Attaching package: 'splusTimeDate'
## The following objects are masked from 'package:base':
##
## months, quarters, sort.list, weekdays
library(stringi)
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:splusTimeDate':
##
## days, hms, hours, mdy, minutes, seconds, years
## The following object is masked from 'package:plyr':
##
## here
## The following object is masked from 'package:base':
##
## date
library(zoo)
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(xts)
##
## Attaching package: 'xts'
## The following objects are masked from 'package:dplyr':
##
## first, last
library(ggplot2)
library(plotly)
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following objects are masked from 'package:plyr':
##
## arrange, mutate, rename, summarise
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(astsa)
library(forecast)
##
## Attaching package: 'forecast'
## The following object is masked from 'package:astsa':
##
## gas
library(Metrics)
##
## Attaching package: 'Metrics'
## The following object is masked from 'package:forecast':
##
## accuracy
library(gtools)
library(reshape2)
library(lattice)
library(caret)
##
## Attaching package: 'caret'
## The following objects are masked from 'package:Metrics':
##
## precision, recall
library(plyr)
library(gbm)
## Loaded gbm 2.1.5
library(bst)
library(tidyr)
##
## Attaching package: 'tidyr'
## The following object is masked from 'package:reshape2':
##
## smiths
## The following object is masked from 'package:magrittr':
##
## extract
library(forecast)
Excel files Import and Data Structure Reshaping
Hdf1=read_excel("C://Users//wchie//OneDrive//Desktop//Arconic Data 1.xlsx",sheet=1)
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in G4174 / R4174C7: got '1753-01-01'
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in G10364 / R10364C7: got '1753-01-01'
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in G10365 / R10365C7: got '1753-01-01'
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in G22212 / R22212C7: got '1753-01-01'
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in G35019 / R35019C7: got '1753-01-01'
Hdf1 = Hdf1 %>%
mutate(`Quantity (PCS)` = as.numeric(`Quantity (PCS)`),
`Ship Date Promise` = as.Date(`Ship Date Promise`))
Hdf2=read_excel("C://Users//wchie//OneDrive//Desktop//Arconic Data 2.xlsx",sheet=1)
Hdf2 = Hdf2 %>%
mutate(`Sales Order #` = as.character(`Sales Order #`),
`Line #` = as.character(`Line #`),
`Item Group (Product Family)` = as.character(`Item Group (Product Family)`),
`Ship Date Promise` = as.Date(as.numeric(`Ship Date Promise`),origin = "1899-12-30")) %>%
rename(`Quantity (PCS)` = `Quantity (Pcs)`,`LT at Time of Order (WKS)` = `LT at Time of Order (Wks)`)
## Warning in as.Date(as.numeric(`Ship Date Promise`), origin = "1899-12-30"):
## NAs introduced by coercion
Hdf3=read_excel("C://Users//wchie//OneDrive//Desktop//Arconic Data 3.xlsx",sheet=1)
Hdf3 = Hdf3 %>%
mutate(`Sales Order #` = as.character(`Sales Order #`),
`Line #` = as.character(`Line #`),
`Item Group (Product Family)` = as.character(`Item Group (Product Family)`),
`Ship Date Promise` = as.Date(as.numeric(`Ship Date Promise`),origin = "1899-12-30")) %>%
rename(`Quantity (PCS)` = `Quantity (Pcs)`,`LT at Time of Order (WKS)` = `LT at Time of Order (Wks)`)
## Warning in as.Date(as.numeric(`Ship Date Promise`), origin = "1899-12-30"):
## NAs introduced by coercion
Hdf = bind_rows(list(Hdf1,Hdf2,Hdf3))
OpenOrder_df1=read_excel("C://Users//wchie//OneDrive//Desktop//Arconic Data 1.xlsx",sheet=2)
OpenOrder_df2=read_excel("C://Users//wchie//OneDrive//Desktop//Arconic Data 2.xlsx",sheet=2)
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in G3497 / R3497C7: got '01/01/1753'
OpenOrder_df2 = OpenOrder_df2 %>%
mutate(`Item Group (Product Family)`=as.character(`Item Group (Product Family)`)) %>%
filter(!is.na(`Ship Date Promise`))
OpenOrder_df3=read_excel("C://Users//wchie//OneDrive//Desktop//Arconic Data 3.xlsx",sheet=2)
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in E3493 / R3493C5: got 'NULL'
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in F3493 / R3493C6: got 'NULL'
## Warning in read_fun(path = enc2native(normalizePath(path)), sheet_i =
## sheet, : Expecting date in G3493 / R3493C7: got 'NULL'
glimpse(OpenOrder_df3)
## Observations: 3,492
## Variables: 11
## $ `Customer #` <chr> "354011", "354011", "354011", "9...
## $ `Delivery Address` <chr> "001", "005", "005", "009", "001...
## $ `Sales Order #` <dbl> 273780, 274385, 276086, 267666, ...
## $ `Line #` <dbl> 1, 2, 70, 5, 12, 2, 1, 2, 2, 7, ...
## $ `Order Date` <dttm> 2018-03-02, 2018-03-12, 2018-04...
## $ `Request Date` <dttm> 2018-04-30, 2018-05-14, 2018-06...
## $ `Ship Date Promise` <dttm> 2018-04-30, 2018-05-14, 2018-06...
## $ `Item #` <chr> "BTCW-4U8", "BTCW-4U8", "BTCW-4U...
## $ `Item Group (Product Family)` <dbl> 12354, 12354, 12354, 14372, 1235...
## $ `Quantity (Pcs)` <dbl> 6000, 4000, 4000, 210, 13500, 11...
## $ `LT at Time of Order (Wks)` <dbl> 10, 10, 12, 10, 10, 8, 18, 18, 1...
OpenOrder_df3 = OpenOrder_df3 %>%
mutate(`Item Group (Product Family)` = as.character(`Item Group (Product Family)`)) %>%
rename(`Quantity (PCS)` = `Quantity (Pcs)`,`LT at Time of Order (WKS)` = `LT at Time of Order (Wks)`) %>%
filter(!is.na(`Order Date`))
OpenOrder_df = bind_rows(list(OpenOrder_df1,OpenOrder_df2,OpenOrder_df3))
truck_market_rate1=read_excel("C://Users//wchie//OneDrive//Desktop//Arconic Data 1.xlsx",sheet=3)
truck_market_rate3=read_excel("C://Users//wchie//OneDrive//Desktop//Arconic Data 3.xlsx",sheet=3)
Tool for ARIMA and BaggedETS Models
Forecasting_Model_Function = function(historical_data = NA, openorder_data = NA,Combine_H_O = NA, truck_market_rate =NA, Increase_Sensitivity_ARIMA = TRUE,Item_Group = NA, Item = NA, Delivery_Address = NA,Max_C_Date = FALSE,Max_C_Date_value = "2018-10-01" , Prediction_Terms = 12){
Hdf = historical_data
OpenOrder_df = openorder_data
# Copy the ship Date Actual to the Ship Date Promise's Missing Value #
Hdf = as.data.frame(Hdf)
missing_value_P_list = which(is.na(Hdf$`Ship Date Promise`))
fill_table_A = Hdf[c(which(is.na(Hdf$`Ship Date Promise`))),c("Ship Date Actual")]
for (i in 1:length(missing_value_P_list)){
Hdf[missing_value_P_list[[i]],c("Ship Date Promise")] = fill_table_A[[i]]
}
Hdf = as.tibble(Hdf)
# OpenOrder data need to be fixed #
OpenOrder_df=na.omit(OpenOrder_df)
# Date Transformation and handling missing value #
New_Hdf = Hdf %>% mutate(Order_Date = ymd(`Order Date`),
Order_Date_year = year(`Order Date`),
Order_Date_month = month(`Order Date`),
`LT at Time of Order (WKS)` =replace(`LT at Time of Order (WKS)`, is.na(`LT at Time of Order (WKS)`),mean(`LT at Time of Order (WKS)`, na.rm=T)))
sapply(New_Hdf,function(x) sum(is.na(x)))
# filling Missing value of ship date actual for OpenOrder Data by using ship date promise
New_Hdf[setdiff(names(OpenOrder_df), names(New_Hdf))] <- NA
OpenOrder_df[setdiff(names(New_Hdf), names(OpenOrder_df))] <- NA
H_Open_df = rbind(New_Hdf, OpenOrder_df)
H_Open_df = as.data.frame(H_Open_df)
missing_value_A_list = which(is.na(H_Open_df$`Ship Date Actual`))
fill_table_P = H_Open_df[c(which(is.na(H_Open_df$`Ship Date Actual`))),c("Ship Date Promise")]
for (i in 1:length(missing_value_A_list)){
H_Open_df[missing_value_A_list[[i]],c("Ship Date Actual")] = fill_table_P[[i]]
}
H_Open_df = as.tibble(H_Open_df)
# Identify the Combine_H_O
if (isTRUE(Combine_H_O)){
select_sample_df = H_Open_df
}
else{
select_sample_df = New_Hdf
}
#Identify the parameters are TRUE or FALSE#
if(!is.na(Item_Group) & is.na(Item) & is.na(Delivery_Address)){
sample_df <- select_sample_df %>%
filter(`Item Group (Product Family)`== Item_Group)
}
else if(!is.na(Item_Group) & !is.na(Item) & is.na(Delivery_Address)){
sample_df <- select_sample_df %>%
filter(`Item Group (Product Family)`== Item_Group,`Item #`==Item)
}
else if(!is.na(Item_Group) & !is.na(Item) & !is.na(Delivery_Address)){
sample_df <- select_sample_df %>%
filter(`Item Group (Product Family)`== Item_Group,`Item #`==Item,`Delivery Address`==Delivery_Address)
}
else{
print("You should at least fill Item_Group or Item out, then the machine could be work.")
}
# Starting to filter out the data we want #
sample_df <- sample_df %>%
mutate(`Order Date` = as.Date(`Order Date`),
`Quantity (PCS)` = as.integer(`Quantity (PCS)`),
diff_Promise_Order_days = difftime(`Ship Date Promise`,`Order Date`,units = c('days')),
diff_Actual_Promise_days = difftime(`Ship Date Actual`,`Ship Date Promise`,units = c('days')),
diff_Actual_Order_days = difftime(`Ship Date Actual`,`Order Date`, units = c('days'))) %>%
arrange(`Order Date`) %>%
select(`Order Date`,diff_Promise_Order_days,diff_Actual_Promise_days,diff_Actual_Order_days,`Quantity (PCS)`,`LT at Time of Order (WKS)`) %>%
group_by(`Order Date` = floor_date(`Order Date`, unit="month")) %>%
summarise(sumQuantity = sum(`Quantity (PCS)`),
avg_diff_Promise_Order_days=mean(diff_Promise_Order_days),
avg_diff_Actual_Promise_days=mean(diff_Actual_Promise_days),
avg_diff_Actual_Order_days=mean(diff_Actual_Order_days),
`avg LT at Time of Order (WKS)`=mean(`LT at Time of Order (WKS)`))
if (isTRUE(Max_C_Date)){
sample_df = sample_df %>%
complete(`Order Date` = seq.Date(min(`Order Date`),max(`Order Date`),by='month')) %>%
na.replace(.,0) %>%
filter(`Order Date` <= as.Date(Max_C_Date_value))
}
else{
sample_df = sample_df %>%
complete(`Order Date` = seq.Date(min(`Order Date`),max(as.Date(Max_C_Date_value)),by='month')) %>%
na.replace(.,0) %>%
filter(`Order Date` <= as.Date(Max_C_Date_value))
}
sample_df = sample_df %>%
mutate(Demand_rate = abs(sumQuantity-lag(sumQuantity)),
`Safety Stock Level` = Demand_rate*as.numeric(avg_diff_Promise_Order_days)/30,
Inventory_Level = sumQuantity*abs(as.numeric(`avg LT at Time of Order (WKS)`)*7/28-(as.numeric(`avg LT at Time of Order (WKS)`)*7)%/%28))
sample_df1 = sample_df
# Time Series Plot #
sample_df = as.tibble(as.data.frame(sample_df))
p1 = list()
p1[[1]] = sample_df %>% plot_ly() %>%
add_trace(x= ~`Order Date`,y= ~sumQuantity,name="sumQuantity",type='scatter', mode='lines') %>%
#add_trace(x= ~`Order Date`,y= ~`Safety Stock Level`,name="High Inventory Level",type='scatter', mode='lines') %>%
add_trace(x= ~`Order Date`,y= ~Inventory_Level,name="Inventory Level",type='scatter', mode='lines') %>%
layout(title='Historical Plot')
p1[[2]] = sample_df %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~avg_diff_Actual_Promise_days, name="diff_A_P_days")
p1[[3]] = sample_df %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~avg_diff_Promise_Order_days, name="diff_P_O_days")
p1[[4]] = sample_df %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~`avg LT at Time of Order (WKS)`, name="Avg LT of Order (WKS)")
# xts Transformation
ts_Demand_sample_df = ts(sample_df$sumQuantity,start = c(year(min(sample_df$`Order Date`)),month(min(sample_df$`Order Date`))), frequency = 12)
# ARIMA Model #
if (isTRUE(Increase_Sensitivity_ARIMA)){
arima_ts = auto.arima(ts_Demand_sample_df, D=1)
}
else{
arima_ts = auto.arima(ts_Demand_sample_df)
}
# BaggedETS Model
bagg_model = baggedETS(ts_Demand_sample_df)
bagged_aic_list = list()
for (i in 1:length(bagg_model$models)){
bagged_aic_list=append(bagged_aic_list,as.numeric(bagg_model$models[[i]]$aic))
}
if(arima_ts$aic < bagg_model$models[[which.min(bagged_aic_list)]]$aic){
f_arima_ts <- forecast(arima_ts, level = c(80,95), h = Prediction_Terms)
#print(f_arima_ts$mean)
forecasting_table = as.tibble(data.frame(`Order Date`=as.Date(f_arima_ts$mean), sumQuantity=as.matrix(f_arima_ts$mean)))
His_table = sample_df %>%
select(`Order Date`,sumQuantity,`avg LT at Time of Order (WKS)`)
forecasting_table = forecasting_table %>%
rename(`Order Date` = Order.Date) %>%
filter(`Order Date` > tail(His_table$`Order Date`,1))
# Linear Regression #
Linear_Model = lm(`avg LT at Time of Order (WKS)`~poly(sumQuantity,2), data = sample_df1)
new_demand = data.frame(sumQuantity = forecasting_table$sumQuantity)
forecasting_D_P_O_table = data.frame(avg_LT_at_Time_of_Order = predict(Linear_Model, new_demand))
forecasting_table = cbind(forecasting_table,forecasting_D_P_O_table$avg_LT_at_Time_of_Order)
forecasting_table = forecasting_table %>%
rename(`avg LT at Time of Order (WKS)` = `forecasting_D_P_O_table$avg_LT_at_Time_of_Order`)
Full_table = rbind(His_table,forecasting_table)
Full_table = Full_table %>%
mutate(Inventory_Level = sumQuantity*abs(as.numeric(`avg LT at Time of Order (WKS)`)*7/28-(as.numeric(`avg LT at Time of Order (WKS)`)*7)%/%28))
Full_table %>%
filter(`Order Date` > tail(His_table$`Order Date`,1)) %>%
print()
# Time Series Plot #
Full_table = as.tibble(as.data.frame(Full_table))
p2 = list()
p2[[1]] = Full_table %>% plot_ly() %>%
add_trace(x= ~`Order Date`,y= ~sumQuantity,name="sumQuantity",type='scatter', mode='lines') %>%
add_trace(x= ~`Order Date`,y= ~Inventory_Level,name="Inventory Level",type='scatter', mode='lines')%>%
layout(title='Forecasting Plot')
p2[[2]] = Full_table %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~`avg LT at Time of Order (WKS)`, name="avg LT of Order (WKS)")
return(list(autoplot(f_arima_ts),subplot(p1,nrows=4),subplot(p2,nrows=2)))
}
else{
# BaggedETS Model #
f_bagg_ts = forecast(bagg_model, h = Prediction_Terms)
forecasting_table = as.tibble(data.frame(`Order Date`=as.Date(f_bagg_ts$mean), sumQuantity=as.matrix(f_bagg_ts$mean)))
His_table = sample_df %>%
select(`Order Date`,sumQuantity,`avg LT at Time of Order (WKS)`)
forecasting_table = forecasting_table %>%
rename(`Order Date` = Order.Date) %>%
filter(`Order Date` > tail(His_table$`Order Date`,1))
# Linear Regression #
Linear_Model = lm(`avg LT at Time of Order (WKS)`~poly(sumQuantity,2), data = sample_df1)
new_demand = data.frame(sumQuantity = forecasting_table$sumQuantity)
forecasting_D_P_O_table = data.frame(avg_LT_at_Time_of_Order = predict(Linear_Model, new_demand))
forecasting_table = cbind(forecasting_table,forecasting_D_P_O_table$avg_LT_at_Time_of_Order)
forecasting_table = forecasting_table %>%
rename(`avg LT at Time of Order (WKS)` = `forecasting_D_P_O_table$avg_LT_at_Time_of_Order`)
Full_table = rbind(His_table,forecasting_table)
Full_table = Full_table %>%
mutate(Inventory_Level = sumQuantity*abs(as.numeric(`avg LT at Time of Order (WKS)`)*7/28-(as.numeric(`avg LT at Time of Order (WKS)`)*7)%/%28))
Full_table %>%
filter(`Order Date` > tail(His_table$`Order Date`,1)) %>%
print()
# Time Series Plot #
Full_table = as.tibble(as.data.frame(Full_table))
p2 = list()
p2[[1]] = Full_table %>% plot_ly() %>%
add_trace(x= ~`Order Date`,y= ~sumQuantity,name="sumQuantity",type='scatter', mode='lines') %>%
add_trace(x= ~`Order Date`,y= ~Inventory_Level,name="Inventory Level",type='scatter', mode='lines')%>%
layout(title='Forecasting Plot')
p2[[2]] = Full_table %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~`avg LT at Time of Order (WKS)`, name="avg LT of Order (WKS)")
return(list(autoplot(f_bagg_ts),subplot(p1,nrows=4),subplot(p2,nrows=2)))
}
}
Tool for Neuroal Network Time Series
Forecasting_nn_Model_Function = function(historical_data = NA, openorder_data = NA,Combine_H_O = NA, truck_market_rate =NA,Item_Group = NA, Item = NA, Delivery_Address = NA,Max_C_Date = FALSE,Max_C_Date_value = "2018-10-01" , Prediction_Terms = 12){
Hdf = historical_data
OpenOrder_df = openorder_data
# Copy the ship Date Actual to the Ship Date Promise's Missing Value #
Hdf = as.data.frame(Hdf)
missing_value_P_list = which(is.na(Hdf$`Ship Date Promise`))
fill_table_A = Hdf[c(which(is.na(Hdf$`Ship Date Promise`))),c("Ship Date Actual")]
for (i in 1:length(missing_value_P_list)){
Hdf[missing_value_P_list[[i]],c("Ship Date Promise")] = fill_table_A[[i]]
}
Hdf = as.tibble(Hdf)
# OpenOrder data need to be fixed #
OpenOrder_df=na.omit(OpenOrder_df)
# Date Transformation and handling missing value #
New_Hdf = Hdf %>% mutate(Order_Date = ymd(`Order Date`),
Order_Date_year = year(`Order Date`),
Order_Date_month = month(`Order Date`),
`LT at Time of Order (WKS)` =replace(`LT at Time of Order (WKS)`, is.na(`LT at Time of Order (WKS)`),mean(`LT at Time of Order (WKS)`, na.rm=T)))
sapply(New_Hdf,function(x) sum(is.na(x)))
# filling Missing value of ship date actual for OpenOrder Data by using ship date promise
New_Hdf[setdiff(names(OpenOrder_df), names(New_Hdf))] <- NA
OpenOrder_df[setdiff(names(New_Hdf), names(OpenOrder_df))] <- NA
H_Open_df = rbind(New_Hdf, OpenOrder_df)
H_Open_df = as.data.frame(H_Open_df)
missing_value_A_list = which(is.na(H_Open_df$`Ship Date Actual`))
fill_table_P = H_Open_df[c(which(is.na(H_Open_df$`Ship Date Actual`))),c("Ship Date Promise")]
for (i in 1:length(missing_value_A_list)){
H_Open_df[missing_value_A_list[[i]],c("Ship Date Actual")] = fill_table_P[[i]]
}
H_Open_df = as.tibble(H_Open_df)
# Identify the Combine_H_O
if (isTRUE(Combine_H_O)){
select_sample_df = H_Open_df
}
else{
select_sample_df = New_Hdf
}
if(!is.na(Item_Group) & is.na(Item) & is.na(Delivery_Address)){
sample_df <- select_sample_df %>%
filter(`Item Group (Product Family)`== Item_Group)
}
else if(!is.na(Item_Group) & !is.na(Item) & is.na(Delivery_Address)){
sample_df <- select_sample_df %>%
filter(`Item Group (Product Family)`== Item_Group,`Item #`==Item)
}
else if(!is.na(Item_Group) & !is.na(Item) & !is.na(Delivery_Address)){
sample_df <- select_sample_df %>%
filter(`Item Group (Product Family)`== Item_Group,`Item #`==Item,`Delivery Address`==Delivery_Address)
}
else{
print("You should at least fill Item_Group or Item out, then the machine could be work.")
}
# Item_Group Prediction #
### The sumQuantity for each family by each month ###
# Simple transformation to the time series table #
# Based on the Order Date for the same Item Family to caculate the total Quantity #
sample_df <- sample_df %>%
mutate(`Order Date` = as.Date(`Order Date`),
`Quantity (PCS)` = as.integer(`Quantity (PCS)`),
diff_Promise_Order_days = difftime(`Ship Date Promise`,`Order Date`,units = c('days')),
diff_Actual_Promise_days = difftime(`Ship Date Actual`,`Ship Date Promise`,units = c('days')),
diff_Actual_Order_days = difftime(`Ship Date Actual`,`Order Date`, units = c('days'))) %>%
arrange(`Order Date`) %>%
select(`Order Date`,diff_Promise_Order_days,diff_Actual_Promise_days,diff_Actual_Order_days,`Quantity (PCS)`,`LT at Time of Order (WKS)`) %>%
group_by(`Order Date` = floor_date(`Order Date`, unit="month")) %>%
summarise(sumQuantity = sum(`Quantity (PCS)`),
avg_diff_Promise_Order_days=mean(diff_Promise_Order_days),
avg_diff_Actual_Promise_days=mean(diff_Actual_Promise_days),
avg_diff_Actual_Order_days=mean(diff_Actual_Order_days),
`avg LT at Time of Order (WKS)`=mean(`LT at Time of Order (WKS)`))
if (isTRUE(Max_C_Date)){
sample_df = sample_df %>%
complete(`Order Date` = seq.Date(min(`Order Date`),max(`Order Date`),by='month')) %>%
na.replace(.,0) %>%
filter(`Order Date` <= as.Date(Max_C_Date_value))
}
else{
sample_df = sample_df %>%
complete(`Order Date` = seq.Date(min(`Order Date`),max(as.Date(Max_C_Date_value)),by='month')) %>%
na.replace(.,0) %>%
filter(`Order Date` <= as.Date(Max_C_Date_value))
}
sample_df = sample_df %>%
mutate(Demand_rate = abs(sumQuantity-lag(sumQuantity)),
`Safety Stock Level` = Demand_rate*as.numeric(avg_diff_Promise_Order_days)/30,
Inventory_Level = sumQuantity*abs(as.numeric(`avg LT at Time of Order (WKS)`)*7/28-(as.numeric(`avg LT at Time of Order (WKS)`)*7)%/%28))
sample_df1 = sample_df
# Time Series Plot #
sample_df = as.tibble(as.data.frame(sample_df))
p1 = list()
p1[[1]] = sample_df %>% plot_ly() %>%
add_trace(x= ~`Order Date`,y= ~sumQuantity,name="sumQuantity",type='scatter', mode='lines') %>%
#add_trace(x= ~`Order Date`,y= ~`Safety Stock Level`,name="High Inventory Level",type='scatter', mode='lines') %>%
add_trace(x= ~`Order Date`,y= ~Inventory_Level,name="Inventory Level",type='scatter', mode='lines') %>%
layout(title='Historical Plot')
p1[[2]] = sample_df %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~avg_diff_Actual_Promise_days, name="diff_A_P_days")
p1[[3]] = sample_df %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~avg_diff_Promise_Order_days, name="diff_P_O_days")
p1[[4]] = sample_df %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~`avg LT at Time of Order (WKS)`, name="Avg LT of Order (WKS)")
# xts Transformation
ts_Demand_sample_df = ts(sample_df$sumQuantity,start = c(year(min(sample_df$`Order Date`)),month(min(sample_df$`Order Date`))), frequency = 12)
fit = nnetar(ts_Demand_sample_df,decay=0.5,maxit=150)
f_nn_ts <- forecast(fit, h = Prediction_Terms)
#print(f_arima_ts$mean)
forecasting_table = as.tibble(data.frame(`Order Date`=as.Date(f_nn_ts$mean), sumQuantity=as.matrix(f_nn_ts$mean)))
His_table = sample_df %>%
select(`Order Date`,sumQuantity,`avg LT at Time of Order (WKS)`)
forecasting_table = forecasting_table %>%
rename(`Order Date` = Order.Date) %>%
filter(`Order Date` > tail(His_table$`Order Date`,1))
# Linear Regression #
Linear_Model = lm(`avg LT at Time of Order (WKS)`~poly(sumQuantity,2), data = sample_df1)
new_demand = data.frame(sumQuantity = forecasting_table$sumQuantity)
forecasting_D_P_O_table = data.frame(avg_LT_at_Time_of_Order = predict(Linear_Model, new_demand))
forecasting_table = cbind(forecasting_table,forecasting_D_P_O_table$avg_LT_at_Time_of_Order)
forecasting_table = forecasting_table %>%
rename(`avg LT at Time of Order (WKS)` = `forecasting_D_P_O_table$avg_LT_at_Time_of_Order`)
Full_table = rbind(His_table,forecasting_table)
Full_table = Full_table %>%
mutate(Inventory_Level = sumQuantity*abs(as.numeric(`avg LT at Time of Order (WKS)`)*7/28-(as.numeric(`avg LT at Time of Order (WKS)`)*7)%/%28))
Full_table %>%
filter(`Order Date` > tail(His_table$`Order Date`,1)) %>%
print()
# Time Series Plot #
Full_table = as.tibble(as.data.frame(Full_table))
p2 = list()
p2[[1]] = Full_table %>% plot_ly() %>%
add_trace(x= ~`Order Date`,y= ~sumQuantity,name="sumQuantity",type='scatter', mode='lines') %>%
add_trace(x= ~`Order Date`,y= ~Inventory_Level,name="Inventory Level",type='scatter', mode='lines') %>%
layout(title='Forecasting Plot')
p2[[2]] = Full_table %>% plot_ly() %>%
add_lines(x= ~`Order Date`, y= ~`avg LT at Time of Order (WKS)`, name="Avg LT of Order (WKS)")
return(list(autoplot(f_nn_ts),subplot(p1,nrows=4),subplot(p2,nrows=2)))
}
Short Term for One Month
Two Models ARIMA and BaggedETS
Forecasting_Model_Function(historical_data = Hdf, openorder_data = OpenOrder_df,Combine_H_O = NA,Item_Group = 11286,Increase_Sensitivity_ARIMA = TRUE,Prediction_Terms = 1,Max_C_Date = FALSE,Max_C_Date_value = "2018-10-01")
## Warning: `as.tibble()` is deprecated, use `as_tibble()` (but mind the new semantics).
## This warning is displayed once per session.
## # A tibble: 1 x 4
## `Order Date` sumQuantity `avg LT at Time of Order (WKS)` Inventory_Level
## <date> <dbl> <dbl> <dbl>
## 1 2018-11-01 1281313. 10.4 769668.
## [[1]]
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
##
## [[2]]
##
## [[3]]
Long Term for three months
Two Models ARIMA and BaggedETS
Forecasting_Model_Function(historical_data = Hdf, openorder_data = OpenOrder_df,Combine_H_O = NA,Item_Group = 11286,Increase_Sensitivity_ARIMA = TRUE,Prediction_Terms = 3,Max_C_Date = FALSE,Max_C_Date_value = "2018-10-01")
## # A tibble: 3 x 4
## `Order Date` sumQuantity `avg LT at Time of Order (WKS)` Inventory_Level
## <date> <dbl> <dbl> <dbl>
## 1 2018-11-01 1281313. 10.4 769668.
## 2 2018-12-01 2176508. 9.17 636813.
## 3 2019-01-01 3793421. 8.36 343278.
## [[1]]
##
## [[2]]
##
## [[3]]
short Term for One Month
Neuronal Network
Forecasting_nn_Model_Function(historical_data = Hdf, openorder_data = OpenOrder_df,Combine_H_O = NA,Item_Group = 11286,Prediction_Terms = 1,Max_C_Date_value = "2018-10-01")
## # A tibble: 1 x 4
## `Order Date` sumQuantity `avg LT at Time of Order (WKS)` Inventory_Level
## <date> <dbl> <dbl> <dbl>
## 1 2018-11-01 1841312. 9.57 721006.
## [[1]]
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
##
## [[2]]
##
## [[3]]
Long Term for three months
Neuronal Network
Forecasting_nn_Model_Function(historical_data = Hdf, openorder_data = OpenOrder_df,Combine_H_O = NA,Item_Group = 11286,Prediction_Terms = 3,Max_C_Date_value = "2018-10-01")
## # A tibble: 3 x 4
## `Order Date` sumQuantity `avg LT at Time of Order (WKS)` Inventory_Level
## <date> <dbl> <dbl> <dbl>
## 1 2018-11-01 1846600. 9.56 719912.
## 2 2018-12-01 2530806. 8.84 529624.
## 3 2019-01-01 2920972. 8.57 417308.
## [[1]]
##
## [[2]]
##
## [[3]]