library(readxl)
library(TTR)
library(forecast)
## Warning: package 'forecast' was built under R version 4.5.1
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
#membuka file
suntik<-read_excel("D:/MAGANG BKKBN/DATA FIKS/SUNTIK.xlsx")
head(suntik)
## # A tibble: 6 × 2
## PERIODE SUNTIK
## <chr> <dbl>
## 1 2020M1 988
## 2 2020M2 1189
## 3 2020M3 1011
## 4 2020M4 1031
## 5 2020M5 1021
## 6 2020M6 1653
#membagi training dan testing
training<-suntik[1:52,2]
testing<-suntik[53:75,2] #data time series
suntik.ts<-ts(suntik$SUNTIK)
training.ts<-ts(training)
testing.ts<-ts(testing,start=61)
#eksplorasi data
plot(suntik.ts, col="red",main="Plot semua data")
points(suntik.ts)
plot(training.ts, col="blue",main="Plot semua data")
points(training.ts)
#Double Eksponensial Smoothing #Lamda=0.2 dan beta=0.2
des.1<- HoltWinters(training.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)
plot(des.1)
#ramalan
ramalandes1<- forecast(des.1, h=23)
ramalandes1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 53 672.5834 290.89710 1054.270 88.84458 1256.322
## 54 685.4063 292.88132 1077.931 85.09115 1285.721
## 55 698.2292 291.41533 1105.043 76.06108 1320.397
## 56 711.0521 286.29851 1135.806 61.44754 1360.657
## 57 723.8750 277.44883 1170.301 41.12510 1406.625
## 58 736.6979 264.88666 1208.509 15.12489 1458.271
## 59 749.5208 248.71110 1250.330 -16.40153 1515.443
## 60 762.3437 229.07448 1295.613 -53.22118 1577.909
## 61 775.1666 206.15944 1344.174 -95.05473 1645.388
## 62 787.9895 180.16074 1395.818 -141.60434 1717.583
## 63 800.8123 151.27240 1450.352 -192.57327 1794.198
## 64 813.6352 119.67956 1507.591 -247.67838 1874.949
## 65 826.4581 85.55398 1567.362 -306.65699 1959.573
## 66 839.2810 49.05208 1629.510 -369.26985 2047.832
## 67 852.1039 10.31468 1693.893 -435.30162 2139.509
## 68 864.9268 -30.53238 1760.386 -504.55983 2234.413
## 69 877.7497 -73.37705 1828.876 -576.87313 2332.373
## 70 890.5726 -118.11969 1899.265 -652.08913 2433.234
## 71 903.3955 -164.67166 1971.463 -730.07225 2536.863
## 72 916.2184 -212.95397 2045.391 -810.70171 2643.138
## 73 929.0413 -262.89608 2120.979 -893.86959 2751.952
## 74 941.8642 -314.43474 2198.163 -979.47920 2863.208
## 75 954.6871 -367.51310 2276.887 -1067.44359 2976.818
#Lamda=0.6 dan beta=0.3
des.2<- HoltWinters(training.ts, gamma = FALSE, beta = 0.3, alpha = 0.6)
plot(des.2)
#ramalan
ramalandes2<- forecast(des.2, h=23)
ramalandes2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 53 572.7905 330.01601 815.5650 201.49896 944.082
## 54 568.2251 260.33188 876.1183 97.34307 1039.107
## 55 563.6596 177.50317 949.8161 -26.91572 1154.235
## 56 559.0942 83.99997 1034.1884 -167.49973 1285.688
## 57 554.5288 -18.54246 1127.6000 -321.90805 1430.966
## 58 549.9633 -129.02445 1228.9511 -488.45887 1588.386
## 59 545.3979 -246.67225 1337.4680 -665.96886 1756.765
## 60 540.8325 -370.91424 1452.5792 -853.56379 1935.229
## 61 536.2670 -501.30922 1573.8433 -1050.56891 2123.103
## 62 531.7016 -637.50398 1700.9072 -1256.44403 2319.847
## 63 527.1362 -779.20718 1833.4795 -1470.74358 2525.016
## 64 522.5707 -926.17270 1971.3142 -1693.09114 2738.233
## 65 518.0053 -1078.18852 2114.1991 -1923.16248 2959.173
## 66 513.4399 -1235.06915 2261.9489 -2160.67390 3187.554
## 67 508.8744 -1396.65016 2414.3990 -2405.37395 3423.123
## 68 504.3090 -1562.78428 2571.4023 -2657.03737 3665.655
## 69 499.7436 -1733.33839 2732.8255 -2915.46056 3914.948
## 70 495.1781 -1908.19124 2898.5475 -3180.45813 4170.814
## 71 490.6127 -2087.23174 3068.4571 -3451.86015 4433.086
## 72 486.0473 -2270.35748 3242.4520 -3729.51000 4701.605
## 73 481.4818 -2457.47361 3420.4372 -4013.26263 4976.226
## 74 476.9164 -2648.49192 3602.3247 -4302.98313 5256.816
## 75 472.3510 -2843.33004 3788.0319 -4598.54554 5543.247
#Lamda dan beta optimum
des.opt<- HoltWinters(training.ts, gamma = FALSE)
des.opt
## Holt-Winters exponential smoothing with trend and without seasonal component.
##
## Call:
## HoltWinters(x = training.ts, gamma = FALSE)
##
## Smoothing parameters:
## alpha: 0.5843328
## beta : 0.3268309
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 577.363210
## b -5.373076
plot(des.opt)
#ramalan
ramalandesopt<- forecast(des.opt, h=23)
ramalandesopt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 53 571.9901 329.0760 814.9042 200.48509 943.4952
## 54 566.6171 259.2461 873.9881 96.53369 1036.7004
## 55 561.2440 174.4975 947.9905 -30.23373 1152.7217
## 56 555.8709 77.7503 1033.9915 -175.35146 1287.0933
## 57 550.4978 -29.0370 1130.0327 -335.82421 1436.8199
## 58 545.1248 -144.5571 1234.8066 -509.65263 1599.9021
## 59 539.7517 -267.9023 1347.4057 -695.44850 1774.9519
## 60 534.3786 -398.4111 1467.1683 -892.20010 1960.9573
## 61 529.0055 -535.5790 1593.5901 -1099.13603 2157.1471
## 62 523.6325 -679.0064 1726.2713 -1315.64497 2362.9099
## 63 518.2594 -828.3664 1864.8851 -1541.22696 2577.7457
## 64 512.8863 -983.3845 2009.1571 -1775.46247 2801.2351
## 65 507.5132 -1143.8260 2158.8524 -2017.99216 3033.0186
## 66 502.1401 -1309.4861 2313.7664 -2268.50304 3272.7833
## 67 496.7671 -1480.1840 2473.7182 -2526.71872 3520.2529
## 68 491.3940 -1655.7585 2638.5465 -2792.39239 3775.1804
## 69 486.0209 -1836.0640 2808.1059 -3065.30156 4037.3434
## 70 480.6478 -2020.9684 2982.2641 -3345.24408 4306.5398
## 71 475.2748 -2210.3507 3160.9003 -3632.03500 4582.5845
## 72 469.9017 -2404.0997 3343.9031 -3925.50415 4865.3075
## 73 464.5286 -2602.1124 3531.1697 -4225.49416 5154.5514
## 74 459.1555 -2804.2933 3722.6044 -4531.85883 5450.1699
## 75 453.7825 -3010.5533 3918.1182 -4844.46183 5752.0268
#Ukuran Keakuratan Ramalan Data Training
ssedes.train1<-des.1$SSE
sisaandes1<-ramalandes1$residuals
head(sisaandes1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## x
## [1,] NA
## [2,] NA
## [3,] -379.0000
## [4,] -469.0400
## [5,] -552.3104
## [6,] 45.1657
msedes.train1<-ssedes.train1/length(training.ts)
mapedes.train1 <- sum(abs(sisaandes1[3:length(training.ts)] / training.ts[3:length(training.ts)]) * 100) / length(training.ts)
ssedes.train2<-des.2$SSE
msedes.train2<-ssedes.train2/length(training.ts)
sisaandes2<-ramalandes2$residuals
head(sisaandes2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## x
## [1,] NA
## [2,] NA
## [3,] -379.0000
## [4,] -264.3800
## [5,] -200.9436
## [6,] 502.6008
mapedes.train2<-sum(abs(sisaandes2[3:length(training.ts)]/training.ts[3:length(training.ts)])*100)/length(training.ts)
ssedes.trainopt<-des.opt$SSE
msedes.trainopt<-ssedes.trainopt/length(training.ts)
sisaandesopt<-ramalandesopt$residuals
head(sisaandesopt)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## x
## [1,] NA
## [2,] NA
## [3,] -379.0000
## [4,] -266.1572
## [5,] -198.4219
## [6,] 509.6276
mapedes.trainopt<-sum(abs(sisaandesopt[3:length(training.ts)]/training.ts[3:length(training.ts)])*100)/length(training.ts)
#Perbandingan Ukuran Keakuratan Ramalan Data Training
akurasi.4 <- data.frame(
"Perbandingan Ukuran Keakuratan" = c("SSE", "MSE", "MAPE"),
"Double Exponential Smoothing 1" = c(ssedes.train1, msedes.train1, mapedes.train1), "Double Exponential Smoothing 2" = c(ssedes.train2, msedes.train2, mapedes.train2),"Double Exponential Smoothing Opt" = c(ssedes.trainopt, msedes.trainopt, mapedes.trainopt))
akurasi.4
## Perbandingan.Ukuran.Keakuratan Double.Exponential.Smoothing.1
## 1 SSE 4.789107e+06
## 2 MSE 9.209821e+04
## 3 MAPE 3.277663e+01
## Double.Exponential.Smoothing.2 Double.Exponential.Smoothing.Opt
## 1 1.784535e+06 1.783827e+06
## 2 3.431797e+04 3.430437e+04
## 3 1.877983e+01 1.893564e+01
#Akurasi Data Testing
selisihdes1<-ramalandes1$mean-testing.ts
selisihdes1
## Time Series:
## Start = 61
## End = 75
## Frequency = 1
## testing.ts
## [1,] 213.1666
## [2,] 161.9895
## [3,] 131.8123
## [4,] 293.6352
## [5,] 353.4581
## [6,] 313.2810
## [7,] 343.1039
## [8,] 228.9268
## [9,] 274.7497
## [10,] 412.5726
## [11,] 466.3955
## [12,] 469.2184
## [13,] 502.0413
## [14,] 488.8642
## [15,] 572.6871
SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(testing.ts)
MAPEtestingdes1<-sum(abs(selisihdes1/testing.ts)*100)/length(testing.ts)
#Akurasi Data Testing
selisihdes2<-ramalandes2$mean-testing.ts
selisihdes2
## Time Series:
## Start = 61
## End = 75
## Frequency = 1
## testing.ts
## [1,] -25.7329701
## [2,] -94.2984042
## [3,] -141.8638383
## [4,] 2.5707276
## [5,] 45.0052935
## [6,] -12.5601406
## [7,] -0.1255747
## [8,] -131.6910088
## [9,] -103.2564429
## [10,] 17.1781230
## [11,] 53.6126889
## [12,] 39.0472548
## [13,] 54.4818207
## [14,] 23.9163866
## [15,] 90.3509525
SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(testing.ts)
MAPEtestingdes2<-sum(abs(selisihdes2/testing.ts)*100)/length(testing.ts)
#Akurasi Data Testing
selisihdesopt<-ramalandesopt$mean-testing.ts
selisihdesopt
## Time Series:
## Start = 61
## End = 75
## Frequency = 1
## testing.ts
## [1,] -32.994474
## [2,] -102.367550
## [3,] -150.740625
## [4,] -7.113701
## [5,] 34.513223
## [6,] -23.859853
## [7,] -12.232929
## [8,] -144.606005
## [9,] -116.979081
## [10,] 2.647843
## [11,] 38.274767
## [12,] 22.901691
## [13,] 37.528615
## [14,] 6.155539
## [15,] 71.782464
SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(testing.ts)
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing.ts)*100)/length(testing.ts)
#Perbandingan Ukuran Keakuratan Ramalan Data Testing
akurasi.5 <- data.frame(
"Perbandingan Ukuran Keakuratan" = c("SSE", "MSE", "MAPE"),
"Double Exponential Smoothing 1" = c(SSEtestingdes1, MSEtestingdes1, MAPEtestingdes1), "Double Exponential Smoothing 2" = c(SSEtestingdes2, MSEtestingdes2, MAPEtestingdes2),"Double Exponential Smoothing Opt" = c(SSEtestingdesopt, MSEtestingdesopt, MAPEtestingdesopt))
akurasi.5
## Perbandingan.Ukuran.Keakuratan Double.Exponential.Smoothing.1
## 1 SSE 2.070880e+06
## 2 MSE 9.003828e+04
## 3 MAPE 4.768038e+01
## Double.Exponential.Smoothing.2 Double.Exponential.Smoothing.Opt
## 1 76271.64960 79441.659232
## 2 3316.15868 3453.985184
## 3 6.84295 6.342219
# Forecast 9 bulan ke depan (model terbaik: DES optimum)
des_final <- HoltWinters(suntik.ts, gamma = FALSE)
forecast_des_final <- forecast(des_final, h = 9)
forecast_des_final
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 76 236.7531 27.48297 446.0232 -83.29793 556.8041
## 77 223.7122 -39.80563 487.2300 -179.30352 626.7279
## 78 210.6713 -118.40076 539.7433 -292.60098 713.9435
## 79 197.6304 -206.18204 601.4428 -419.94742 815.2082
## 80 184.5895 -301.72315 670.9021 -559.16151 928.3405
## 81 171.5486 -404.05988 747.1570 -708.76858 1051.8657
## 82 158.5077 -512.51392 829.5293 -867.73129 1184.7466
## 83 145.4668 -626.58555 917.5191 -1035.28537 1326.2189
## 84 132.4259 -745.89053 1010.7423 -1210.84315 1475.6949
plot(forecast_des_final)
