library("forecast")
## Warning: package 'forecast' was built under R version 4.3.3
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library("graphics")
library("TTR")
## Warning: package 'TTR' was built under R version 4.3.3
library("TSA")
## Warning: package 'TSA' was built under R version 4.3.3
## Registered S3 methods overwritten by 'TSA':
## method from
## fitted.Arima forecast
## plot.Arima forecast
##
## Attaching package: 'TSA'
## The following objects are masked from 'package:stats':
##
## acf, arima
## The following object is masked from 'package:utils':
##
## tar
library(readxl)
## Warning: package 'readxl' was built under R version 4.3.3
mpdw <- read_xlsx("D:/Semester 5/MPDW/Praktikum/Tugas/Data Tugas Pertemuan 1_ Ria Yunita_G140122115.xlsx")
mpdw
## # A tibble: 107 × 2
## Periode Penumpang
## <dbl> <dbl>
## 1 1 3500
## 2 2 2684
## 3 3 5162
## 4 4 6268
## 5 5 4841
## 6 6 5983
## 7 7 6349
## 8 8 4135
## 9 9 3014
## 10 10 3379
## # ℹ 97 more rows
str(mpdw)
## tibble [107 × 2] (S3: tbl_df/tbl/data.frame)
## $ Periode : num [1:107] 1 2 3 4 5 6 7 8 9 10 ...
## $ Penumpang: num [1:107] 3500 2684 5162 6268 4841 ...
dim(mpdw)
## [1] 107 2
Mengubah data agar terbaca sebagai data deret waktu dengan fungsi
ts() .
data.ts <- ts(mpdw$Penumpang)
summary(data.ts)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1673 2849 3355 3543 4065 6423
Membuat plot data deret waktu
ts.plot(data.ts, xlab="Periode waktu ", ylab="Jumlah penumpang",
main = "Time Series Plot")
points(data.ts)
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
#membagi data latih dan data uji
training_ma <- mpdw[1:86,]
testing_ma <- mpdw[87:107,]
train_ma.ts <- ts(training_ma$Penumpang)
test_ma.ts <- ts(testing_ma$Penumpang)
Eksplorasi data pada keseluruhan data, data latih serta data uji menggunakan plot data deret waktu.
#eksplorasi keseluruhan data
plot(data.ts, col="purple",main="Plot semua data")
points(data.ts)
#eksplorasi data latih
plot(train_ma.ts, col="darkgreen",main="Plot data latih")
points(train_ma.ts)
#eksplorasi data uji
plot(test_ma.ts, col="darkgreen",main="Plot data uji")
points(test_ma.ts)
Berdasarkan plot data deret waktu pada data latih diatas, dapat dilihat bahwa data cenderung memiliki pola yang naik turun dan tidak bergerak pada nilai tengah tertentu sehingga hal ini mengindikasikan bahwa data tidak stasioner.
#Eksplorasi dengan GGPLOT
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.2
ggplot() +
geom_line(data = training_ma, aes(x = Periode, y = Penumpang, col = "Data Latih")) +
geom_line(data = testing_ma, aes(x = Periode, y = Penumpang, col = "Data Uji")) +
labs(x = "Periode Waktu", y = "Jumlah Penumpang", color = "Legend") +
scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
values = c("blue", "red")) +
theme_bw() + theme(legend.position = "bottom",
plot.caption = element_text(hjust=0.5, size=12))
Pemulusan SMA dengan nilai paramter n=4
data.sma<-SMA(train_ma.ts, n=4)
data.sma
## Time Series:
## Start = 1
## End = 86
## Frequency = 1
## [1] NA NA NA 4403.50 4738.75 5563.50 5860.25 5327.00 4870.25
## [10] 4219.25 3537.50 3663.50 3829.50 4178.00 4044.75 3593.25 4058.25 4447.75
## [19] 4888.75 5706.75 5928.00 5418.25 4911.50 4123.25 3274.25 3312.00 3325.25
## [28] 3483.00 3462.75 2998.00 2771.50 2592.00 2654.75 2895.00 3313.50 3329.25
## [37] 3065.75 2991.00 2758.50 3081.75 3868.00 3719.50 3996.75 4296.25 3892.25
## [46] 3964.75 4189.00 4016.00 4459.00 4701.50 4387.75 4038.50 3554.00 3716.50
## [55] 3960.00 4406.00 4461.25 4060.75 3948.75 3527.50 3559.75 3821.50 3800.25
## [64] 3896.00 3896.50 3741.75 3486.25 3360.75 3151.75 3223.75 3087.50 2897.25
## [73] 2634.50 2345.00 2598.25 2561.25 2892.00 2793.25 2518.25 2493.75 2513.25
## [82] 2900.25 3126.50 3563.75 3476.50 3167.00
Data pemulusan pada periode ke-t selanjutnya digunakan sebagai nilai peramalan pada periode ke t+1 sehingga hasil peramalan 1 periode kedepan adalah sebagai berikut.
data.ramal<-c(NA,data.sma)
data.ramal #forecast 1 periode ke depan
## [1] NA NA NA NA 4403.50 4738.75 5563.50 5860.25 5327.00
## [10] 4870.25 4219.25 3537.50 3663.50 3829.50 4178.00 4044.75 3593.25 4058.25
## [19] 4447.75 4888.75 5706.75 5928.00 5418.25 4911.50 4123.25 3274.25 3312.00
## [28] 3325.25 3483.00 3462.75 2998.00 2771.50 2592.00 2654.75 2895.00 3313.50
## [37] 3329.25 3065.75 2991.00 2758.50 3081.75 3868.00 3719.50 3996.75 4296.25
## [46] 3892.25 3964.75 4189.00 4016.00 4459.00 4701.50 4387.75 4038.50 3554.00
## [55] 3716.50 3960.00 4406.00 4461.25 4060.75 3948.75 3527.50 3559.75 3821.50
## [64] 3800.25 3896.00 3896.50 3741.75 3486.25 3360.75 3151.75 3223.75 3087.50
## [73] 2897.25 2634.50 2345.00 2598.25 2561.25 2892.00 2793.25 2518.25 2493.75
## [82] 2513.25 2900.25 3126.50 3563.75 3476.50 3167.00
Setelah itu, dilakukan peramalan terhadap 21 periode data uji
data.gab<-cbind(aktual=c(train_ma.ts,rep(NA,21)),pemulusan=c(data.sma,rep(NA,21)),ramalan=c(data.ramal,rep(data.ramal[length(data.ramal)],20)))
data.gab
## aktual pemulusan ramalan
## [1,] 3500 NA NA
## [2,] 2684 NA NA
## [3,] 5162 NA NA
## [4,] 6268 4403.50 NA
## [5,] 4841 4738.75 4403.50
## [6,] 5983 5563.50 4738.75
## [7,] 6349 5860.25 5563.50
## [8,] 4135 5327.00 5860.25
## [9,] 3014 4870.25 5327.00
## [10,] 3379 4219.25 4870.25
## [11,] 3622 3537.50 4219.25
## [12,] 4639 3663.50 3537.50
## [13,] 3678 3829.50 3663.50
## [14,] 4773 4178.00 3829.50
## [15,] 3089 4044.75 4178.00
## [16,] 2833 3593.25 4044.75
## [17,] 5538 4058.25 3593.25
## [18,] 6331 4447.75 4058.25
## [19,] 4853 4888.75 4447.75
## [20,] 6105 5706.75 4888.75
## [21,] 6423 5928.00 5706.75
## [22,] 4292 5418.25 5928.00
## [23,] 2826 4911.50 5418.25
## [24,] 2952 4123.25 4911.50
## [25,] 3027 3274.25 4123.25
## [26,] 4443 3312.00 3274.25
## [27,] 2879 3325.25 3312.00
## [28,] 3583 3483.00 3325.25
## [29,] 2946 3462.75 3483.00
## [30,] 2584 2998.00 3462.75
## [31,] 1973 2771.50 2998.00
## [32,] 2865 2592.00 2771.50
## [33,] 3197 2654.75 2592.00
## [34,] 3545 2895.00 2654.75
## [35,] 3647 3313.50 2895.00
## [36,] 2928 3329.25 3313.50
## [37,] 2143 3065.75 3329.25
## [38,] 3246 2991.00 3065.75
## [39,] 2717 2758.50 2991.00
## [40,] 4221 3081.75 2758.50
## [41,] 5288 3868.00 3081.75
## [42,] 2652 3719.50 3868.00
## [43,] 3826 3996.75 3719.50
## [44,] 5419 4296.25 3996.75
## [45,] 3672 3892.25 4296.25
## [46,] 2942 3964.75 3892.25
## [47,] 4723 4189.00 3964.75
## [48,] 4727 4016.00 4189.00
## [49,] 5444 4459.00 4016.00
## [50,] 3912 4701.50 4459.00
## [51,] 3468 4387.75 4701.50
## [52,] 3330 4038.50 4387.75
## [53,] 3506 3554.00 4038.50
## [54,] 4562 3716.50 3554.00
## [55,] 4442 3960.00 3716.50
## [56,] 5114 4406.00 3960.00
## [57,] 3727 4461.25 4406.00
## [58,] 2960 4060.75 4461.25
## [59,] 3994 3948.75 4060.75
## [60,] 3429 3527.50 3948.75
## [61,] 3856 3559.75 3527.50
## [62,] 4007 3821.50 3559.75
## [63,] 3909 3800.25 3821.50
## [64,] 3812 3896.00 3800.25
## [65,] 3858 3896.50 3896.00
## [66,] 3388 3741.75 3896.50
## [67,] 2887 3486.25 3741.75
## [68,] 3310 3360.75 3486.25
## [69,] 3022 3151.75 3360.75
## [70,] 3676 3223.75 3151.75
## [71,] 2342 3087.50 3223.75
## [72,] 2549 2897.25 3087.50
## [73,] 1971 2634.50 2897.25
## [74,] 2518 2345.00 2634.50
## [75,] 3355 2598.25 2345.00
## [76,] 2401 2561.25 2598.25
## [77,] 3294 2892.00 2561.25
## [78,] 2123 2793.25 2892.00
## [79,] 2255 2518.25 2793.25
## [80,] 2303 2493.75 2518.25
## [81,] 3372 2513.25 2493.75
## [82,] 3671 2900.25 2513.25
## [83,] 3160 3126.50 2900.25
## [84,] 4052 3563.75 3126.50
## [85,] 3023 3476.50 3563.75
## [86,] 2433 3167.00 3476.50
## [87,] NA NA 3167.00
## [88,] NA NA 3167.00
## [89,] NA NA 3167.00
## [90,] NA NA 3167.00
## [91,] NA NA 3167.00
## [92,] NA NA 3167.00
## [93,] NA NA 3167.00
## [94,] NA NA 3167.00
## [95,] NA NA 3167.00
## [96,] NA NA 3167.00
## [97,] NA NA 3167.00
## [98,] NA NA 3167.00
## [99,] NA NA 3167.00
## [100,] NA NA 3167.00
## [101,] NA NA 3167.00
## [102,] NA NA 3167.00
## [103,] NA NA 3167.00
## [104,] NA NA 3167.00
## [105,] NA NA 3167.00
## [106,] NA NA 3167.00
## [107,] NA NA 3167.00
ts.plot(data.ts, xlab="Time Periode ", ylab="Penumpang", main= "SMA N=4 Data Penumpang")
points(data.ts)
lines(data.gab[,2],col="green",lwd=2)
lines(data.gab[,3],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.5)
#Menghitung nilai keakuratan data latih
error_train.sma = train_ma.ts-data.ramal[1:length(train_ma.ts)]
SSE_train.sma = sum(error_train.sma[5:length(train_ma.ts)]^2)
MSE_train.sma = mean(error_train.sma[5:length(train_ma.ts)]^2)
MAPE_train.sma = mean(abs((error_train.sma[5:length(train_ma.ts)]/train_ma.ts[5:length(train_ma.ts)])*100))
akurasi_train.sma <- matrix(c(SSE_train.sma, MSE_train.sma, MAPE_train.sma))
row.names(akurasi_train.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.sma) <- c("Akurasi m = 4")
akurasi_train.sma
## Akurasi m = 4
## SSE 8.509888e+07
## MSE 1.037791e+06
## MAPE 2.410772e+01
Berdasarkan hasil akurasi nilai MAPE data latih pada metode pemulusan SMA sebesar 24,1%, nilai ini tidak dapat dikategorikan sebagai nilai akurasi yang sangat baik dikarenakan nilainya melebihi batas MAPE kategori sangat baik yaitu 10%, tetapi nilai MAPE 24,1% ini tergolong dalam nilai yang cukup baik. Selanjutnya dilakukan perhitungan nilai MAPE data uji pada metde pemulusan SMA.
#Menghitung nilai keakuratan data uji
error_test.sma = test_ma.ts-data.gab[87:107,3]
SSE_test.sma = sum(error_test.sma^2)
MSE_test.sma = mean(error_test.sma^2)
MAPE_test.sma = mean(abs((error_test.sma/test_ma.ts*100)))
akurasi_test.sma <- matrix(c(SSE_test.sma, MSE_test.sma, MAPE_test.sma))
row.names(akurasi_test.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.sma) <- c("Akurasi m = 4")
akurasi_test.sma
## Akurasi m = 4
## SSE 1.167432e+07
## MSE 5.559200e+05
## MAPE 2.489396e+01
Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE yang lebih dari 20% sehingga nilai akurasi ini dapat dikategorikan sebagai cukup baik, tetapi mmasih dapat dicari model lain yang MAPE nya kurang dari 10% sehingga model SMA ini kurang cocok digunakan.
Metode pemulusan Double Moving Average (DMA) pada dasarnya mirip dengan SMA. Namun demikian, metode ini lebih cocok digunakan untuk pola data trend. Proses pemulusan dengan rata rata dalam metode ini dilakukan sebanyak 2 kali.
dma <- SMA(data.sma, n = 4)
At <- 2*data.sma - dma
Bt <- 2/(4-1)*(data.sma - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)
t = 1:21
f = c()
for (i in t) {
f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}
data.gab2 <- cbind(aktual = c(train_ma.ts,rep(NA,21)), pemulusan1 = c(data.sma,rep(NA,21)),pemulusan2 = c(data.dma, rep(NA,21)),At = c(At, rep(NA,21)), Bt = c(Bt,rep(NA,21)),ramalan = c(data.ramal2, f[-1]))
data.gab2
## aktual pemulusan1 pemulusan2 At Bt ramalan
## [1,] 3500 NA NA NA NA NA
## [2,] 2684 NA NA NA NA NA
## [3,] 5162 NA NA NA NA NA
## [4,] 6268 4403.50 NA NA NA NA
## [5,] 4841 4738.75 NA NA NA NA
## [6,] 5983 5563.50 NA NA NA NA
## [7,] 6349 5860.25 7058.167 6579.000 479.1666667 NA
## [8,] 4135 5327.00 5251.375 5281.625 -30.2500000 7058.1667
## [9,] 3014 4870.25 3978.583 4335.250 -356.6666667 5251.3750
## [10,] 3379 4219.25 2802.688 3369.312 -566.6250000 3978.5833
## [11,] 3622 3537.50 1952.500 2586.500 -634.0000000 2802.6875
## [12,] 4639 3663.50 2981.625 3254.375 -272.7500000 1952.5000
## [13,] 3678 3829.50 3857.938 3846.562 11.3750000 2981.6250
## [14,] 4773 4178.00 4804.458 4553.875 250.5833333 3857.9375
## [15,] 3089 4044.75 4237.771 4160.562 77.2083333 4804.4583
## [16,] 2833 3593.25 3063.042 3275.125 -212.0833333 4237.7708
## [17,] 5538 4058.25 4207.729 4147.938 59.7916667 3063.0417
## [18,] 6331 4447.75 5134.000 4859.500 274.5000000 4207.7292
## [19,] 4853 4888.75 5958.333 5530.500 427.8333333 5134.0000
## [20,] 6105 5706.75 7259.042 6638.125 620.9166667 5958.3333
## [21,] 6423 5928.00 7069.979 6613.188 456.7916667 7259.0417
## [22,] 4292 5418.25 5306.271 5351.062 -44.7916667 7069.9792
## [23,] 2826 4911.50 3945.458 4331.875 -386.4166667 5306.2708
## [24,] 2952 4123.25 2503.250 3151.250 -648.0000000 3945.4583
## [25,] 3027 3274.25 1344.979 2116.688 -771.7083333 2503.2500
## [26,] 4443 3312.00 2323.250 2718.750 -395.5000000 1344.9792
## [27,] 2879 3325.25 3019.521 3141.812 -122.2916667 2323.2500
## [28,] 3583 3483.00 3706.958 3617.375 89.5833333 3019.5208
## [29,] 2946 3462.75 3574.417 3529.750 44.6666667 3706.9583
## [30,] 2584 2998.00 2465.917 2678.750 -212.8333333 3574.4167
## [31,] 1973 2771.50 2092.646 2364.188 -271.5416667 2465.9167
## [32,] 2865 2592.00 1985.229 2227.938 -242.7083333 2092.6458
## [33,] 3197 2654.75 2489.229 2555.438 -66.2083333 1985.2292
## [34,] 3545 2895.00 3172.812 3061.688 111.1250000 2489.2292
## [35,] 3647 3313.50 4062.979 3763.188 299.7916667 3172.8125
## [36,] 2928 3329.25 3797.792 3610.375 187.4166667 4062.9792
## [37,] 2143 3065.75 2923.875 2980.625 -56.7500000 3797.7917
## [38,] 3246 2991.00 2684.542 2807.125 -122.5833333 2923.8750
## [39,] 2717 2758.50 2295.792 2480.875 -185.0833333 2684.5417
## [40,] 4221 3081.75 3260.917 3189.250 71.6666667 2295.7917
## [41,] 5288 3868.00 5023.312 4561.188 462.1250000 3260.9167
## [42,] 2652 3719.50 4323.771 4082.062 241.7083333 5023.3125
## [43,] 3826 3996.75 4547.167 4327.000 220.1666667 4323.7708
## [44,] 5419 4296.25 4839.792 4622.375 217.4166667 4547.1667
## [45,] 3672 3892.25 3752.354 3808.312 -55.9583333 4839.7917
## [46,] 2942 3964.75 3843.500 3892.000 -48.5000000 3752.3542
## [47,] 4723 4189.00 4361.396 4292.438 68.9583333 3843.5000
## [48,] 4727 4016.00 4016.833 4016.500 0.3333333 4361.3958
## [49,] 5444 4459.00 4962.021 4760.812 201.2083333 4016.8333
## [50,] 3912 4701.50 5301.708 5061.625 240.0833333 4962.0208
## [51,] 3468 4387.75 4382.229 4384.438 -2.2083333 5301.7083
## [52,] 3330 4038.50 3441.521 3680.312 -238.7916667 4382.2292
## [53,] 3506 3554.00 2526.604 2937.562 -410.9583333 3441.5208
## [54,] 4562 3716.50 3370.354 3508.812 -138.4583333 2526.6042
## [55,] 4442 3960.00 4197.917 4102.750 95.1666667 3370.3542
## [56,] 5114 4406.00 5234.125 4902.875 331.2500000 4197.9167
## [57,] 3727 4461.25 5003.438 4786.562 216.8750000 5234.1250
## [58,] 2960 4060.75 3792.000 3899.500 -107.5000000 5003.4375
## [59,] 3994 3948.75 3498.021 3678.312 -180.2916667 3792.0000
## [60,] 3429 3527.50 2740.729 3055.438 -314.7083333 3498.0208
## [61,] 3856 3559.75 3202.354 3345.312 -142.9583333 2740.7292
## [62,] 4007 3821.50 4000.042 3928.625 71.4166667 3202.3542
## [63,] 3909 3800.25 4005.250 3923.250 82.0000000 4000.0417
## [64,] 3812 3896.00 4107.042 4022.625 84.4166667 4005.2500
## [65,] 3858 3896.50 3968.062 3939.438 28.6250000 4107.0417
## [66,] 3388 3741.75 3588.625 3649.875 -61.2500000 3968.0625
## [67,] 2887 3486.25 3038.125 3217.375 -179.2500000 3588.6250
## [68,] 3310 3360.75 2926.479 3100.188 -173.7083333 3038.1250
## [69,] 3022 3151.75 2679.458 2868.375 -188.9166667 2926.4792
## [70,] 3676 3223.75 3087.292 3141.875 -54.5833333 2679.4583
## [71,] 2342 3087.50 2890.104 2969.062 -78.9583333 3087.2917
## [72,] 2549 2897.25 2575.896 2704.438 -128.5416667 2890.1042
## [73,] 1971 2634.50 2090.750 2308.250 -217.5000000 2575.8958
## [74,] 2518 2345.00 1684.896 1948.938 -264.0416667 2090.7500
## [75,] 3355 2598.25 2564.083 2577.750 -13.6666667 1684.8958
## [76,] 2401 2561.25 2605.417 2587.750 17.6666667 2564.0833
## [77,] 3294 2892.00 3380.125 3184.875 195.2500000 2605.4167
## [78,] 2123 2793.25 2930.021 2875.312 54.7083333 3380.1250
## [79,] 2255 2518.25 2230.021 2345.312 -115.2916667 2930.0208
## [80,] 2303 2493.75 2192.812 2313.188 -120.3750000 2230.0208
## [81,] 3372 2513.25 2402.625 2446.875 -44.2500000 2192.8125
## [82,] 3671 2900.25 3390.042 3194.125 195.9166667 2402.6250
## [83,] 3160 3126.50 3739.938 3494.562 245.3750000 3390.0417
## [84,] 4052 3563.75 4460.104 4101.562 358.5416667 3739.9375
## [85,] 3023 3476.50 3826.083 3686.250 139.8333333 4460.1042
## [86,] 2433 3167.00 2889.604 3000.562 -110.9583333 3826.0833
## [87,] NA NA NA NA NA 2889.6042
## [88,] NA NA NA NA NA 2778.6458
## [89,] NA NA NA NA NA 2667.6875
## [90,] NA NA NA NA NA 2556.7292
## [91,] NA NA NA NA NA 2445.7708
## [92,] NA NA NA NA NA 2334.8125
## [93,] NA NA NA NA NA 2223.8542
## [94,] NA NA NA NA NA 2112.8958
## [95,] NA NA NA NA NA 2001.9375
## [96,] NA NA NA NA NA 1890.9792
## [97,] NA NA NA NA NA 1780.0208
## [98,] NA NA NA NA NA 1669.0625
## [99,] NA NA NA NA NA 1558.1042
## [100,] NA NA NA NA NA 1447.1458
## [101,] NA NA NA NA NA 1336.1875
## [102,] NA NA NA NA NA 1225.2292
## [103,] NA NA NA NA NA 1114.2708
## [104,] NA NA NA NA NA 1003.3125
## [105,] NA NA NA NA NA 892.3542
## [106,] NA NA NA NA NA 781.3958
## [107,] NA NA NA NA NA 670.4375
Hasil pemulusan menggunakan metode DMA divisualisasikan sebagai berikut
ts.plot(data.ts, xlab="Time Periode", ylab="Penumpang", main= "DMA N=4 Data Sales")
points(data.ts)
lines(data.gab2[,3],col="green",lwd=2)
lines(data.gab2[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.8)
#Menghitung nilai keakuratan data latih
error_train.dma = train_ma.ts-data.ramal2[1:length(train_ma.ts)]
SSE_train.dma = sum(error_train.dma[8:length(train_ma.ts)]^2)
MSE_train.dma = mean(error_train.dma[8:length(train_ma.ts)]^2)
MAPE_train.dma = mean(abs((error_train.dma[8:length(train_ma.ts)]/train_ma.ts[8:length(train_ma.ts)])*100))
akurasi_train.dma <- matrix(c(SSE_train.dma, MSE_train.dma, MAPE_train.dma))
row.names(akurasi_train.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.dma) <- c("Akurasi m = 4")
akurasi_train.dma
## Akurasi m = 4
## SSE 1.293847e+08
## MSE 1.637781e+06
## MAPE 2.966339e+01
Nilai MAPE pada data latih diatas sebesar 29,6% sehingga dapat dikategorikan cukup baik. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.
#Menghitung nilai keakuratan data uji
error_test.dma = test_ma.ts-data.gab2[87:107,6]
SSE_test.dma = sum(error_test.dma^2)
MSE_test.dma = mean(error_test.dma^2)
MAPE_test.dma = mean(abs((error_test.dma/test_ma.ts*100)))
akurasi_test.dma <- matrix(c(SSE_test.dma, MSE_test.dma, MAPE_test.dma))
row.names(akurasi_test.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.dma) <- c("Akurasi m = 4")
akurasi_test.dma
## Akurasi m = 4
## SSE 3.933545e+07
## MSE 1.873117e+06
## MAPE 3.667622e+01
Perhitungan akurasi menggunakan data uji menghasilkan nilai MAPE yang lebih dari 20% (36,67%) sehingga nilai akurasi ini dapat dikategorikan sebagai cukup baik.
Pada datah latih dan data uji diatas, metode SMA lebih baik daripada DMA karena memiliki nilai MAPE yang lebih kecil walaupun kedua nya sama sama masuk kedalam kategori yang cukup baik. Selain itu, nilai MSE dan SSE data latih dan data uji pada SMA lebih kecil dari DMA, sehinggga hal ini juga yang menjadi alasan bahwa metode SMA lebih baik dari DMA. Namun untuk kedua uji tersebut dihasilkan nilai MAPE yang lebih dari 20% sehingga dapat dikatakan bahwa metode SMA maupun DMA kurang cocok digunakan untuk data tersebut karena masih dapat dicari nilai MAPE yang lebih kecil dengan metode lain.
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
#membagi training dan testing
training<-mpdw[1:86,]
testing<-mpdw[87:107,]
train.ts <- ts(training$Penumpang)
test.ts <- ts(testing$Penumpang)
Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.
#eksplorasi data
plot(data.ts, col="black",main="Plot semua data")
points(data.ts)
plot(train.ts, col="red",main="Plot data latih")
points(train.ts)
plot(test.ts, col="blue",main="Plot data uji")
points(test.ts)
Eksplorasi data juga dapat dilakukan menggunakan package
ggplot2 .
#Eksplorasi dengan GGPLOT
library(ggplot2)
ggplot() +
geom_line(data = training, aes(x = Periode, y = Penumpang, col = "Data Latih")) +
geom_line(data = testing, aes(x = Periode, y = Penumpang, col = "Data Uji")) +
labs(x = "Periode Waktu", y = "Jumlah Penumpang Datang", color = "Legend") +
scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
values = c("blue", "red")) +
theme_bw() + theme(legend.position = "bottom",
plot.caption = element_text(hjust=0.5, size=12))
#Cara 1 (fungsi ses)
ses.1 <- ses(train.ts, h = 21, alpha = 0.2)
plot(ses.1)
ses.1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 3011.63 1729.390 4293.871 1050.6124 4972.648
## 88 3011.63 1703.996 4319.264 1011.7765 5011.484
## 89 3011.63 1679.087 4344.174 973.6807 5049.580
## 90 3011.63 1654.634 4368.626 936.2840 5086.976
## 91 3011.63 1630.615 4392.646 899.5493 5123.711
## 92 3011.63 1607.006 4416.254 863.4428 5159.817
## 93 3011.63 1583.787 4439.473 827.9332 5195.327
## 94 3011.63 1560.940 4462.320 792.9918 5230.268
## 95 3011.63 1538.448 4484.812 758.5922 5264.668
## 96 3011.63 1516.293 4506.967 724.7101 5298.550
## 97 3011.63 1494.463 4528.798 691.3226 5331.938
## 98 3011.63 1472.941 4550.319 658.4088 5364.851
## 99 3011.63 1451.717 4571.543 625.9490 5397.311
## 100 3011.63 1430.778 4592.483 593.9250 5429.335
## 101 3011.63 1410.112 4613.148 562.3197 5460.941
## 102 3011.63 1389.710 4633.550 531.1170 5492.143
## 103 3011.63 1369.561 4653.699 500.3020 5522.958
## 104 3011.63 1349.656 4673.604 469.8606 5553.400
## 105 3011.63 1329.987 4693.273 439.7794 5583.481
## 106 3011.63 1310.546 4712.715 410.0461 5613.214
## 107 3011.63 1291.324 4731.936 380.6487 5642.612
ses.2<- ses(train.ts, h = 21, alpha = 0.7)
plot(ses.2)
ses.2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 2681.159 1395.1601 3967.158 714.39346 4647.925
## 88 2681.159 1111.3973 4250.921 280.41570 5081.902
## 89 2681.159 871.5982 4490.720 -86.32544 5448.644
## 90 2681.159 660.0531 4702.265 -409.85569 5772.174
## 91 2681.159 468.6429 4893.675 -702.59240 6064.910
## 92 2681.159 292.5221 5069.796 -971.94588 6334.264
## 93 2681.159 128.5241 5233.794 -1222.75916 6585.077
## 94 2681.159 -25.5555 5387.874 -1458.40362 6820.722
## 95 2681.159 -171.3245 5533.643 -1681.33804 7043.656
## 96 2681.159 -309.9981 5672.316 -1893.42100 7255.739
## 97 2681.159 -442.5214 5804.839 -2096.09794 7458.416
## 98 2681.159 -569.6467 5931.965 -2290.51935 7652.837
## 99 2681.159 -691.9844 6054.302 -2477.61870 7839.937
## 100 2681.159 -810.0378 6172.356 -2658.16578 8020.484
## 101 2681.159 -924.2278 6286.546 -2832.80426 8195.122
## 102 2681.159 -1034.9105 6397.229 -3002.07886 8364.397
## 103 2681.159 -1142.3905 6504.709 -3166.45541 8528.773
## 104 2681.159 -1246.9308 6609.249 -3326.33598 8688.654
## 105 2681.159 -1348.7601 6711.078 -3482.07049 8844.389
## 106 2681.159 -1448.0791 6810.397 -3633.96566 8996.284
## 107 2681.159 -1545.0646 6907.383 -3782.29218 9144.610
autoplot(ses.1) +
autolayer(fitted(ses.1), series="Fitted") +
ylab("Penumpang") + xlab("Periode")
#Cara 2 (fungsi Holtwinter)
ses1<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.3)
plot(ses1)
#ramalan
ramalan1<- forecast(ses1, h=21)
ramalan1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 3009.866 1731.9475 4287.785 1055.45833 4964.274
## 88 3009.866 1675.6799 4344.052 969.40449 5050.328
## 89 3009.866 1621.6912 4398.041 886.83585 5132.896
## 90 3009.866 1569.7250 4450.007 807.36041 5212.372
## 91 3009.866 1519.5698 4500.162 730.65458 5289.077
## 92 3009.866 1471.0484 4548.684 656.44752 5363.285
## 93 3009.866 1424.0109 4595.721 584.50987 5435.222
## 94 3009.866 1378.3289 4641.403 514.64532 5505.087
## 95 3009.866 1333.8916 4685.840 446.68437 5573.048
## 96 3009.866 1290.6025 4729.130 380.47940 5639.253
## 97 3009.866 1248.3769 4771.355 315.90094 5703.831
## 98 3009.866 1207.1401 4812.592 252.83470 5766.897
## 99 3009.866 1166.8258 4852.906 191.17917 5828.553
## 100 3009.866 1127.3745 4892.358 130.84372 5888.888
## 101 3009.866 1088.7333 4930.999 71.74702 5947.985
## 102 3009.866 1050.8541 4968.878 13.81577 6005.916
## 103 3009.866 1013.6935 5006.039 -43.01638 6062.748
## 104 3009.866 977.2122 5042.520 -98.80971 6118.542
## 105 3009.866 941.3742 5078.358 -153.61918 6173.351
## 106 3009.866 906.1467 5113.585 -207.49508 6227.227
## 107 3009.866 871.4994 5148.233 -260.48355 6280.216
ses2<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.8)
plot(ses2)
#ramalan
ramalan2<- forecast(ses2, h=21)
ramalan2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 2585.677 1284.49369 3886.860 595.68882 4575.665
## 88 2585.677 919.34931 4252.005 37.24867 5134.105
## 89 2585.677 620.93326 4550.421 -419.13930 5590.493
## 90 2585.677 362.21394 4809.140 -814.81635 5986.170
## 91 2585.677 130.60918 5040.745 -1169.02525 6340.379
## 92 2585.677 -80.95533 5252.309 -1492.58526 6663.939
## 93 2585.677 -276.92636 5448.281 -1792.29709 6963.651
## 94 2585.677 -460.31512 5631.669 -2072.76599 7244.120
## 95 2585.677 -633.27284 5804.627 -2337.28199 7508.636
## 96 2585.677 -797.39971 5968.754 -2588.29239 7759.647
## 97 2585.677 -953.92440 6125.279 -2827.67624 7999.030
## 98 2585.677 -1103.81458 6275.169 -3056.91348 8228.268
## 99 2585.677 -1247.84855 6419.203 -3277.19443 8448.549
## 100 2585.677 -1386.66339 6558.018 -3489.49340 8660.848
## 101 2585.677 -1520.78841 6692.143 -3694.61993 8865.974
## 102 2585.677 -1650.66909 6822.023 -3893.25528 9064.609
## 103 2585.677 -1776.68454 6948.039 -4085.97929 9257.333
## 104 2585.677 -1899.16059 7070.515 -4273.29024 9444.644
## 105 2585.677 -2018.37972 7189.734 -4455.62016 9626.974
## 106 2585.677 -2134.58870 7305.943 -4633.34646 9804.701
## 107 2585.677 -2248.00465 7419.359 -4806.80119 9978.155
#SES
ses.opt <- ses(train.ts, h = 21, alpha = NULL)
plot(ses.opt)
ses.opt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 2958.111 1690.3315 4225.891 1019.209528 4897.013
## 88 2958.111 1589.8033 4326.419 865.464838 5050.757
## 89 2958.111 1496.1714 4420.051 722.267311 5193.955
## 90 2958.111 1408.1857 4508.037 587.704697 5328.518
## 91 2958.111 1324.9332 4591.289 460.381013 5455.841
## 92 2958.111 1245.7235 4670.499 339.240225 5576.982
## 93 2958.111 1170.0192 4746.203 223.460531 5692.762
## 94 2958.111 1097.3925 4818.830 112.387500 5803.835
## 95 2958.111 1027.4959 4888.726 5.489912 5910.732
## 96 2958.111 960.0429 4956.179 -97.670461 6013.893
## 97 2958.111 894.7940 5021.428 -197.460167 6113.682
## 98 2958.111 831.5461 5084.676 -294.189485 6210.412
## 99 2958.111 770.1257 5146.097 -388.123824 6304.346
## 100 2958.111 710.3831 5205.839 -479.492316 6395.715
## 101 2958.111 652.1877 5264.035 -568.494395 6484.717
## 102 2958.111 595.4254 5320.797 -655.304928 6571.527
## 103 2958.111 539.9951 5376.227 -740.078249 6656.301
## 104 2958.111 485.8072 5430.415 -822.951388 6739.174
## 105 2958.111 432.7819 5483.440 -904.046666 6820.269
## 106 2958.111 380.8473 5535.375 -983.473820 6899.696
## 107 2958.111 329.9387 5586.284 -1061.331742 6977.554
#Lamda Optimum Holt Winter
sesopt<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE,alpha = NULL)
sesopt
## Holt-Winters exponential smoothing without trend and without seasonal component.
##
## Call:
## HoltWinters(x = train.ts, alpha = NULL, beta = FALSE, gamma = FALSE)
##
## Smoothing parameters:
## alpha: 0.4522596
## beta : FALSE
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 2922.547
plot(sesopt)
#ramalan
ramalanopt<- forecast(sesopt, h=21)
ramalanopt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 2922.547 1652.88560 4192.208 980.7675 4864.326
## 88 2922.547 1529.07483 4316.019 791.4153 5053.679
## 89 2922.547 1415.40092 4429.693 617.5660 5227.528
## 90 2922.547 1309.71907 4535.375 455.9396 5389.154
## 91 2922.547 1210.54860 4634.545 304.2714 5540.822
## 92 2922.547 1116.81636 4728.277 160.9203 5684.174
## 93 2922.547 1027.71515 4817.379 24.6518 5820.442
## 94 2922.547 942.61964 4902.474 -105.4906 5950.584
## 95 2922.547 861.03373 4984.060 -230.2654 6075.359
## 96 2922.547 782.55598 5062.538 -350.2868 6195.381
## 97 2922.547 706.85610 5138.238 -466.0598 6311.154
## 98 2922.547 633.65845 5211.435 -578.0059 6423.100
## 99 2922.547 562.73019 5282.364 -686.4813 6531.575
## 100 2922.547 493.87247 5351.221 -791.7901 6636.884
## 101 2922.547 426.91389 5418.180 -894.1944 6739.288
## 102 2922.547 361.70550 5483.388 -993.9221 6839.016
## 103 2922.547 298.11681 5546.977 -1091.1726 6936.266
## 104 2922.547 236.03283 5609.061 -1186.1218 7031.216
## 105 2922.547 175.35152 5669.742 -1278.9259 7124.020
## 106 2922.547 115.98191 5729.112 -1369.7239 7214.818
## 107 2922.547 57.84244 5787.251 -1458.6405 7303.734
Dari hasil diatas, nilai alpha yang optimum sebesar 0,45.
#Keakuratan Metode
#Pada data training
SSE1<-ses1$SSE
MSE1<-ses1$SSE/length(train.ts)
RMSE1<-sqrt(MSE1)
akurasi1 <- matrix(c(SSE1,MSE1,RMSE1))
row.names(akurasi1)<- c("SSE", "MSE", "RMSE")
colnames(akurasi1) <- c("Akurasi lamda=0.3")
akurasi1
## Akurasi lamda=0.3
## SSE 8.355581e+07
## MSE 9.715792e+05
## RMSE 9.856872e+02
SSE2<-ses2$SSE
MSE2<-ses2$SSE/length(train.ts)
RMSE2<-sqrt(MSE2)
akurasi2 <- matrix(c(SSE2,MSE2,RMSE2))
row.names(akurasi2)<- c("SSE", "MSE", "RMSE")
colnames(akurasi2) <- c("Akurasi lamda=0.8")
akurasi2
## Akurasi lamda=0.8
## SSE 86608635.476
## MSE 1007077.157
## RMSE 1003.532
#Cara Manual
fitted1<-ramalan1$fitted
sisaan1<-ramalan1$residuals
head(sisaan1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA -816.000 1906.800 2440.760 281.532 1339.072
resid1<-training$Penumpang-ramalan1$fitted
head(resid1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA -816.000 1906.800 2440.760 281.532 1339.072
#Cara Manual
SSE.1=sum(sisaan1[2:length(train.ts)]^2)
SSE.1
## [1] 83555814
MSE.1 = SSE.1/length(train.ts)
MSE.1
## [1] 971579.2
MAPE.1 = sum(abs(sisaan1[2:length(train.ts)]/train.ts[2:length(train.ts)])*
100)/length(train.ts)
MAPE.1
## [1] 22.56632
akurasi.1 <- matrix(c(SSE.1,MSE.1,MAPE.1))
row.names(akurasi.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasi.1) <- c("Akurasi lamda=0.3")
akurasi.1
## Akurasi lamda=0.3
## SSE 8.355581e+07
## MSE 9.715792e+05
## MAPE 2.256632e+01
fitted2<-ramalan2$fitted
sisaan2<-ramalan2$residuals
head(sisaan2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA -816.0000 2314.8000 1568.9600 -1113.2080 919.3584
resid2<-training$Penumpang-ramalan2$fitted
head(resid2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA -816.0000 2314.8000 1568.9600 -1113.2080 919.3584
SSE.2=sum(sisaan2[2:length(train.ts)]^2)
SSE.2
## [1] 86608635
MSE.2 = SSE.2/length(train.ts)
MSE.2
## [1] 1007077
MAPE.2 = sum(abs(sisaan2[2:length(train.ts)]/train.ts[2:length(train.ts)])*
100)/length(train.ts)
MAPE.2
## [1] 22.68615
akurasi.2 <- matrix(c(SSE.2,MSE.2,MAPE.2))
row.names(akurasi.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasi.2) <- c("Akurasi lamda=0.8")
akurasi.2
## Akurasi lamda=0.8
## SSE 8.660864e+07
## MSE 1.007077e+06
## MAPE 2.268615e+01
Berdasarkan nilai SSE, MSE, RMSE, dan MAPE di antara kedua parameter, nilai parameter \(\lambda=0,3\) menghasilkan akurasi yang lebih baik dibanding \(\lambda=0,8\) . Hal ini dilihat dari nilai masing-masing ukuran akurasi yang lebih kecil. Berdasarkan nilai MAPE-nya, hasil ini dapat dikategorikan sebagai peramalan cukup baik karena berada di atas nilai 20%.
Akurasi data uji dapat dihitung dengan cara yang hampir sama dengan perhitungan akurasi data latih.
selisih1<-ramalan1$mean-testing$Penumpang
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(testing)
selisih2<-ramalan2$mean-testing$Penumpang
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(testing)
selisihopt<-ramalanopt$mean-testing$Penumpang
SSEtestingopt<-sum(selisihopt^2)
MSEtestingopt<-SSEtestingopt/length(testing)
akurasitesting1 <- matrix(c(SSEtesting1,SSEtesting2,SSEtestingopt))
row.names(akurasitesting1)<- c("SSE1", "SSE2", "SSEopt")
akurasitesting1
## [,1]
## SSE1 10215146
## SSE2 11454454
## SSEopt 9852538
akurasitesting2 <- matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt))
row.names(akurasitesting2)<- c("MSE1", "MSE2", "MSEopt")
akurasitesting2
## [,1]
## MSE1 5107573
## MSE2 5727227
## MSEopt 4926269
#cara lain
accuracy(ramalan1,testing$Penumpang)
## ME RMSE MAE MPE MAPE MASE
## Training set -19.22094 991.4684 816.5765 -6.343423 22.83180 0.9663089
## Test set -142.53268 697.4493 552.9332 -11.300228 21.77841 0.6543224
## ACF1
## Training set 0.267392
## Test set NA
accuracy(ramalan2,testing$Penumpang)
## ME RMSE MAE MPE MAPE MASE
## Training set -13.44593 1009.418 826.2539 -4.751221 22.95305 0.9777608
## Test set 281.65626 738.546 574.4886 4.385628 19.60882 0.6798303
## ACF1
## Training set -0.08216092
## Test set NA
accuracy(ramalanopt,testing$Penumpang)
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -15.02139 984.9915 814.2180 -5.676437 22.72112 0.9635180 0.1558786
## Test set -55.21359 684.9587 540.4591 -8.071302 20.73216 0.6395609 NA
Berdasarkan nilai akurasi data uji diatas, nilai parameter \(\lambda=0,45\) memiliki nilai akurasi yang lebih kecil dibandingkan dengan parameter \(\lambda=0,3\) dan \(\lambda=0,8\), sehingga parameter \(\lambda=0,45\) dapat dijadikan parameter optimum. Selain itu, nilai MAPE pada data uji parameter optimum sebesar 20,73% sehingga dapat dikategorikan cukup baik.
#Lamda=0.3 dan gamma=0.3
des.1<- HoltWinters(train.ts, gamma = FALSE, beta = 0.3, alpha = 0.3)
plot(des.1)
#ramalan
ramalandes1<- forecast(des.1, h=21)
ramalandes1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 3332.073 1789.6214 4874.525 973.09681 5691.049
## 88 3373.840 1718.2350 5029.444 841.81075 5905.869
## 89 3415.606 1601.9953 5229.217 641.92760 6189.285
## 90 3457.373 1441.8895 5472.856 374.95710 6539.789
## 91 3499.139 1241.1461 5757.133 45.83662 6952.442
## 92 3540.906 1003.8191 6077.993 -339.23354 7421.046
## 93 3582.673 733.8934 6431.452 -774.15929 7939.505
## 94 3624.439 434.8818 6813.997 -1253.56789 8502.446
## 95 3666.206 109.7256 7222.686 -1772.96134 9105.373
## 96 3707.972 -239.1672 7655.112 -2328.65676 9744.602
## 97 3749.739 -609.8364 8109.314 -2917.65626 10417.134
## 98 3791.506 -1000.6811 8583.692 -3537.51154 11120.523
## 99 3833.272 -1410.3831 9076.927 -4186.20653 11852.751
## 100 3875.039 -1837.8451 9587.923 -4862.06309 12612.141
## 101 3916.805 -2282.1429 10115.753 -5563.66781 13397.278
## 102 3958.572 -2742.4888 10659.633 -6289.81602 14206.960
## 103 4000.338 -3218.2037 11218.881 -7039.46905 15040.146
## 104 4042.105 -3708.6956 11792.906 -7811.72157 15895.932
## 105 4083.872 -4213.4433 12381.187 -8605.77655 16773.520
## 106 4125.638 -4731.9838 12983.260 -9420.92574 17672.202
## 107 4167.405 -5263.9022 13598.712 -10256.53459 18591.344
#Lamda=0.8 dan gamma=0.4
des.2<- HoltWinters(train.ts, gamma = FALSE, beta = 0.8, alpha = 0.4)
plot(des.2)
#ramalan
ramalandes2<- forecast(des.2, h=21)
ramalandes2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 2833.6626 1123.7964 4543.529 218.6479 5448.677
## 88 2413.6289 306.6741 4520.584 -808.6804 5635.938
## 89 1993.5952 -763.4812 4750.672 -2222.9893 6210.180
## 90 1573.5615 -2033.2431 5180.366 -3942.5701 7089.693
## 91 1153.5278 -3457.4078 5764.464 -5898.2897 8205.345
## 92 733.4941 -5007.1763 6474.165 -8046.1037 9513.092
## 93 313.4605 -6664.4698 7291.391 -10358.3629 10985.284
## 94 -106.5732 -8417.2970 8204.150 -12816.7284 12603.582
## 95 -526.6069 -10257.1729 9203.959 -15408.2234 14355.010
## 96 -946.6406 -12177.7416 10284.460 -18123.1273 16229.846
## 97 -1366.6743 -14174.0173 11440.669 -20953.8152 18220.467
## 98 -1786.7080 -16241.9456 12668.530 -23894.0862 20320.670
## 99 -2206.7417 -18378.1352 13964.652 -26938.7538 22525.270
## 100 -2626.7754 -20579.6866 15326.136 -30083.3837 24829.833
## 101 -3046.8091 -22844.0768 16750.459 -33324.1173 27230.499
## 102 -3466.8428 -25169.0800 18235.394 -36657.5505 29723.865
## 103 -3886.8765 -27552.7096 19778.957 -40080.6449 32306.892
## 104 -4306.9102 -29993.1757 21379.355 -43590.6633 34976.843
## 105 -4726.9438 -32488.8530 23034.965 -47185.1200 37731.232
## 106 -5146.9775 -35038.2558 24744.301 -50861.7427 40567.788
## 107 -5567.0112 -37640.0177 26505.995 -54618.4417 43484.419
#Visually evaluate the prediction
plot(data.ts)
lines(des.1$fitted[,1], lty=2, col="blue")
lines(ramalandes1$mean, col="red")
Untuk mendapatkan nilai parameter optimum dari DES, argumen
alpha dan beta dapat dibuat NULL
seperti berikut.
#Lamda dan gamma optimum
des.opt<- HoltWinters(train.ts, gamma = FALSE)
des.opt
## Holt-Winters exponential smoothing with trend and without seasonal component.
##
## Call:
## HoltWinters(x = train.ts, gamma = FALSE)
##
## Smoothing parameters:
## alpha: 0.7420854
## beta : 0.08410782
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 2647.38048
## b -41.82048
plot(des.opt)
#ramalan
ramalandesopt<- forecast(des.opt, h=21)
ramalandesopt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 87 2605.560 1206.25863 4004.861 465.5132 4745.607
## 88 2563.740 767.81860 4359.660 -182.8845 5310.364
## 89 2521.919 354.68896 4689.149 -792.5733 5836.411
## 90 2480.099 -47.34339 5007.540 -1385.2903 6345.487
## 91 2438.278 -445.09104 5321.647 -1971.4544 6848.011
## 92 2396.458 -842.32395 5635.239 -2556.8313 7349.747
## 93 2354.637 -1241.31671 5950.591 -3144.8997 7854.174
## 94 2312.817 -1643.52095 6269.154 -3737.8796 8363.513
## 95 2270.996 -2049.89858 6591.891 -4337.2421 8879.234
## 96 2229.176 -2461.10281 6919.454 -4943.9863 9402.338
## 97 2187.355 -2877.58366 7252.294 -5558.8003 9933.511
## 98 2145.535 -3299.65281 7590.722 -6182.1610 10473.230
## 99 2103.714 -3727.52514 7934.954 -6814.3968 11021.825
## 100 2061.894 -4161.34638 8285.134 -7455.7307 11579.518
## 101 2020.073 -4601.21196 8641.358 -8106.3086 12146.455
## 102 1978.253 -5047.18027 9003.686 -8766.2199 12722.725
## 103 1936.432 -5499.28205 9372.147 -9435.5115 13308.376
## 104 1894.612 -5957.52730 9746.751 -10114.1987 13903.422
## 105 1852.791 -6421.91034 10127.493 -10802.2728 14507.855
## 106 1810.971 -6892.41361 10514.355 -11499.7070 15121.649
## 107 1769.150 -7369.01049 10907.311 -12206.4606 15744.761
Nilai alpha dan beta yang optimun yaitu sebesar 0,74 dan 0,08. Selanjutnya akan dilakukan perhitungan akurasi pada data latih maupun data uji dengan ukuran akurasi SSE, MSE dan MAPE.
#Akurasi Data Training
ssedes.train1<-des.1$SSE
msedes.train1<-ssedes.train1/length(train.ts)
sisaandes1<-ramalandes1$residuals
head(sisaandes1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA 3294.000 3931.340 1490.657 2217.020
mapedes.train1 <- sum(abs(sisaandes1[3:length(train.ts)]/train.ts[3:length(train.ts)])
*100)/length(train.ts)
akurasides.1 <- matrix(c(ssedes.train1,msedes.train1,mapedes.train1))
row.names(akurasides.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.1) <- c("Akurasi lamda=0.3 dan gamma=0.3")
akurasides.1
## Akurasi lamda=0.3 dan gamma=0.3
## SSE 1.213159e+08
## MSE 1.410650e+06
## MAPE 2.436711e+01
ssedes.train2<-des.2$SSE
msedes.train2<-ssedes.train2/length(train.ts)
sisaandes2<-ramalandes2$residuals
head(sisaandes2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA 3294.0000 2844.3200 -868.6704 -249.4901
mapedes.train2 <- sum(abs(sisaandes2[3:length(train.ts)]/train.ts[3:length(train.ts)])
*100)/length(train.ts)
akurasides.2 <- matrix(c(ssedes.train2,msedes.train2,mapedes.train2))
row.names(akurasides.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.2) <- c("Akurasi lamda=0.8 dan gamma=0.4")
akurasides.2
## Akurasi lamda=0.8 dan gamma=0.4
## SSE 1.477691e+08
## MSE 1.718246e+06
## MAPE 2.876896e+01
Hasil akurasi dari data latih didapatkan skenario 1 dengan lamda=0.3 dan gamma=0.3 memiliki hasil yang lebih baik. Namun untuk kedua skenario dapat dikategorikan peramalan cukup baik berdasarkan nilai MAPE-nya yang berada diatas 20%.
#Akurasi Data Testing
selisihdes1<-ramalandes1$mean-testing$Penumpang
selisihdes1
## Time Series:
## Start = 87
## End = 107
## Frequency = 1
## [1] 456.07313 701.83971 -26.39370 578.37288 -712.86053 522.90605
## [7] 1158.67264 1006.43922 920.20580 412.97239 727.73897 -286.49444
## [13] 722.27214 1585.03873 2140.80531 2285.57190 1739.33848 1591.10507
## [19] -13.12835 1002.63824 2017.40482
SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(testing$Penumpang)
MAPEtestingdes1<-sum(abs(selisihdes1/testing$Penumpang)*100)/length(testing$Penumpang)
selisihdes2<-ramalandes2$mean-testing$Penumpang
selisihdes2
## Time Series:
## Start = 87
## End = 107
## Frequency = 1
## [1] -42.3374 -258.3711 -1448.4048 -1305.4385 -3058.4722 -2284.5059
## [7] -2110.5395 -2724.5732 -3272.6069 -4241.6406 -4388.6743 -5864.7080
## [13] -5317.7417 -4916.7754 -4822.8091 -5139.8428 -6147.8765 -6757.9102
## [19] -8823.9438 -8269.9775 -7717.0112
SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(testing$Penumpang)
MAPEtestingdes2<-sum(abs(selisihdes2/testing$Penumpang)*100)/length(testing$Penumpang)
selisihdesopt<-ramalandesopt$mean-testing$Penumpang
selisihdesopt
## Time Series:
## Start = 87
## End = 107
## Frequency = 1
## [1] -270.44001 -108.26049 -920.08097 -398.90145 -1773.72193 -621.54241
## [7] -69.36289 -305.18337 -475.00385 -1065.82433 -834.64482 -1932.46530
## [13] -1007.28578 -228.10626 244.07326 305.25278 -324.56770 -556.38818
## [19] -2244.20866 -1312.02914 -380.84962
SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(testing$Penumpang)
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing$Penumpang)*100)/length(testing$Penumpang)
akurasitestingdes <-
matrix(c(SSEtestingdes1,MSEtestingdes1,MAPEtestingdes1,SSEtestingdes2,MSEtestingdes2,
MAPEtestingdes2,SSEtestingdesopt,MSEtestingdesopt,MAPEtestingdesopt),
nrow=3,ncol=3)
row.names(akurasitestingdes)<- c("SSE", "MSE", "MAPE")
colnames(akurasitestingdes) <- c("des ske1","des ske2","des opt")
akurasitestingdes
## des ske1 des ske2 des opt
## SSE 2.927505e+07 5.040813e+08 1.905081e+07
## MSE 1.394050e+06 2.400387e+07 9.071812e+05
## MAPE 4.182458e+01 1.583867e+02 2.294301e+01
Berdasarkan hasil akurasi data uji diatas, terbukti bahwa nilai alpha dan beta yang optimum memiliki nilai akurasi yang lebih baik dibandingkan nilai alpha dan beta yang lain. Selain itu nilai MAPE pada alpha dan beta yang optimum ini juga paling kecil dan dapat dikategorikan cukup baik.Namun nilai MAPE pada parameter alpha dan beta yang optimum ini sebesar 22,9% yang nilainya masih diatas 10% sehingga masih dapat dicari model lain yang dapat menghasilkan MAPE yang lebih kecil.
MSEfull <-
matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt,MSEtestingdes1,MSEtestingdes2,
MSEtestingdesopt),nrow=3,ncol=2)
row.names(MSEfull)<- c("ske 1", "ske 2", "ske opt")
colnames(MSEfull) <- c("ses","des")
MSEfull
## ses des
## ske 1 5107573 1394049.9
## ske 2 5727227 24003869.6
## ske opt 4926269 907181.2
Kedua metode dapat dibandingkan dengan menggunakan ukuran akurasi yang sama. Contoh di atas adalah perbandingan kedua metode dengan ukuran akurasi MAPE Hasilnya didapatkan metode DES lebih baik dibandingkan metode SES dilihat dari MAPE yang lebih kecil nilainya. Namun, metode DES maupun SES memiliki nilai MAPE yang lebih besar dari 10% sehingga kurang cocok digunakan pada data tersebut.
#membagi data menjadi training dan testing
training<-mpdw[1:86,2]
testing<-mpdw[87:107,2]
training.ts<-ts(training, frequency = 7)
testing.ts<-ts(testing, frequency = 7)
Kemudian akan dilakukan eskplorasi dengan plot data deret waktu sebagai berikut.
#Membuat plot time series
plot(data.ts, col="red",main="Plot semua data")
points(data.ts)
plot(training.ts, col="blue",main="Plot data latih")
points(training.ts)
plot(testing.ts, col="green",main="Plot data uji")
points(testing.ts)
Perhitungan dengan model aditif dilakukan jika plot data asli menunjukkan fluktuasi musiman yang relatif stabil (konstan).
#Pemulusan dengan winter aditif
winter1 <- HoltWinters(training.ts,alpha=0.2,beta=0.1,gamma=0.1,seasonal = "additive")
winter1$fitted
## Time Series:
## Start = c(2, 1)
## End = c(13, 2)
## Frequency = 7
## xhat level trend season
## 2.000000 4862.058 5398.480 -174.14625850 -362.275510
## 2.142857 3435.816 5078.922 -188.68741497 -1454.418367
## 2.285714 3848.615 4805.871 -197.12373469 -760.132653
## 2.428571 4800.247 4514.824 -206.51603007 491.938776
## 2.571429 3600.731 4072.659 -230.08097434 -241.846939
## 2.714286 4693.926 4050.232 -209.31559598 853.010204
## 2.857143 4881.821 3637.731 -229.63412423 1473.724490
## 3.000000 2734.082 3386.333 -231.81055006 -420.440136
## 3.142857 1512.630 3225.506 -224.71218721 -1488.163646
## 3.285714 2268.861 3264.867 -198.30478298 -797.701835
## 3.428571 3985.148 3720.391 -132.92200017 397.678998
## 3.571429 3811.849 4056.639 -86.00495058 -158.785425
## 3.714286 4885.419 4178.864 -65.18192342 771.736091
## 3.857143 5781.827 4357.599 -40.79029355 1465.018786
## 4.000000 4025.029 4445.043 -27.96683769 -392.046685
## 4.142857 3065.309 4470.470 -22.62742683 -1382.534029
## 4.285714 3836.397 4399.981 -27.41360271 -536.170703
## 4.428571 4735.934 4195.688 -45.10153788 585.347197
## 4.571429 3654.026 3808.800 -79.28021326 -75.493317
## 4.714286 4693.116 3887.314 -63.50073903 869.302611
## 4.857143 4877.520 3460.990 -99.78306341 1516.312610
## 5.000000 2605.941 3102.303 -125.67346163 -370.689041
## 5.142857 1524.091 3044.642 -118.87227795 -1401.678733
## 5.285714 2433.155 3137.751 -97.67409162 -606.922444
## 5.428571 3289.802 2948.046 -106.87718650 448.632495
## 5.571429 2628.460 2756.209 -115.37321746 -12.375420
## 5.714286 3374.714 2754.544 -104.00241957 724.173313
## 5.857143 3996.753 2684.598 -100.59670753 1412.751017
## 6.000000 2062.975 2514.051 -107.59175783 -343.484306
## 6.142857 1172.287 2579.464 -90.29125644 -1316.885988
## 6.285714 1968.704 2683.316 -70.87699657 -643.734824
## 6.428571 3237.215 2867.898 -45.33107203 414.648371
## 6.571429 2695.896 2718.524 -55.73537486 33.107772
## 6.714286 3680.372 2967.809 -25.23329763 737.796161
## 6.857143 4655.792 3264.101 6.91926232 1384.770816
## 7.000000 2562.824 2870.262 -33.15656806 -274.282301
## 7.142857 1842.619 3089.741 -7.89303867 -1239.228948
## 7.285714 3319.208 3797.124 63.63457856 -541.551125
## 7.428571 4375.039 3931.317 70.69042432 373.031160
## 7.571429 3912.546 3715.400 42.02964673 155.116081
## 7.714286 4844.166 3919.520 58.23873331 866.406401
## 7.857143 5234.689 3954.326 55.89542151 1224.467494
## 8.000000 3938.937 4052.084 60.08164176 -173.228183
## 8.142857 3213.202 4106.778 59.54289869 -953.118479
## 8.285714 3768.591 4217.280 64.63885217 -513.327742
## 8.428571 4508.456 4194.201 55.86702318 258.388050
## 8.571429 4305.347 4049.577 35.81790368 219.952427
## 8.714286 5034.709 4136.725 40.95096246 857.033154
## 8.857143 5329.443 4059.134 29.09677570 1241.212375
## 9.000000 3894.547 4045.142 24.78790634 -175.383156
## 9.142857 3125.123 4036.421 21.43696335 -932.734665
## 9.285714 3494.553 4024.833 18.13449989 -548.415058
## 9.428571 4349.172 4142.857 28.12344698 178.191572
## 9.571429 4237.151 3986.946 9.72000311 240.484662
## 9.714286 4732.149 3920.436 2.09698614 809.616407
## 9.857143 4989.074 3777.503 -12.40600204 1223.976898
## 10.000000 3326.288 3549.082 -34.00748237 -188.786928
## 10.142857 2641.979 3612.217 -24.29324048 -945.944519
## 10.285714 3322.696 3831.128 0.02716967 -508.459270
## 10.428571 3950.127 3844.216 1.33324942 104.577796
## 10.571429 3822.987 3632.924 -19.92929310 209.992594
## 10.714286 4231.813 3510.397 -30.18903721 751.604454
## 10.857143 4321.431 3238.246 -54.38528895 1137.570977
## 11.000000 2837.550 3054.774 -67.29391501 -149.929960
## 11.142857 1962.502 2888.370 -77.20491883 -848.662878
## 11.285714 2359.755 2928.465 -65.47496514 -503.234951
## 11.428571 2731.516 2785.239 -73.25006143 19.527626
## 11.571429 2760.719 2669.285 -77.52038879 168.953618
## 11.714286 3299.806 2710.621 -65.63476272 654.819447
## 11.857143 3467.551 2465.225 -83.61088320 1085.936472
## 12.000000 2070.248 2346.904 -87.08190243 -189.573975
## 12.142857 1382.603 2270.373 -86.02687081 -801.743064
## 12.285714 1755.911 2358.825 -68.57892633 -534.335336
## 12.428571 2344.473 2399.664 -57.63714677 2.446317
## 12.571429 2726.942 2547.532 -37.08661324 216.496122
## 12.714286 3263.967 2699.257 -18.20545026 582.914965
## 12.857143 3712.026 2660.259 -20.28478774 1072.052395
## 13.000000 2509.129 2707.969 -13.48531056 -185.353849
## 13.142857 2062.098 2797.257 -3.20789773 -731.951286
xhat1 <- winter1$fitted[,2]
winter1.opt<- HoltWinters(training.ts, alpha= NULL, beta = NULL, gamma = NULL, seasonal = "additive")
winter1.opt
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## HoltWinters(x = training.ts, alpha = NULL, beta = NULL, gamma = NULL, seasonal = "additive")
##
## Smoothing parameters:
## alpha: 0.4094002
## beta : 0.03712133
## gamma: 0.375923
##
## Coefficients:
## [,1]
## a 2681.16350
## b -26.43100
## s1 -158.47985
## s2 98.32782
## s3 660.72362
## s4 433.63269
## s5 1093.56500
## s6 120.40839
## s7 -90.20482
winter1.opt$fitted
## Time Series:
## Start = c(2, 1)
## End = c(13, 2)
## Frequency = 7
## xhat level trend season
## 2.000000 4862.058 5398.480 -174.14626 -362.275510
## 2.142857 3287.062 4926.676 -185.19570 -1454.418367
## 2.285714 3680.210 4629.689 -189.34555 -760.132653
## 2.428571 4615.043 4317.027 -193.92319 491.938776
## 2.571429 3265.690 3716.552 -209.01494 -241.846939
## 2.714286 4734.637 4069.771 -188.14410 853.010204
## 2.857143 4718.561 3449.039 -204.20231 1473.724490
## 3.000000 2540.052 3267.124 -203.37498 -523.696915
## 3.142857 1578.413 3288.488 -195.03236 -1515.043525
## 3.285714 2604.111 3607.084 -175.96579 -827.007380
## 3.428571 4772.338 4632.253 -131.37808 271.463333
## 3.571429 5094.356 5138.991 -107.69035 63.055319
## 3.714286 5439.547 4932.490 -111.35836 618.415702
## 3.857143 6478.134 5093.568 -101.24515 1485.810956
## 4.000000 4465.848 4969.751 -102.08305 -401.819498
## 4.142857 3455.269 4796.494 -104.72511 -1236.499974
## 4.285714 4144.233 4434.146 -114.28841 -175.625290
## 4.428571 4316.868 3831.758 -132.40734 617.517420
## 4.571429 3028.737 3171.278 -152.01008 9.469355
## 4.714286 4233.910 3598.267 -130.51686 766.159582
## 4.857143 4235.512 2913.050 -151.10808 1473.570163
## 5.000000 1893.361 2494.803 -161.02462 -440.417342
## 5.142857 1243.492 2764.729 -145.02716 -1376.210365
## 5.285714 2603.527 3168.506 -124.65482 -440.324815
## 5.428571 2982.618 2785.714 -134.23723 331.140943
## 5.571429 2790.763 2603.324 -136.02472 323.463970
## 5.714286 2969.104 2633.613 -129.85095 465.342371
## 5.857143 3947.134 2739.534 -121.09878 1328.699377
## 6.000000 2163.189 2495.560 -125.66007 -206.710497
## 6.142857 1490.386 2683.013 -114.03687 -1078.590662
## 6.285714 2151.724 2836.157 -104.11878 -580.314393
## 6.428571 3397.574 3180.035 -87.48854 305.027496
## 6.571429 3129.744 2813.919 -97.83155 413.656682
## 6.714286 3674.804 3162.848 -81.24722 593.202807
## 6.857143 4947.377 3742.044 -56.73070 1262.063573
## 7.000000 2617.064 2745.585 -91.61464 -36.907188
## 7.142857 2141.970 3148.910 -73.24185 -933.697252
## 7.285714 4056.482 4417.284 -23.43926 -337.363132
## 7.428571 4361.082 4236.438 -29.28242 153.926437
## 7.571429 4231.272 3626.183 -50.84889 655.937268
## 7.714286 4684.637 3776.648 -43.37585 951.364728
## 7.857143 4460.328 3750.616 -42.73204 752.443980
## 8.000000 4314.317 4110.599 -27.78270 231.500919
## 8.142857 3678.080 3918.108 -33.89691 -206.131034
## 8.285714 3338.389 3798.204 -37.08959 -422.725801
## 8.428571 3559.325 3757.680 -37.21708 -161.138211
## 8.571429 4425.715 3698.632 -38.02749 765.110840
## 8.714286 4641.213 3716.399 -35.95630 960.770192
## 8.857143 4530.740 3598.885 -38.98384 970.838973
## 9.000000 3910.747 3798.688 -30.11976 142.178379
## 9.142857 3407.657 3693.342 -32.91225 -252.772950
## 9.285714 3012.855 3477.159 -39.71551 -424.588262
## 9.428571 3641.342 3839.124 -24.80458 -172.977402
## 9.571429 4494.724 3727.387 -28.03165 795.368790
## 9.714286 4316.664 3437.861 -37.73865 916.540850
## 9.857143 4331.236 3273.346 -42.44475 1100.334319
## 10.000000 3110.559 3058.038 -48.86168 101.382961
## 10.142857 2905.983 3296.346 -38.20155 -352.161797
## 10.285714 3417.413 3647.901 -23.73329 -206.754498
## 10.428571 3367.824 3612.126 -24.18029 -220.121681
## 10.571429 4013.168 3391.096 -31.48760 653.559275
## 10.714286 3877.347 3071.732 -42.17398 847.789313
## 10.857143 3630.795 2679.378 -55.17310 1006.589463
## 11.000000 2845.343 2642.712 -54.48609 257.116811
## 11.142857 2179.227 2382.157 -62.13564 -140.794960
## 11.285714 2201.606 2471.407 -56.51602 -213.284769
## 11.428571 1933.586 2320.481 -60.02065 -326.874204
## 11.571429 2946.022 2499.719 -51.13903 497.441931
## 11.714286 3228.977 2616.016 -44.92360 657.885177
## 11.857143 3191.237 2232.118 -57.50677 1016.625938
## 12.000000 2306.102 2216.682 -55.94504 145.364572
## 12.142857 1968.350 2085.775 -58.72772 -58.697922
## 12.285714 1825.547 2144.402 -54.37136 -264.483976
## 12.428571 2041.262 2285.500 -47.11528 -197.122568
## 12.571429 3344.541 2783.189 -26.89143 588.243184
## 12.714286 3342.078 2889.950 -21.93007 474.057589
## 12.857143 3808.222 2793.477 -24.69720 1039.441310
## 13.000000 2952.303 2868.583 -20.99238 104.712263
## 13.142857 2861.560 2876.534 -19.91796 4.944171
xhat1.opt <- winter1.opt$fitted[,2]
Berdasarkan kasus diatas terdapat 2 skenario yaitu skenario 1 ketika parameter nya alpha=0.2,beta=0.1,gamma=0.1, dan skenario 2 ketika parameter optimum dengan alpha= 0.4, beta = 0.037 dan gamma= 0.37
#Forecast
forecast1 <- predict(winter1, n.ahead = 21)
forecast1.opt <- predict(winter1.opt, n.ahead = 21)
#Plot time series
plot(training.ts,main="Winter 0.2;0.1;0.1",type="l",col="black",
xlim=c(1,25),pch=12)
lines(xhat1,type="l",col="red")
lines(xhat1.opt,type="l",col="blue")
lines(forecast1,type="l",col="red")
lines(forecast1.opt,type="l",col="blue")
legend("topleft",c("Actual Data",expression(paste(winter1)),
expression(paste(winter1.opt))),cex=0.5,
col=c("black","red","blue"),lty=4)
#Akurasi data training
SSE1<-winter1$SSE
MSE1<-winter1$SSE/length(training.ts)
RMSE1<-sqrt(MSE1)
fitted_values <- winter1$fitted[,1]
abs_error <- abs(training.ts - fitted_values)
MAPE1 <- mean(abs_error / training.ts * 100)
akurasi1 <- matrix(c(SSE1,MSE1,RMSE1, MAPE1))
row.names(akurasi1)<- c("SSE", "MSE", "RMSE", "MAPE")
colnames(akurasi1) <- c("Akurasi")
akurasi1
## Akurasi
## SSE 8.202633e+07
## MSE 9.537945e+05
## RMSE 9.766240e+02
## MAPE 2.234119e+01
SSE1.opt<-winter1.opt$SSE
MSE1.opt<-winter1.opt$SSE/length(training.ts)
RMSE1.opt<-sqrt(MSE1.opt)
fitted_values <- winter1.opt$fitted[,1]
abs_error <- abs(training.ts - fitted_values)
MAPE1.opt <- mean(abs_error / training.ts * 100)
akurasi1.opt <- matrix(c(SSE1.opt,MSE1.opt,RMSE1.opt, MAPE1.opt))
row.names(akurasi1.opt)<- c("SSE1.opt", "MSE1.opt", "RMSE1.opt", "MAPE1.opt")
colnames(akurasi1.opt) <- c("Akurasi")
akurasi1.opt
## Akurasi
## SSE1.opt 6.662544e+07
## MSE1.opt 7.747145e+05
## RMSE1.opt 8.801787e+02
## MAPE1.opt 1.976760e+01
akurasi1.train = data.frame(Model_Winter = c("Winter 1","Winter1 optimal"),
Nilai_SSE=c(SSE1,SSE1.opt),
Nilai_MSE=c(MSE1,MSE1.opt),Nilai_RMSE=c(RMSE1,RMSE1.opt), Nilai_MAPE=c(MAPE1,MAPE1.opt))
akurasi1.train
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE Nilai_MAPE
## 1 Winter 1 82026325 953794.5 976.6240 22.34119
## 2 Winter1 optimal 66625445 774714.5 880.1787 19.76760
Hasil akurasi data latih menunjukkan bahwa skenario 2 (winter1 optimal) lebih baik dari skenario 1 (winter1) karena nilai SSE, MSE dan RMSE nya lebih kecil. Selain itu, nilai MAPE pada parameter optimum juga lebih kecil dari model skenario 1 (winter1), nilai MAPE paramter optimum ini masih diatas 10% sehingga masih dalam kategori yang baik karena berada di bawah 20%.
#Akurasi Data Testing
forecast1<-data.frame(forecast1)
testing.ts<-data.frame(testing.ts)
selisih1<-forecast1-testing.ts
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(testing.ts)
MAPEtesting1<-sum(abs(selisih1/testing.ts$Penumpang)*100)/length(testing.ts$Penumpang)
forecast1.opt<-data.frame(forecast1.opt)
selisih1.opt<-forecast1.opt-testing.ts
SSEtesting1.opt<-sum(selisih1.opt^2)
MSEtesting1.opt<-SSEtesting1.opt/length(testing.ts)
MAPEtesting1.opt<-sum(abs(selisih1.opt/testing.ts$Penumpang)*100)/length(testing.ts$Penumpang)
akurasi1.test = data.frame(Model_Winter = c("Winter 1","Winter1 optimal"),
Nilai_SSE=c(SSEtesting1,SSEtesting1.opt),
Nilai_MSE=c(MSEtesting1,MSEtesting1.opt), Nilai_MAPE=c(MAPEtesting1, MAPEtesting1.opt))
akurasi1.test
## Model_Winter Nilai_SSE Nilai_MSE Nilai_MAPE
## 1 Winter 1 5811317 5811317 16.68141
## 2 Winter1 optimal 4139527 4139527 12.95398
Pada akurasi data uji ini juga terbukti bahwa parameter optimum menghasilkan nilai akurasi yang lebih baik dan nilai MAPE yang lebih baik dari model Winter1. Nilai MAPE pada parameter optimum ini sebesar 12,9% sehingga dapat dikategorikan model yang baik.
Model multiplikatif digunakan cocok digunakan jika plot data asli menunjukkan fluktuasi musiman yang bervariasi.
#Pemulusan dengan winter multiplikatif
winter2 <- HoltWinters(training.ts,alpha=0.2,beta=0.1,gamma=0.3,seasonal = "multiplicative")
winter2$fitted
## Time Series:
## Start = c(2, 1)
## End = c(13, 2)
## Frequency = 7
## xhat level trend season
## 2.000000 4858.735 5398.480 -174.1462585 0.9300201
## 2.142857 3328.889 5068.695 -189.7101178 0.6822914
## 2.285714 3789.951 4786.681 -198.9404603 0.8261039
## 2.428571 4720.405 4488.249 -208.8895854 1.1030634
## 2.571429 3708.179 4080.204 -228.8051300 0.9628135
## 2.714286 4521.644 4044.754 -209.4697013 1.1789594
## 2.857143 4566.991 3692.167 -223.7813723 1.3167482
## 3.000000 2937.191 3499.676 -220.6523145 0.8957516
## 3.142857 2063.265 3312.919 -217.2627864 0.6665031
## 3.285714 2518.909 3326.634 -194.1650626 0.8041292
## 3.428571 3909.045 3883.366 -119.0753720 1.0384546
## 3.571429 4233.350 4230.744 -72.4299920 1.0180448
## 3.714286 4743.553 4280.047 -60.2566600 1.1241204
## 3.857143 5890.431 4462.015 -36.0342206 1.3308759
## 4.000000 4060.407 4506.014 -28.0309390 0.9067492
## 4.142857 3253.595 4529.065 -22.9227454 0.7220357
## 4.285714 4312.517 4387.700 -34.7669037 0.9907152
## 4.428571 4722.255 4078.280 -62.2322609 1.1758463
## 4.571429 3828.617 3727.701 -91.0668952 1.0527912
## 4.714286 4399.006 3753.350 -79.3953796 1.1973491
## 4.857143 4506.259 3420.059 -104.7848957 1.3592416
## 5.000000 2813.176 3179.425 -118.3698045 0.9190216
## 5.142857 2078.112 3089.961 -115.4792481 0.6986469
## 5.285714 2748.621 3119.301 -100.9973223 0.9106510
## 5.428571 2912.016 2847.959 -118.0317540 1.0667010
## 5.571429 2841.801 2721.112 -118.9132825 1.0920766
## 5.714286 2786.524 2667.249 -112.4082539 1.0906838
## 5.857143 3346.926 2693.924 -98.4999838 1.2895491
## 6.000000 2368.062 2641.963 -93.8460520 0.9293381
## 6.142857 1907.964 2668.619 -81.7958034 0.7375701
## 6.285714 2176.731 2650.556 -75.4225414 0.8452887
## 6.428571 2951.781 2828.129 -50.1230550 1.0625542
## 6.571429 3011.602 2733.814 -54.5422438 1.1240376
## 6.714286 3314.276 2894.460 -33.0234198 1.1582560
## 6.857143 4218.136 3202.246 1.0575476 1.3168083
## 7.000000 2882.956 2965.435 -22.7293084 0.9796957
## 7.142857 2376.531 3135.223 -3.4775305 0.7588519
## 7.285714 3753.770 3933.607 76.7085694 0.9360288
## 7.428571 4238.420 3992.844 74.9613910 1.0419429
## 7.571429 4736.926 3818.958 50.0767185 1.2243173
## 7.714286 5115.803 3866.760 49.8492221 1.3061815
## 7.857143 4642.379 3857.076 43.8959514 1.1900570
## 8.000000 4305.430 4035.692 57.3679199 1.0518853
## 8.142857 3842.284 4018.255 49.8874531 0.9444812
## 8.285714 3753.177 3988.886 41.9617413 0.9311137
## 8.428571 3815.777 3939.950 32.8720373 0.9604702
## 8.571429 4813.967 3908.317 26.4215005 1.2234529
## 8.714286 5020.078 3893.549 22.3025451 1.2819890
## 8.857143 4751.580 3825.667 13.2840824 1.2377288
## 9.000000 4027.834 3897.513 19.1402862 1.0283868
## 9.142857 3569.316 3858.147 13.2896774 0.9219615
## 9.285714 3385.351 3739.259 0.0718603 0.9053361
## 9.428571 3659.695 3873.789 13.5176729 0.9414475
## 9.571429 4646.771 3838.298 8.6168172 1.2079215
## 9.714286 4623.513 3715.984 -4.4762704 1.2457237
## 9.857143 4533.837 3612.527 -14.3743381 1.2600458
## 10.000000 3508.294 3498.976 -24.2920255 1.0096730
## 10.142857 3104.613 3534.843 -18.2761055 0.8828533
## 10.285714 3476.090 3687.238 -1.2090009 0.9430449
## 10.428571 3396.861 3667.347 -3.0772149 0.9270227
## 10.571429 4095.468 3554.270 -14.0771794 1.1568489
## 10.714286 4068.181 3404.398 -27.6566181 1.2047654
## 10.857143 3843.931 3203.068 -45.0240045 1.2171873
## 11.000000 3176.051 3130.450 -47.7833285 1.0302933
## 11.142857 2662.214 2920.762 -63.9738888 0.9318908
## 11.285714 2592.597 2832.490 -66.4036622 0.9372800
## 11.428571 2279.490 2633.448 -79.6675180 0.8925946
## 11.571429 2789.926 2607.222 -74.3233326 1.1014757
## 11.714286 2896.409 2635.502 -64.0630339 1.1263769
## 11.857143 2903.133 2483.474 -72.8595409 1.2043127
## 12.000000 2317.028 2475.525 -66.3684203 0.9617590
## 12.142857 2119.814 2368.808 -70.4032830 0.9222981
## 12.285714 1990.444 2327.720 -67.4717878 0.8806306
## 12.428571 2076.814 2331.233 -60.3733180 0.9145499
## 12.571429 2907.757 2554.099 -32.0493150 1.1529337
## 12.714286 2842.542 2654.450 -18.8092959 1.0785011
## 12.857143 3331.088 2694.511 -12.9222724 1.2422069
## 13.000000 2634.437 2797.659 -1.3153228 0.9421007
## 13.142857 2701.759 2878.832 6.9335437 0.9362364
xhat2 <- winter2$fitted[,2]
winter2.opt<- HoltWinters(training.ts, alpha= NULL, beta = NULL, gamma = NULL, seasonal = "multiplicative")
winter2.opt$fitted
## Time Series:
## Start = c(2, 1)
## End = c(13, 2)
## Frequency = 7
## xhat level trend season
## 2.000000 4858.735 5398.480 -174.14626 0.9300201
## 2.142857 3232.279 4921.150 -183.76115 0.6822914
## 2.285714 3655.537 4612.747 -187.71391 0.8261039
## 2.428571 4525.611 4294.615 -191.84987 1.1030634
## 2.571429 3448.452 3783.612 -201.97121 0.9628135
## 2.714286 4570.471 4063.393 -186.69338 1.1789594
## 2.857143 4458.149 3581.773 -196.04641 1.3167482
## 3.000000 2973.956 3478.884 -193.09208 0.9050954
## 3.142857 2119.769 3335.313 -191.52161 0.6742715
## 3.285714 2753.266 3555.902 -178.45230 0.8151909
## 3.428571 4858.255 4708.342 -136.24559 1.0625880
## 3.571429 5055.221 5112.081 -119.12102 1.0124698
## 3.714286 5448.980 4915.145 -121.58877 1.1367302
## 3.857143 6532.473 5018.398 -114.45832 1.3320867
## 4.000000 4332.845 4871.922 -115.47371 0.9109413
## 4.142857 3274.275 4738.979 -116.02771 0.7082650
## 4.285714 3892.878 4376.366 -123.84770 0.9154288
## 4.428571 4129.503 3852.088 -136.54659 1.1114135
## 4.571429 3197.745 3329.065 -148.80294 1.0054971
## 4.714286 4090.006 3662.761 -133.50141 1.1588850
## 4.857143 3952.592 3122.138 -146.41251 1.3282784
## 5.000000 2471.485 2867.320 -149.85039 0.9094805
## 5.142857 1918.876 2920.740 -143.40405 0.6909051
## 5.285714 2640.357 3152.398 -131.50967 0.8740333
## 5.428571 2725.246 2723.414 -140.94349 1.0552862
## 5.571429 2652.219 2634.067 -139.30723 1.0631161
## 5.714286 2800.021 2694.405 -132.97585 1.0931479
## 5.857143 3530.485 2826.941 -124.55565 1.3064329
## 6.000000 2449.055 2737.132 -123.45372 0.9370148
## 6.142857 1958.852 2812.818 -117.13839 0.7266636
## 6.285714 2231.444 2794.410 -114.00733 0.8325034
## 6.428571 3252.700 3155.200 -98.95003 1.0642782
## 6.571429 3023.266 2860.147 -105.16908 1.0973831
## 6.714286 3514.151 3180.204 -91.68382 1.1378105
## 6.857143 4759.982 3695.907 -72.42171 1.3136474
## 7.000000 2806.878 2998.303 -92.24818 0.9658724
## 7.142857 2389.043 3317.134 -79.21160 0.7378320
## 7.285714 4265.905 4837.839 -28.47327 0.8869995
## 7.428571 4658.547 4548.503 -36.74604 1.0325350
## 7.571429 4420.478 3864.064 -57.28640 1.1612127
## 7.714286 4698.867 3908.277 -54.06754 1.2191520
## 7.857143 4550.324 3863.200 -53.78243 1.1944936
## 8.000000 4129.140 4100.901 -44.53857 1.0179414
## 8.142857 3313.525 3973.256 -47.17413 0.8439775
## 8.285714 3418.381 3997.391 -44.91269 0.8648703
## 8.428571 3701.184 3912.665 -46.17530 0.9572466
## 8.571429 4390.068 3787.050 -48.69459 1.1743313
## 8.714286 4574.630 3795.396 -46.88565 1.2203862
## 8.857143 4504.486 3706.169 -48.22842 1.2314268
## 9.000000 3841.723 3850.779 -42.11292 1.0086793
## 9.142857 3164.672 3764.355 -43.51817 0.8505269
## 9.285714 3083.040 3627.083 -46.49139 0.8610420
## 9.428571 3755.497 3992.778 -33.41968 0.9485117
## 9.571429 4476.949 3825.250 -37.67267 1.1820088
## 9.714286 4297.172 3582.907 -44.16339 1.2143211
## 9.857143 4276.209 3445.646 -47.11581 1.2582525
## 10.000000 3245.473 3284.829 -50.72162 1.0035143
## 10.142857 2867.943 3454.053 -43.74646 0.8409634
## 10.285714 3454.683 3868.978 -29.20058 0.8997090
## 10.428571 3531.428 3810.902 -30.11631 0.9340461
## 10.571429 4003.508 3511.989 -38.64070 1.1526365
## 10.714286 3831.590 3238.937 -46.07459 1.2000486
## 10.857143 3563.770 2930.027 -54.40993 1.2393065
## 11.000000 2947.084 2910.898 -53.29105 1.0313119
## 11.142857 2271.394 2629.024 -60.54013 0.8843325
## 11.285714 2362.134 2690.785 -56.66156 0.8967435
## 11.428571 2169.008 2464.192 -62.05064 0.9029477
## 11.571429 2785.789 2552.723 -57.27523 1.1163483
## 11.714286 3048.104 2694.099 -50.97537 1.1532201
## 11.857143 2948.407 2424.509 -57.90833 1.2458408
## 12.000000 2401.571 2474.674 -54.48097 0.9923053
## 12.142857 2031.679 2310.821 -57.94952 0.9018175
## 12.285714 1995.819 2349.350 -54.88989 0.8698426
## 12.428571 2205.567 2432.045 -50.52663 0.9261178
## 12.571429 3268.953 2872.214 -34.96515 1.1521560
## 12.714286 3260.300 2973.200 -30.65371 1.1079859
## 12.857143 3650.480 2907.278 -31.77218 1.2695089
## 13.000000 2887.307 2998.728 -27.86442 0.9718745
## 13.142857 2752.976 3025.260 -26.13936 0.9179277
xhat2.opt <- winter2.opt$fitted[,2]
#Forecast
forecast2 <- predict(winter2, n.ahead = 21)
forecast2.opt <- predict(winter2.opt, n.ahead = 21)
#Plot time series
plot(training.ts,main="Winter 0.2;0.1;0.1",type="l",col="black",
xlim=c(1,25),pch=12)
lines(xhat2,type="l",col="red")
lines(xhat2.opt,type="l",col="blue")
lines(forecast2,type="l",col="red")
lines(forecast2.opt,type="l",col="blue")
legend("topleft",c("Actual Data",expression(paste(winter2)),
expression(paste(winter2.opt))),cex=0.5,
col=c("black","red","blue"),lty=1)
#Akurasi data training
SSE2<-winter2$SSE
MSE2<-winter2$SSE/length(training.ts)
RMSE2<-sqrt(MSE2)
fitted_values <- winter2$fitted[,1]
abs_error <- abs(training.ts - fitted_values)
MAPE2 <- mean(abs_error / training.ts * 100)
akurasi2 <- matrix(c(SSE2,MSE2,RMSE2, MAPE2))
row.names(akurasi2)<- c("SSE2", "MSE2", "RMSE2", "MAPE2")
colnames(akurasi2) <- c("Akurasi lamda=0.2")
akurasi2
## Akurasi lamda=0.2
## SSE2 6.508645e+07
## MSE2 7.568191e+05
## RMSE2 8.699535e+02
## MAPE2 1.905108e+01
SSE2.opt<-winter2.opt$SSE
MSE2.opt<-winter2.opt$SSE/length(training.ts)
RMSE2.opt<-sqrt(MSE2.opt)
fitted_values <- winter2.opt$fitted[,1]
abs_error <- abs(training.ts - fitted_values)
MAPE2.opt <- mean(abs_error / training.ts * 100)
akurasi2.opt <- matrix(c(SSE2.opt,MSE2.opt,RMSE2.opt,MAPE2.opt))
row.names(akurasi2.opt)<- c("SSE2.opt", "MSE2.opt", "RMSE2.opt", "MAPE2.opt")
colnames(akurasi2.opt) <- c("Akurasi")
akurasi2.opt
## Akurasi
## SSE2.opt 5.579296e+07
## MSE2.opt 6.487554e+05
## RMSE2.opt 8.054535e+02
## MAPE2.opt 1.751440e+01
akurasi2.train = data.frame(Model_Winter = c("Winter 2","winter2 optimal"),
Nilai_SSE=c(SSE2,SSE2.opt),
Nilai_MSE=c(MSE2,MSE2.opt),Nilai_RMSE=c(RMSE2,RMSE2.opt),Nilai_MAPE=c(MAPE2,MAPE2.opt))
akurasi2.train
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE Nilai_MAPE
## 1 Winter 2 65086445 756819.1 869.9535 19.05108
## 2 winter2 optimal 55792962 648755.4 805.4535 17.51440
Hasil akurasi data latih menunjukkan bahwa skenario 2 (winter2 optimal) lebih baik dari skenario 1 (winter1) karena nilai SSE, MSE dan RMSE, dan MAPE nya lebih kecil. Selain itu nilai MAPE juga lebih kecil serta dibawah 20% yang menandakan bahwa nilai ini dapat dikategorikan sebagai nilai akurasi yang baik.
#Akurasi Data Testing
forecast2<-data.frame(forecast2)
testing.ts<-data.frame(testing.ts)
selisih2<-forecast2-testing.ts
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(testing.ts)
RMSEtesting2 <- sqrt(MSEtesting2)
MAPEtesting2<-sum(abs(selisih2/testing.ts$Penumpang)*100)/length(testing.ts$Penumpang)
akurasi2 <- matrix(c(SSEtesting2, MSEtesting2, RMSEtesting2, MAPEtesting2))
row.names(akurasi2) <- c("SSE2", "MSE2", "RMSE2","MAPE2" )
colnames(akurasi2) <- c("Akurasi lambda=0.2")
akurasi2
## Akurasi lambda=0.2
## SSE2 5.773651e+06
## MSE2 5.773651e+06
## RMSE2 2.402842e+03
## MAPE2 1.689884e+01
forecast2.opt<-data.frame(forecast2.opt)
selisih2.opt<-forecast2.opt-testing.ts
SSEtesting2.opt<-sum(selisih2.opt^2)
MSEtesting2.opt<-SSEtesting2.opt/length(testing.ts)
RMSEtesting2.opt <- sqrt(MSEtesting2.opt)
MAPEtesting2.opt<-sum(abs(selisih2.opt/testing.ts$Penumpang)*100)/length(testing.ts$Penumpang)
akurasi2.opt <- matrix(c(SSEtesting2.opt, MSEtesting2.opt, RMSEtesting2.opt,MAPEtesting2.opt))
row.names(akurasi2.opt) <- c("SSE2", "MSE2", "RMSE2", "MAPE2")
colnames(akurasi2.opt) <- c("Akurasi Optimal")
akurasi2.opt
## Akurasi Optimal
## SSE2 5.350154e+06
## MSE2 5.350154e+06
## RMSE2 2.313040e+03
## MAPE2 1.389459e+01
akurasi2.test = data.frame(Model_Winter = c("Winter2","Winter2 optimal"),
Nilai_SSE=c(SSEtesting2,SSEtesting2.opt),
Nilai_MSE=c(MSEtesting2,MSEtesting2.opt), Nilai_RMSE=c(RMSEtesting2,RMSEtesting2.opt), Nilai_MAPE=c(MAPEtesting2, MAPEtesting2.opt))
akurasi2.test
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE Nilai_MAPE
## 1 Winter2 5773651 5773651 2402.842 16.89884
## 2 Winter2 optimal 5350154 5350154 2313.040 13.89459
Pada akurasi data uji ini juga terbukti bahwa parameter optimum menghasilkan nilai akurasi yang lebih baik dan nilai MAPE yang lebih baik dari model Winter1. Nilai MAPE pada parameter optimum ini sebesar 13,8% sehingga dapat dikategorikan model yang baik.
akurasi1.train
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE Nilai_MAPE
## 1 Winter 1 82026325 953794.5 976.6240 22.34119
## 2 Winter1 optimal 66625445 774714.5 880.1787 19.76760
akurasi2.train
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE Nilai_MAPE
## 1 Winter 2 65086445 756819.1 869.9535 19.05108
## 2 winter2 optimal 55792962 648755.4 805.4535 17.51440
akurasi1.test
## Model_Winter Nilai_SSE Nilai_MSE Nilai_MAPE
## 1 Winter 1 5811317 5811317 16.68141
## 2 Winter1 optimal 4139527 4139527 12.95398
akurasi2.test
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE Nilai_MAPE
## 1 Winter2 5773651 5773651 2402.842 16.89884
## 2 Winter2 optimal 5350154 5350154 2313.040 13.89459
Berdasarkan hasil uji yang telah dilakukan, pemulusan dengan winter aditif memiliki nilai MAPE yang lebih kecil daripada Winter Multiplikatif pada data uji, sedangkan pemulusan dengan winter multiplikatif memiliki nilai MAPE yang lebih kecil dari winter aditif pada data latih. Hal ini berarti kedua model pemulusan ini merupakan model yang baik, tetapi jika dalam hal memprediksi data baru maka model winter aditif merupakann model yang lebih baik karena memiliki nilai MAPE yang lebih kecil pada data ujinya.
Berdasarkan hasil peramalan dan pemulusan yang telah dilakukan, model Winter Aditif dan Winter Multiplikatif merupakan model smoothing terbaik karena memiliki MAPE dibawah 15% dimana nilai ini masuk dalam kategori model yang baik. Model pada kedua metode tersebut memperoleh MAPE terbaik ketika parameter yang digunakan adalah parameter optimum. Model lain seperti SMA,DMA,SSE, dan DSE memiliki nilai MAPE yang cukup besar yaitu diatas 20% sehingga bukan model terbaik.
Hasil pemulusan dan peramalan dengan model Winter Multiplikatif dan aditif adalah sebagai berikut.
#Plot time series hasil pemulusan & peramalan menggunakan metode Winter Aditive Optimum
forecast1.opt <- predict(winter1.opt, n.ahead = 21)
plot(training.ts, main="Metode Winter", type="l", col="black",
xlim=c(1,17), pch=12)
lines(xhat1.opt, type="l", col="blue")
lines(forecast1.opt, type="l", col="blue")
legend("topleft", c("Actual Data", expression(paste(winter1.opt))),
cex=0.5, col=c("black", "blue"), lty=1)
#Plot time series hasil pemulusan & peramalan menggunakan metode Winter Multiplikatif Optimum
forecast2.opt <- predict(winter2.opt, n.ahead = 21)
plot(training.ts, main="Metode Winter", type="l", col="black",
xlim=c(1,17), pch=12)
lines(xhat2.opt, type="l", col="blue")
lines(forecast2.opt, type="l", col="blue")
legend("topleft", c("Actual Data", expression(paste(winter2.opt))),
cex=0.5, col=c("black", "blue"), lty=1)