Untitled
Christine
November 25, 2016
```
SS12CLR102130
X <- ts(c(248, 307, 364, 390, 384, 429, 430, 622, 498, 485, 423, 291, 325, 465, 440, 416, 475, 509, 642, 677, 437, 414),
start = c(2015, 1), frequency = 12)kable(X)| 248 |
| 307 |
| 364 |
| 390 |
| 384 |
| 429 |
| 430 |
| 622 |
| 498 |
| 485 |
| 423 |
| 291 |
| 325 |
| 465 |
| 440 |
| 416 |
| 475 |
| 509 |
| 642 |
| 677 |
| 437 |
| 414 |
seasonplot(X,ylab="Demand", xlab="Month",
main="Seasonal plot: SS12CLR102130 Demand",
year.labels=TRUE, year.labels.left=TRUE, col=1:20, pch=19)
monthplot(X,ylab="Demand",xlab="Month",xaxt="n",
main="Seasonal deviation plot: Demand for SS12CLR102130")
ggseasonplot(X, col =rainbow(12), year.labels=TRUE )
ggseasonplot(X, year.labels=TRUE, continuous=TRUE)
ets(X)## ETS(M,N,N)
##
## Call:
## ets(y = X)
##
## Smoothing parameters:
## alpha = 0.9999
##
## Initial states:
## l = 238.8124
##
## sigma: 0.2017
##
## AIC AICc BIC
## 268.9734 270.3067 272.2465library(fma)## Loading required package: tseriesfit1 <- ets(X)
fit2 <- ets(X,model= "MNN")deviance <- 2*c(logLik(fit1) - logLik(fit2))
df <- attributes(logLik(fit1))$df - attributes(logLik(fit2))$df
#P value
1-pchisq(deviance,df)## [1] 1ses(X)## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Nov 2016 415.2068 297.17310 533.2404 234.68985 595.7237
## Dec 2016 415.2068 251.39966 579.0139 164.68542 665.7281
## Jan 2017 415.2068 215.87391 614.5396 110.35347 720.0601
## Feb 2017 415.2068 185.78487 644.6287 64.33626 766.0773
## Mar 2017 415.2068 159.20828 671.2052 23.69086 806.7227
## Apr 2017 415.2068 135.14240 695.2711 -13.11471 843.5282
## May 2017 415.2068 112.98687 717.4267 -46.99868 877.4122
## Jun 2017 415.2068 92.34815 738.0654 -78.56288 908.9764
## Jul 2017 415.2068 72.95173 757.4618 -108.22713 938.6407
## Aug 2017 415.2068 54.59711 775.8164 -136.29811 966.7116holt(X)## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Nov 2016 424.6726 306.6161 542.7291 244.120806 605.2244
## Dec 2016 431.9161 270.8205 593.0117 185.541626 678.2905
## Jan 2017 439.1596 244.3036 634.0155 141.153104 737.1660
## Feb 2017 446.4030 222.8220 669.9841 104.465356 788.3407
## Mar 2017 453.6465 204.6270 702.6660 72.804076 834.4889
## Apr 2017 460.8900 188.7953 732.9847 44.757076 877.0229
## May 2017 468.1335 174.7686 761.4983 19.470676 916.7962
## Jun 2017 475.3769 162.1791 788.5748 -3.617893 954.3718
## Jul 2017 482.6204 150.7688 814.4720 -24.902846 990.1437
## Aug 2017 489.8639 140.3490 839.3788 -44.673040 1024.4008train = X[1:17]
test = X[18:22]
arma_fit <- auto.arima(train)
arma_forecast <- forecast(arma_fit, h = 5)
arma_fit_accuracy <- accuracy(arma_forecast, test)
arma_fit; arma_forecast; arma_fit_accuracy## Series: train
## ARIMA(1,0,0) with non-zero mean
##
## Coefficients:
## ar1 intercept
## 0.5601 404.8008
## s.e. 0.2202 38.3942
##
## sigma^2 estimated as 6211: log likelihood=-97.49
## AIC=200.97 AICc=202.82 BIC=203.47## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 18 444.1174 343.1219 545.1130 289.6580 598.5768
## 19 426.8209 311.0640 542.5779 249.7859 603.8560
## 20 417.1337 297.1198 537.1475 233.5883 600.6790
## 21 411.7081 290.3897 533.0265 226.1677 597.2485
## 22 408.6694 286.9447 530.3941 222.5075 594.8312## ME RMSE MAE MPE MAPE MASE
## Training set 6.751697 74.02652 48.64956 -1.692432 12.48599 0.7791721
## Test set 114.110107 154.08465 114.11011 18.344851 18.34485 1.8275893
## ACF1
## Training set -0.02020686
## Test set NAplot(arma_forecast, ylim=c(0,1400))
lines(X[1:22])
Xfit1 <- meanf(X,h=3)
Xfit2 <- rwf(X,h=3)
Xfit3 <- snaive(X,h=3)
plot(Xfit1, plot.conf=FALSE,
main="Forecasts for SS02CLR7284")
lines(Xfit2$mean,col=2)
lines(Xfit3$mean,col=3)
lines(X)
legend("topleft", lty=1, col=c(4,2,3),
legend=c("Mean method","Naive method","Seasonal naive method"))
Y <- ts(c(347, 296, 566, 820, 919, 1379, 1379, 1159, 1132, 1119, 1238, 904, 512, 471, 744, 789, 943, 1341, 973, 1255, 1146, 1045),
start = c(2015, 1), frequency = 12)kable(Y)| 347 |
| 296 |
| 566 |
| 820 |
| 919 |
| 1379 |
| 1379 |
| 1159 |
| 1132 |
| 1119 |
| 1238 |
| 904 |
| 512 |
| 471 |
| 744 |
| 789 |
| 943 |
| 1341 |
| 973 |
| 1255 |
| 1146 |
| 1045 |
seasonplot(Y,ylab="Demand", xlab="Month",
main="Seasonal plot: SS02CLR7284 Demand",
year.labels=TRUE, year.labels.left=TRUE, col=1:20, pch=19)
monthplot(Y,ylab="Demand",xlab="Month",xaxt="n",
main="Seasonal deviation plot: Demand for SS02CLR7284")
ggseasonplot(Y, col =rainbow(12), year.labels=TRUE )
ggseasonplot(Y, year.labels=TRUE, continuous=TRUE)
ets(Y)## ETS(A,N,N)
##
## Call:
## ets(y = Y)
##
## Smoothing parameters:
## alpha = 0.9999
##
## Initial states:
## l = 337.3248
##
## sigma: 232.3382
##
## AIC AICc BIC
## 313.7235 315.0568 316.9966fit11 <- ets(Y)
fit22 <- ets(Y,model= "ANN")
deviance <- 2*c(logLik(fit11) - logLik(fit22))
df <- attributes(logLik(fit11))$df - attributes(logLik(fit22))$df
#P value
1-pchisq(deviance,df)## [1] 1exp <- ses(Y[1:17], 5, initial="simple")
exp_accuracy = accuracy(exp, Y[18:22])
exp; exp_accuracy## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 18 943 666.3776 1219.622 519.94252 1366.057
## 19 943 551.7968 1334.203 344.70637 1541.294
## 20 943 463.8759 1422.124 210.24295 1675.757
## 21 943 389.7552 1496.245 96.88503 1789.115
## 22 943 324.4535 1561.547 -2.98529 1888.985## ME RMSE MAE MPE MAPE MASE
## Training set 35.05882 215.8496 161.8824 1.716246 20.77187 0.9411765
## Test set 209.00000 248.2986 209.0000 17.019540 17.01954 1.2151163
## ACF1
## Training set 0.2966868
## Test set NAplot(exp, ylim=c(0,1400))
lines(Y[1:1400])
train = Y[1:17]
test = Y[18:22]
arma_fit <- auto.arima(train)
arma_forecast <- forecast(arma_fit, h = 5)
arma_fit_accuracy <- accuracy(arma_forecast, test)
arma_fit; arma_forecast; arma_fit_accuracy## Series: train
## ARIMA(2,0,0) with non-zero mean
##
## Coefficients:
## ar1 ar2 intercept
## 1.1491 -0.5084 872.9012
## s.e. 0.2021 0.2185 123.2241
##
## sigma^2 estimated as 40137: log likelihood=-113.31
## AIC=234.61 AICc=237.94 BIC=237.94## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 18 996.1135 739.3640 1252.863 603.4491 1388.778
## 19 978.8480 587.7350 1369.961 380.6923 1577.004
## 20 932.0024 488.7848 1375.220 254.1596 1609.845
## 21 886.9488 434.7682 1339.129 195.3983 1578.499
## 22 858.9942 406.8033 1311.185 167.4278 1550.561## ME RMSE MAE MPE MAPE MASE
## Training set 5.702761 181.8080 146.7547 -6.46192 21.34210 0.8532249
## Test set 221.418648 254.9565 223.7578 18.25177 18.49218 1.3009177
## ACF1
## Training set -0.0331735
## Test set NAplot(arma_forecast, ylim=c(0,1400))
lines(Y[1:22])
Yfit1 <- meanf(Y,h=3)
Yfit2 <- rwf(Y,h=3)
Yfit3 <- snaive(Y,h=3)
plot(Yfit1, plot.conf=FALSE,
main="Forecasts for SS02CLR7284")
lines(Yfit2$mean,col=2)
lines(Yfit3$mean,col=3)
lines(Y)
legend("topleft", lty=1, col=c(4,2,3),
legend=c("Mean method","Naive method","Seasonal naive method"))
accuracy(Yfit1)## ME RMSE MAE MPE MAPE MASE
## Training set 2.068263e-14 322.6724 267.2479 -20.52167 41.96595 2.225212
## ACF1
## Training set 0.6635529accuracy(Yfit2)## ME RMSE MAE MPE MAPE MASE
## Training set 33.2381 237.7956 190.9524 1.158479 22.0128 1.589945
## ACF1
## Training set 0.006426149accuracy(Yfit3)## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 10.3 164.9967 120.1 4.915171 16.02931 1 0.1083469ets(Y)## ETS(A,N,N)
##
## Call:
## ets(y = Y)
##
## Smoothing parameters:
## alpha = 0.9999
##
## Initial states:
## l = 337.3248
##
## sigma: 232.3382
##
## AIC AICc BIC
## 313.7235 315.0568 316.9966library(TTR)
plot.ts(X)
X1 <- SMA(X, n = 8)
plot.ts(X1)
ets(X)## ETS(M,N,N)
##
## Call:
## ets(y = X)
##
## Smoothing parameters:
## alpha = 0.9999
##
## Initial states:
## l = 238.8124
##
## sigma: 0.2017
##
## AIC AICc BIC
## 268.9734 270.3067 272.2465W <- ts(c(211, 253, 410, 449, 408, 450, 450, 441, 462, 470, 396, 468, 293, 415, 467, 402, 490, 598, 501, 380, 529, 439), start = c(2015, 1), frequency = 12)
kable(head(W))| 211 |
| 253 |
| 410 |
| 449 |
| 408 |
| 450 |
A <- ts(c(155, 142, 180, 181, 196, 216, 216, 235, 239, 205, 210, 171, 221, 169, 235, 182, 209, 239, 249, 385, 274, 217), start = c(2015, 1), frequency = 12)
kable(head(A))| 155 |
| 142 |
| 180 |
| 181 |
| 196 |
| 216 |
B <- ts(c(105, 199, 176, 180, 255, 264, 264, 244, 179, 271, 245, 162, 225, 125, 309, 130, 192, 230, 236, 323, 168, 192), start = c(2015, 1), frequency = 12)
kable(head(B))| 105 |
| 199 |
| 176 |
| 180 |
| 255 |
| 264 |
C <- ts(c(2008, 1520, 1695, 2076, 1725, 2184, 2184, 2591, 2627, 2590, 2975, 2349, 1926, 1870, 2327, 2273, 2418, 2596, 2578, 3146, 2656, 2386), start = c(2015, 1), frequency = 12)
kable(head(C))| 2008 |
| 1520 |
| 1695 |
| 2076 |
| 1725 |
| 2184 |
D <- ts(c(219, 179, 321, 389, 299, 488, 488, 449, 509, 499, 561, 466, 262, 337, 408, 437, 420, 704, 492, 726, 768, 519), start = c(2015, 1), frequency = 12)
kable(head(D))| 219 |
| 179 |
| 321 |
| 389 |
| 299 |
| 488 |
E <- ts(c(185, 218, 183, 281, 331, 434, 434, 428, 375, 473, 536, 333, 259, 193, 281, 299, 190, 292, 365, 522, 457, 398), start = c(2015, 1), frequency = 12)
kable(head(E))| 185 |
| 218 |
| 183 |
| 281 |
| 331 |
| 434 |