Replace this data
plot(B, ylab="Demand for 3/32 CLEAR 72 X 84")

ggseasonplot(B, col =rainbow(12), year.labels=TRUE, ylab = "Historical Demand")

ADecomposed <- decompose(B)
plot(ADecomposed)

seasonplot(B,ylab="Demand", xlab="Month",
main="Seasonal plot: Demand",
year.labels=TRUE, year.labels.left=TRUE, col=1:20, pch=19)

Ctrain = B[1:36]
Ctest = B[49:58]
Naive
C.naive.train <- snaive(Ctrain)
C.naive.forecast <- forecast(C.naive.train)
C.naive.accuracy <- accuracy(C.naive.forecast, Ctest)
#C.naive.forecast;C.naive.accuracy
kable(C.naive.accuracy)
Training set |
0.5714286 |
60.60174 |
46.17143 |
-3.411752 |
21.54346 |
1 |
-0.1943818 |
Test set |
-33.0000000 |
33.01515 |
33.00000 |
-22.922595 |
22.92259 |
NA |
NA |
RWF
#C.sma.train <- rwf(Ctrain)
C.rwf.train <- rwf(Ctrain)
C.rwf.forecast <- forecast(C.rwf.train)
C.rwf.accuracy <- accuracy(C.rwf.forecast, Ctest)
kable(C.rwf.accuracy)
Training set |
0.5714286 |
60.60174 |
46.17143 |
-3.411752 |
21.54346 |
1.000000 |
-0.1943818 |
Test set |
63.9000000 |
90.68352 |
77.10000 |
20.366175 |
29.53521 |
1.669864 |
NA |
SMA
sma.train <- SMA(Ctrain, n = 3)
sma.forecast <- forecast(sma.train, h = 12)
## Warning in ets(object, lambda = lambda, allow.multiplicative.trend =
## allow.multiplicative.trend, : Missing values encountered. Using longest
## contiguous portion of time series
sma.accuracy <- accuracy(sma.forecast, Ctest)
kable(sma.accuracy)
Training set |
2.164964 |
28.98017 |
23.42520 |
0.0053271 |
11.72483 |
0.9707386 |
0.5603919 |
Test set |
9.230032 |
65.00372 |
51.96601 |
-4.2303146 |
23.75359 |
2.1534678 |
NA |
SES
C.ses.train <- ses(Ctrain)
C.ses.forecast <- forecast(C.ses.train)
C.ses.accuracy <- accuracy(C.ses.forecast, Ctest)
kable(C.ses.accuracy)
Training set |
1.168128 |
58.46140 |
46.47348 |
-3.923089 |
22.25934 |
1.006542 |
0.0055536 |
Test set |
51.392401 |
82.34967 |
69.59544 |
14.738898 |
27.38244 |
1.507327 |
NA |
ETS
C.ets.train <- ets(Ctrain)
C.ets.forecast <- forecast(C.ets.train, h = 6)
C.ets.accuracy <- accuracy(C.ets.forecast, Ctest)
C.ets.train;C.ets.accuracy
## ETS(A,N,N)
##
## Call:
## ets(y = Ctrain)
##
## Smoothing parameters:
## alpha = 0.7789
##
## Initial states:
## l = 156.8982
##
## sigma: 58.4614
##
## AIC AICc BIC
## 427.9291 428.6791 432.6796
## ME RMSE MAE MPE MAPE MASE
## Training set 1.163276 58.46140 46.47106 -3.926783 22.25800 1.006489
## Test set 21.651480 61.72729 51.99494 3.232894 24.30897 NA
## ACF1
## Training set 0.005656934
## Test set NA
kable(C.ets.accuracy)
Training set |
1.163276 |
58.46140 |
46.47106 |
-3.926783 |
22.25800 |
1.006489 |
0.0056569 |
Test set |
21.651480 |
61.72729 |
51.99494 |
3.232894 |
24.30897 |
NA |
NA |
Holt
C.Holt.train <- holt(Ctrain)
C.Holt.forecast <- forecast(C.Holt.train, h = 6)
C.Holt.accuracy <- accuracy(C.Holt.forecast, Ctest)
kable(C.Holt.accuracy)
Training set |
0.0680166 |
58.45546 |
46.51909 |
-4.458350 |
22.41744 |
1.00753 |
0.005948 |
Test set |
17.9005373 |
59.00199 |
49.43523 |
1.537297 |
23.44224 |
NA |
NA |
Arima
arma_fitC <- auto.arima(B)
arma_forecastC <- forecast(arma_fitC, h = 12)
arma_fit_accuracyC <- accuracy(arma_forecastC, Ctest)
arma_fitC; arma_fit_accuracyC
## Series: B
## ARIMA(1,0,0)(1,0,1)[12] with non-zero mean
##
## Coefficients:
## ar1 sar1 sma1 intercept
## 0.5057 0.8792 -0.4096 225.4772
## s.e. 0.1196 0.1134 0.2626 24.5986
##
## sigma^2 estimated as 1440: log likelihood=-295.91
## AIC=601.81 AICc=602.97 BIC=612.12
## ME RMSE MAE MPE MAPE MASE
## Training set 0.782589 36.61132 30.83331 -3.308060 15.02284 0.6927469
## Test set 23.055183 68.96918 63.48729 4.875268 27.13618 1.4263995
## ACF1
## Training set -0.004678829
## Test set NA
BestForecast
variableB = window(ThreeYear)
arma_fit_2015FC <- auto.arima(variableB)
arma_forecastC <- forecast(arma_fit_2015FC, h = 12)
arma_forecastC
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2105 494.7259 318.0591 671.3926 224.5374 764.9143
## Feb 2105 423.1596 235.9723 610.3469 136.8814 709.4379
## Mar 2105 451.9351 254.7879 649.0823 150.4244 753.4457
## Apr 2105 789.1606 582.5330 995.7882 473.1509 1105.1703
## May 2105 1029.0407 813.3489 1244.7324 699.1687 1358.9127
## Jun 2105 1048.4620 824.0720 1272.8520 705.2871 1391.6368
## Jul 2105 1137.0253 904.2619 1369.7887 781.0444 1493.0062
## Aug 2105 1150.5906 909.7447 1391.4365 782.2486 1518.9326
## Sep 2105 1191.6808 943.0150 1440.3466 811.3793 1571.9823
## Oct 2105 1270.3948 1014.1476 1526.6420 878.4985 1662.2910
## Nov 2105 715.5118 451.9012 979.1225 312.3541 1118.6695
## Dec 2105 538.0244 267.2504 808.7983 123.9114 952.1373
AccuracyBest <- data.frame(B.Actual2015, BestForecast2015)
#kable(AccuracyBest)
AccuracySecondBest <- data.frame(B.Actual2015, SecondBestFC)
#kable(AccuracySecondBest)
Month.YrInventory <- c("January 2015", "February 2015", "March 2015", "April 2015", "May 2015", "June 2015", "July 2015", "August 2015", "September 2015","October 2015", "November 2015", "December 2015")
ModelBest <- data_frame(Month.YrInventory , BestForecast2015, SeasonIndexB)
#ModelBest
#sigmaBig = sd(ModelBest$BestForec=AVERAGE(ast2015)
sigma = sd(ModelBest$BestForecast2015/21)
LeadTime = 5
sqrtLead = sqrt(LeadTime)
ServiceLevel = 2.05
January 2015 |
24 |
10 |
118 |
45 |
163 |
February 2015 |
20 |
9 |
101 |
41 |
141 |
March 2015 |
22 |
10 |
108 |
44 |
152 |
April 2015 |
38 |
14 |
188 |
65 |
253 |
May 2015 |
49 |
16 |
245 |
74 |
319 |
June 2015 |
50 |
17 |
250 |
80 |
330 |
July 2015 |
54 |
20 |
271 |
90 |
361 |
August 2015 |
55 |
19 |
274 |
85 |
359 |
September 2015 |
57 |
17 |
284 |
80 |
364 |
October 2015 |
60 |
23 |
302 |
105 |
408 |
November 2015 |
34 |
16 |
170 |
73 |
244 |
December 2015 |
26 |
12 |
128 |
54 |
182 |