require("forecast")
require("graphics")
require("TTR")
require("TSA")
require("readr")
require("dplyr")
require("knitr")
data <- read_csv("D:/STATATISTIKA/SEM5/MPDW/srilangka_updated.csv")
colnames(data) <- c("Tanggal", "Jumlah.Pengunjung")
# ambil hanya 1/5 data awal
data <- data[1:120,]
kable(head(data))
| Tanggal | Jumlah.Pengunjung |
|---|---|
| 2023-01-01 | 2246 |
| 2023-01-02 | 3633 |
| 2023-01-03 | 2982 |
| 2023-01-04 | 2694 |
| 2023-01-05 | 3512 |
| 2023-01-06 | 3035 |
str(data)
## tibble [120 × 2] (S3: tbl_df/tbl/data.frame)
## $ Tanggal : Date[1:120], format: "2023-01-01" "2023-01-02" ...
## $ Jumlah.Pengunjung: num [1:120] 2246 3633 2982 2694 3512 ...
dim(data)
## [1] 120 2
data.ts <- ts(data$Jumlah.Pengunjung)
Menampilkan ringkasan data
summary(data.ts)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2240 3202 3624 3676 4036 5846
Membuat plot data deret waktu
ts.plot(data.ts, xlab="Tanggal ", ylab="Jumlah Kedatangan Turis",
main = "Time Series Plot")
Menyimpan plot
#menyimpan plot
#dev.copy(png, "eksplorasi.png")
#dev.off()
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
# data hanya 120, bagi 80% data latih dan 20% data uji
data_train <- data[1:96,]
data_test <- data[97:120,]
data_train.ts <- ts(data_train$Jumlah.Pengunjung)
data_test.ts <- ts(data_test$Jumlah.Pengunjung)
Eksplorasi data dilakukan pada keseluruhan data, data latih serta data uji menggunakan plot data deret waktu.
#eksplorasi keseluruhan data
plot(data.ts, col="red",main="Plot semua data")
points(data.ts)
#eksplorasi data latih
plot(data_train.ts, col="blue",main="Plot data latih")
points(data_train.ts)
#eksplorasi data uji
plot(data_test.ts, col="blue",main="Plot data uji")
points(data_test.ts)
#Eksplorasi dengan GGPLOT
library(ggplot2)
ggplot() +
geom_line(data = data, aes(x = Tanggal, y = Jumlah.Pengunjung, col = "Data Latih")) +
geom_line(data = data_test, aes(x = Tanggal, y = Jumlah.Pengunjung, col = "Data Uji")) +
labs(x = "Tanggal", y = "Jumlah Turis 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))
Pemulusan menggunakan metode SMA dilakukan dengan fungsi
SMA(). Dalam hal ini akan dilakukan pemulusan dengan
parameter m=3.
data.sma<-SMA(data_train.ts, n=3)
data.sma
## Time Series:
## Start = 1
## End = 96
## Frequency = 1
## [1] NA NA 2953.667 3103.000 3062.667 3080.333 3106.667 2906.667
## [9] 3163.667 3319.000 3249.000 3439.667 3467.000 3545.333 3147.000 3376.333
## [17] 3481.667 3669.333 3657.333 3741.667 3535.000 3222.667 3385.667 3392.333
## [25] 3371.333 3332.667 3434.333 3403.333 3153.667 3308.333 3406.333 3403.333
## [33] 3411.667 3711.333 3775.333 3660.000 3848.333 4019.667 4051.000 4035.333
## [41] 4333.667 4332.333 3984.000 3913.333 3831.333 3769.000 3724.667 4023.333
## [49] 4039.333 3766.667 3861.667 3803.000 3797.333 3801.000 4053.333 4116.667
## [57] 3597.667 3615.333 3392.000 3712.667 3704.000 4285.333 4169.333 3946.667
## [65] 3835.667 3676.667 3732.000 3559.667 3935.667 4713.333 4462.333 4819.333
## [73] 3937.000 4151.000 3816.000 4004.333 3914.333 3653.000 4092.000 3986.000
## [81] 4013.667 3580.000 4065.333 4352.333 4548.667 4428.667 3882.333 3635.000
## [89] 3608.667 4168.333 4372.000 4179.000 4160.333 3834.333 3673.000 3514.000
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
## [1] NA NA NA 2953.667 3103.000 3062.667 3080.333 3106.667
## [9] 2906.667 3163.667 3319.000 3249.000 3439.667 3467.000 3545.333 3147.000
## [17] 3376.333 3481.667 3669.333 3657.333 3741.667 3535.000 3222.667 3385.667
## [25] 3392.333 3371.333 3332.667 3434.333 3403.333 3153.667 3308.333 3406.333
## [33] 3403.333 3411.667 3711.333 3775.333 3660.000 3848.333 4019.667 4051.000
## [41] 4035.333 4333.667 4332.333 3984.000 3913.333 3831.333 3769.000 3724.667
## [49] 4023.333 4039.333 3766.667 3861.667 3803.000 3797.333 3801.000 4053.333
## [57] 4116.667 3597.667 3615.333 3392.000 3712.667 3704.000 4285.333 4169.333
## [65] 3946.667 3835.667 3676.667 3732.000 3559.667 3935.667 4713.333 4462.333
## [73] 4819.333 3937.000 4151.000 3816.000 4004.333 3914.333 3653.000 4092.000
## [81] 3986.000 4013.667 3580.000 4065.333 4352.333 4548.667 4428.667 3882.333
## [89] 3635.000 3608.667 4168.333 4372.000 4179.000 4160.333 3834.333 3673.000
## [97] 3514.000
Selanjutnya akan dilakukan peramalan sejumlah data uji yaitu 24 periode. Pada metode SMA, hasil peramalan 24 periode ke depan akan bernilai sama dengan hasil peramalan 1 periode kedepan. Dalam hal ini akan dilakukan pengguabungan data aktual train, data hasil pemulusan dan data hasil ramalan 24 periode kedepan.
data.gab<-cbind(aktual=c(data_train.ts,rep(NA,24)),pemulusan=c(data.sma,rep(NA,24)),ramalan=c(data.ramal,rep(data.ramal[length(data.ramal)],23)))
data.gab
## aktual pemulusan ramalan
## [1,] 2246 NA NA
## [2,] 3633 NA NA
## [3,] 2982 2953.667 NA
## [4,] 2694 3103.000 2953.667
## [5,] 3512 3062.667 3103.000
## [6,] 3035 3080.333 3062.667
## [7,] 2773 3106.667 3080.333
## [8,] 2912 2906.667 3106.667
## [9,] 3806 3163.667 2906.667
## [10,] 3239 3319.000 3163.667
## [11,] 2702 3249.000 3319.000
## [12,] 4378 3439.667 3249.000
## [13,] 3321 3467.000 3439.667
## [14,] 2937 3545.333 3467.000
## [15,] 3183 3147.000 3545.333
## [16,] 4009 3376.333 3147.000
## [17,] 3253 3481.667 3376.333
## [18,] 3746 3669.333 3481.667
## [19,] 3973 3657.333 3669.333
## [20,] 3506 3741.667 3657.333
## [21,] 3126 3535.000 3741.667
## [22,] 3036 3222.667 3535.000
## [23,] 3995 3385.667 3222.667
## [24,] 3146 3392.333 3385.667
## [25,] 2973 3371.333 3392.333
## [26,] 3879 3332.667 3371.333
## [27,] 3451 3434.333 3332.667
## [28,] 2880 3403.333 3434.333
## [29,] 3130 3153.667 3403.333
## [30,] 3915 3308.333 3153.667
## [31,] 3174 3406.333 3308.333
## [32,] 3121 3403.333 3406.333
## [33,] 3940 3411.667 3403.333
## [34,] 4073 3711.333 3411.667
## [35,] 3313 3775.333 3711.333
## [36,] 3594 3660.000 3775.333
## [37,] 4638 3848.333 3660.000
## [38,] 3827 4019.667 3848.333
## [39,] 3688 4051.000 4019.667
## [40,] 4591 4035.333 4051.000
## [41,] 4722 4333.667 4035.333
## [42,] 3684 4332.333 4333.667
## [43,] 3546 3984.000 4332.333
## [44,] 4510 3913.333 3984.000
## [45,] 3438 3831.333 3913.333
## [46,] 3359 3769.000 3831.333
## [47,] 4377 3724.667 3769.000
## [48,] 4334 4023.333 3724.667
## [49,] 3407 4039.333 4023.333
## [50,] 3559 3766.667 4039.333
## [51,] 4619 3861.667 3766.667
## [52,] 3231 3803.000 3861.667
## [53,] 3542 3797.333 3803.000
## [54,] 4630 3801.000 3797.333
## [55,] 3988 4053.333 3801.000
## [56,] 3732 4116.667 4053.333
## [57,] 3073 3597.667 4116.667
## [58,] 4041 3615.333 3597.667
## [59,] 3062 3392.000 3615.333
## [60,] 4035 3712.667 3392.000
## [61,] 4015 3704.000 3712.667
## [62,] 4806 4285.333 3704.000
## [63,] 3687 4169.333 4285.333
## [64,] 3347 3946.667 4169.333
## [65,] 4473 3835.667 3946.667
## [66,] 3210 3676.667 3835.667
## [67,] 3513 3732.000 3676.667
## [68,] 3956 3559.667 3732.000
## [69,] 4338 3935.667 3559.667
## [70,] 5846 4713.333 3935.667
## [71,] 3203 4462.333 4713.333
## [72,] 5409 4819.333 4462.333
## [73,] 3199 3937.000 4819.333
## [74,] 3845 4151.000 3937.000
## [75,] 4404 3816.000 4151.000
## [76,] 3764 4004.333 3816.000
## [77,] 3575 3914.333 4004.333
## [78,] 3620 3653.000 3914.333
## [79,] 5081 4092.000 3653.000
## [80,] 3257 3986.000 4092.000
## [81,] 3703 4013.667 3986.000
## [82,] 3780 3580.000 4013.667
## [83,] 4713 4065.333 3580.000
## [84,] 4564 4352.333 4065.333
## [85,] 4369 4548.667 4352.333
## [86,] 4353 4428.667 4548.667
## [87,] 2925 3882.333 4428.667
## [88,] 3627 3635.000 3882.333
## [89,] 4274 3608.667 3635.000
## [90,] 4604 4168.333 3608.667
## [91,] 4238 4372.000 4168.333
## [92,] 3695 4179.000 4372.000
## [93,] 4548 4160.333 4179.000
## [94,] 3260 3834.333 4160.333
## [95,] 3211 3673.000 3834.333
## [96,] 4071 3514.000 3673.000
## [97,] NA NA 3514.000
## [98,] NA NA 3514.000
## [99,] NA NA 3514.000
## [100,] NA NA 3514.000
## [101,] NA NA 3514.000
## [102,] NA NA 3514.000
## [103,] NA NA 3514.000
## [104,] NA NA 3514.000
## [105,] NA NA 3514.000
## [106,] NA NA 3514.000
## [107,] NA NA 3514.000
## [108,] NA NA 3514.000
## [109,] NA NA 3514.000
## [110,] NA NA 3514.000
## [111,] NA NA 3514.000
## [112,] NA NA 3514.000
## [113,] NA NA 3514.000
## [114,] NA NA 3514.000
## [115,] NA NA 3514.000
## [116,] NA NA 3514.000
## [117,] NA NA 3514.000
## [118,] NA NA 3514.000
## [119,] NA NA 3514.000
## [120,] NA NA 3514.000
Adapun plot data deret waktu dari hasil peramalan yang dilakukan adalah sebagai berikut.
ts.plot(data.ts, xlab="Tanggal ", ylab="Jumlah Kedatangan Turis", main= "SMA N=3 Data Jumlah Kedatangan Turis")
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)
Selanjutnya perhitungan akurasi dilakukan dengan ukuran akurasi Sum Squares Error (SSE), Mean Square Error (MSE) dan Mean Absolute Percentage Error (MAPE). Perhitungan akurasi dilakukan baik pada data latih maupun pada data uji.
#Menghitung nilai keakuratan data latih
error.train.sma = data_train.ts-data.ramal[1:length(data_train.ts)]
SSE.train.sma = sum(error.train.sma[4:length(data_train.ts)]^2)
MSE.train.sma = mean(error.train.sma[4:length(data_train.ts)]^2)
MAPE.train.sma = mean(abs((error.train.sma[4:length(data_train.ts)]/data_train.ts[4:length(data_train.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 = 3")
akurasi.train.sma
## Akurasi m = 3
## SSE 4.050540e+07
## MSE 4.355419e+05
## MAPE 1.441313e+01
Dalam hal ini nilai MAPE data latih pada metode pemulusan SMA kurang dari 15%, nilai ini dapat dikategorikan sebagai nilai akurasi yang cukup baik. Selanjutnya dilakukan perhitungan nilai MAPE data uji pada metde pemulusan SMA.
#Menghitung nilai keakuratan data uji
error.test.sma = data_test.ts-data.gab[97:120,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/data_test.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 = 3")
akurasi.test.sma
## Akurasi m = 3
## SSE 1.277789e+07
## MSE 5.324122e+05
## MAPE 1.802925e+01
Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE yang kurang dari 15% sehingga nilai akurasi ini dapat dikategorikan sebagai cukup baik.
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 5 kali.
dma <- SMA(data.sma, n = 5)
At <- 2*data.sma - dma
Bt <- 2/(4-1)*(data.sma - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)
t = 1:24
f = c()
for (i in t) {
f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}
data.gab2 <- cbind(aktual = c(data_train.ts,rep(NA,24)), pemulusan1 = c(data.sma,rep(NA,24)),pemulusan2 = c(data.dma, rep(NA,24)),At = c(At, rep(NA,24)), Bt = c(Bt,rep(NA,24)),ramalan = c(data.ramal2, f[-1]))
data.gab2
## aktual pemulusan1 pemulusan2 At Bt ramalan
## [1,] 2246 NA NA NA NA NA
## [2,] 3633 NA NA NA NA NA
## [3,] 2982 2953.667 NA NA NA NA
## [4,] 2694 3103.000 NA NA NA NA
## [5,] 3512 3062.667 NA NA NA NA
## [6,] 3035 3080.333 NA NA NA NA
## [7,] 2773 3106.667 3182.333 3152.067 30.266667 NA
## [8,] 2912 2906.667 2664.667 2761.467 -96.800000 3182.33333
## [9,] 3806 3163.667 3329.778 3263.333 66.444444 2664.66667
## [10,] 3239 3319.000 3658.556 3522.733 135.822222 3329.77778
## [11,] 2702 3249.000 3415.667 3349.000 66.666667 3658.55556
## [12,] 4378 3439.667 3813.111 3663.733 149.377778 3415.66667
## [13,] 3321 3467.000 3699.222 3606.333 92.888889 3813.11111
## [14,] 2937 3545.333 3780.889 3686.667 94.222222 3699.22222
## [15,] 3183 3147.000 2776.000 2924.400 -148.400000 3780.88889
## [16,] 4009 3376.333 3345.111 3357.600 -12.488889 2776.00000
## [17,] 3253 3481.667 3612.000 3559.867 52.133333 3345.11111
## [18,] 3746 3669.333 4045.000 3894.733 150.266667 3612.00000
## [19,] 3973 3657.333 3975.667 3848.333 127.333333 4045.00000
## [20,] 3506 3741.667 4002.333 3898.067 104.266667 3975.66667
## [21,] 3126 3535.000 3398.333 3453.000 -54.666667 4002.33333
## [22,] 3036 3222.667 2651.778 2880.133 -228.355556 3398.33333
## [23,] 3995 3385.667 3181.000 3262.867 -81.866667 2651.77778
## [24,] 3146 3392.333 3287.111 3329.200 -42.088889 3181.00000
## [25,] 2973 3371.333 3354.556 3361.267 -6.711111 3287.11111
## [26,] 3879 3332.667 3318.889 3324.400 -5.511111 3354.55556
## [27,] 3451 3434.333 3519.444 3485.400 34.044444 3318.88889
## [28,] 2880 3403.333 3430.889 3419.867 11.022222 3519.44444
## [29,] 3130 3153.667 2844.667 2968.267 -123.600000 3430.88889
## [30,] 3915 3308.333 3278.111 3290.200 -12.088889 2844.66667
## [31,] 3174 3406.333 3514.889 3471.467 43.422222 3278.11111
## [32,] 3121 3403.333 3517.222 3471.667 45.555556 3514.88889
## [33,] 3940 3411.667 3536.667 3486.667 50.000000 3517.22222
## [34,] 4073 3711.333 4149.889 3974.467 175.422222 3536.66667
## [35,] 3313 3775.333 4164.889 4009.067 155.822222 4149.88889
## [36,] 3594 3660.000 3772.778 3727.667 45.111111 4164.88889
## [37,] 4638 3848.333 4126.667 4015.333 111.333333 3772.77778
## [38,] 3827 4019.667 4380.889 4236.400 144.488889 4126.66667
## [39,] 3688 4051.000 4351.222 4231.133 120.088889 4380.88889
## [40,] 4591 4035.333 4222.778 4147.800 74.977778 4351.22222
## [41,] 4722 4333.667 4793.778 4609.733 184.044444 4222.77778
## [42,] 3684 4332.333 4628.889 4510.267 118.622222 4793.77778
## [43,] 3546 3984.000 3711.889 3820.733 -108.844444 4628.88889
## [44,] 4510 3913.333 3569.333 3706.933 -137.600000 3711.88889
## [45,] 3438 3831.333 3418.667 3583.733 -165.066667 3569.33333
## [46,] 3359 3769.000 3440.667 3572.000 -131.333333 3418.66667
## [47,] 4377 3724.667 3525.000 3604.867 -79.866667 3440.66667
## [48,] 4334 4023.333 4308.333 4194.333 114.000000 3525.00000
## [49,] 3407 4039.333 4309.000 4201.133 107.866667 4308.33333
## [50,] 3559 3766.667 3603.444 3668.733 -65.288889 4309.00000
## [51,] 4619 3861.667 3825.889 3840.200 -14.311111 3603.44444
## [52,] 3231 3803.000 3643.333 3707.200 -63.866667 3825.88889
## [53,] 3542 3797.333 3703.556 3741.067 -37.511111 3643.33333
## [54,] 4630 3801.000 3792.778 3796.067 -3.288889 3703.55556
## [55,] 3988 4053.333 4370.111 4243.400 126.711111 3792.77778
## [56,] 3732 4116.667 4454.000 4319.067 134.933333 4370.11111
## [57,] 3073 3597.667 3138.444 3322.133 -183.688889 4454.00000
## [58,] 4041 3615.333 3246.222 3393.867 -147.644444 3138.44444
## [59,] 3062 3392.000 2787.000 3029.000 -242.000000 3246.22222
## [60,] 4035 3712.667 3755.667 3738.467 17.200000 2787.00000
## [61,] 4015 3704.000 3870.111 3803.667 66.444444 3755.66667
## [62,] 4806 4285.333 5191.111 4828.800 362.311111 3870.11111
## [63,] 3687 4169.333 4697.111 4486.000 211.111111 5191.11111
## [64,] 3347 3946.667 3918.444 3929.733 -11.288889 4697.11111
## [65,] 4473 3835.667 3581.444 3683.133 -101.688889 3918.44444
## [66,] 3210 3676.667 3166.556 3370.600 -204.044444 3581.44444
## [67,] 3513 3732.000 3498.556 3591.933 -93.377778 3166.55556
## [68,] 3956 3559.667 3242.222 3369.200 -126.977778 3498.55556
## [69,] 4338 3935.667 4248.556 4123.400 125.155556 3242.22222
## [70,] 5846 4713.333 6029.778 5503.200 526.577778 4248.55556
## [71,] 3203 4462.333 5098.556 4844.067 254.488889 6029.77778
## [72,] 5409 4819.333 5688.111 5340.600 347.511111 5098.55556
## [73,] 3199 3937.000 3209.444 3500.467 -291.022222 5688.11111
## [74,] 3845 4151.000 3708.333 3885.400 -177.066667 3209.44444
## [75,] 4404 3816.000 3114.111 3394.867 -280.755556 3708.33333
## [76,] 3764 4004.333 3769.000 3863.133 -94.133333 3114.11111
## [77,] 3575 3914.333 3830.667 3864.133 -33.466667 3769.00000
## [78,] 3620 3653.000 3228.444 3398.267 -169.822222 3830.66667
## [79,] 5081 4092.000 4418.778 4288.067 130.711111 3228.44444
## [80,] 3257 3986.000 4079.444 4042.067 37.377778 4418.77778
## [81,] 3703 4013.667 4150.111 4095.533 54.577778 4079.44444
## [82,] 3780 3580.000 3105.111 3295.067 -189.955556 4150.11111
## [83,] 4713 4065.333 4261.889 4183.267 78.622222 3105.11111
## [84,] 4564 4352.333 4940.444 4705.200 235.244444 4261.88889
## [85,] 4369 4548.667 5276.444 4985.333 291.111111 4940.44444
## [86,] 4353 4428.667 4818.111 4662.333 155.777778 5276.44444
## [87,] 2925 3882.333 3260.444 3509.200 -248.755556 4818.11111
## [88,] 3627 3635.000 2744.333 3100.600 -356.266667 3260.44444
## [89,] 4274 3608.667 2922.000 3196.667 -274.666667 2744.33333
## [90,] 4604 4168.333 4541.222 4392.067 149.155556 2922.00000
## [91,] 4238 4372.000 5103.222 4810.733 292.488889 4541.22222
## [92,] 3695 4179.000 4489.667 4365.400 124.266667 5103.22222
## [93,] 4548 4160.333 4264.778 4223.000 41.777778 4489.66667
## [94,] 3260 3834.333 3320.222 3525.867 -205.644444 4264.77778
## [95,] 3211 3673.000 3055.111 3302.267 -247.155556 3320.22222
## [96,] 4071 3514.000 2917.111 3155.867 -238.755556 3055.11111
## [97,] NA NA NA NA NA 2917.11111
## [98,] NA NA NA NA NA 2678.35556
## [99,] NA NA NA NA NA 2439.60000
## [100,] NA NA NA NA NA 2200.84444
## [101,] NA NA NA NA NA 1962.08889
## [102,] NA NA NA NA NA 1723.33333
## [103,] NA NA NA NA NA 1484.57778
## [104,] NA NA NA NA NA 1245.82222
## [105,] NA NA NA NA NA 1007.06667
## [106,] NA NA NA NA NA 768.31111
## [107,] NA NA NA NA NA 529.55556
## [108,] NA NA NA NA NA 290.80000
## [109,] NA NA NA NA NA 52.04444
## [110,] NA NA NA NA NA -186.71111
## [111,] NA NA NA NA NA -425.46667
## [112,] NA NA NA NA NA -664.22222
## [113,] NA NA NA NA NA -902.97778
## [114,] NA NA NA NA NA -1141.73333
## [115,] NA NA NA NA NA -1380.48889
## [116,] NA NA NA NA NA -1619.24444
## [117,] NA NA NA NA NA -1858.00000
## [118,] NA NA NA NA NA -2096.75556
## [119,] NA NA NA NA NA -2335.51111
## [120,] NA NA NA NA NA -2574.26667
Hasil pemulusan menggunakan metode DMA divisualisasikan sebagai berikut
ts.plot(data.ts, xlab="Tanggal", ylab="Jumlah Kedatangan Turis", main= "DMA N=5 Data Jumlah Kedatangan Turis")
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)
Selanjutnya perhitungan akurasi dilakukan baik pada data latih maupun data uji. Perhitungan akurasi dilakukan dengan ukuran akurasi SSE, MSE dan MAPE.
error.train.dma = data_train.ts-data.ramal2[1:length(data_train.ts)]
SSE.train.dma = sum(error.train.dma[8:length(data_train.ts)]^2)
MSE.train.dma = mean(error.train.dma[8:length(data_train.ts)]^2)
MAPE.train.dma = mean(abs((error.train.dma[8:length(data_train.ts)]/data_train.ts[8:length(data_train.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 = 2")
akurasi.train.dma
## Akurasi m = 2
## SSE 7.434954e+07
## MSE 8.353880e+05
## MAPE 1.948173e+01
Perhitungan akurasi pada data latih menggunakan nilai MAPE menghasilkan nilai MAPE yang kurang dari 20% sehingga dikategorikan cukup baik. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.
error.test.dma = data_test.ts-data.gab2[97:120,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/data_test.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 = 6")
akurasi.test.dma
## Akurasi m = 6
## SSE 3.425514e+08
## MSE 1.427297e+07
## MAPE 9.279410e+01
Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE yang kurang dari 21% sehingga nilai akurasi ini dapat dikategorikan sebagai cukup baik.
Pada data latih, metode SMA lebih baik dibandingkan dengan metode DMA, sedangkan pada data uji, metode DMA lebih baik dibandingkan SMA
Metode Exponential Smoothing adalah metode pemulusan dengan melakukan pembobotan menurun secara eksponensial. Nilai yang lebih baru diberi bobot yang lebih besar dari nilai terdahulu. Terdapat satu atau lebih parameter pemulusan yang ditentukan secara eksplisit, dan hasil pemilihan parameter tersebut akan menentukan bobot yang akan diberikan pada nilai pengamatan. Ada dua macam model, yaitu model tunggal dan ganda.
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
#membagi training dan testing
training<-data[1: 96,]
testing<-data[97:120,]
train.ts <- ts(training$Jumlah.Pengunjung)
test.ts <- ts(testing$Jumlah.Pengunjung)
Single Exponential Smoothing merupakan metode pemulusan yang tepat digunakan untuk data dengan pola stasioner atau konstan.
Nilai pemulusan pada periode ke-t didapat dari persamaan:
\[ \tilde{y}_T=\lambda y_t+(1-\lambda)\tilde{y}_{T-1} \]
Nilai parameter \(\lambda\) adalah nilai antara 0 dan 1.
Nilai pemulusan periode ke-t bertindak sebagai nilai ramalan pada periode ke-\((T+\tau)\).
\[ \tilde{y}_{T+\tau}(T)=\tilde{y}_T \]
Pemulusan dengan metode SES dapat dilakukan dengan dua fungsi dari
packages berbeda, yaitu (1) fungsi ses() dari
packages forecast dan (2) fungsi
HoltWinters dari packages stats .
#Cara 1 (fungsi ses)
ses.1 <- ses(train.ts, h = 24, alpha = 0.2)
plot(ses.1)
ses.1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3865.948 3069.877 4662.020 2648.462 5083.434
## 98 3865.948 3054.112 4677.785 2624.351 5107.545
## 99 3865.948 3038.647 4693.250 2600.700 5131.197
## 100 3865.948 3023.466 4708.431 2577.482 5154.415
## 101 3865.948 3008.553 4723.343 2554.676 5177.221
## 102 3865.948 2993.896 4738.001 2532.259 5199.638
## 103 3865.948 2979.481 4752.416 2510.213 5221.683
## 104 3865.948 2965.297 4766.600 2488.520 5243.377
## 105 3865.948 2951.332 4780.565 2467.163 5264.733
## 106 3865.948 2937.578 4794.319 2446.128 5285.769
## 107 3865.948 2924.024 4807.873 2425.400 5306.497
## 108 3865.948 2910.663 4821.234 2404.965 5326.932
## 109 3865.948 2897.486 4834.411 2384.813 5347.084
## 110 3865.948 2884.486 4847.411 2364.931 5366.966
## 111 3865.948 2871.656 4860.241 2345.309 5386.588
## 112 3865.948 2858.989 4872.908 2325.937 5405.960
## 113 3865.948 2846.480 4885.417 2306.806 5425.091
## 114 3865.948 2834.122 4897.775 2287.906 5443.991
## 115 3865.948 2821.911 4909.986 2269.230 5462.666
## 116 3865.948 2809.840 4922.056 2250.771 5481.126
## 117 3865.948 2797.907 4933.990 2232.519 5499.377
## 118 3865.948 2786.105 4945.792 2214.470 5517.427
## 119 3865.948 2774.430 4957.466 2196.616 5535.281
## 120 3865.948 2762.880 4969.017 2178.950 5552.947
ses.2<- ses(train.ts, h = 24, alpha = 0.7)
plot(ses.2)
ses.2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3846.743 2878.4427 4815.043 2365.85548 5327.631
## 98 3846.743 2664.7819 5028.704 2039.08939 5654.397
## 99 3846.743 2484.2237 5209.263 1762.94951 5930.537
## 100 3846.743 2324.9396 5368.547 1519.34551 6174.141
## 101 3846.743 2180.8162 5512.670 1298.92770 6394.559
## 102 3846.743 2048.2050 5645.281 1096.11642 6597.370
## 103 3846.743 1924.7217 5768.764 907.26510 6786.221
## 104 3846.743 1808.7066 5884.780 729.83522 6963.651
## 105 3846.743 1698.9490 5994.537 561.97545 7131.511
## 106 3846.743 1594.5339 6098.952 402.28635 7291.200
## 107 3846.743 1494.7497 6198.737 249.67956 7443.807
## 108 3846.743 1399.0299 6294.456 103.28882 7590.197
## 109 3846.743 1306.9150 6386.571 -37.58873 7731.075
## 110 3846.743 1218.0260 6475.460 -173.53270 7867.019
## 111 3846.743 1132.0460 6561.440 -305.02777 7998.514
## 112 3846.743 1048.7069 6644.779 -432.48407 8125.970
## 113 3846.743 967.7791 6725.707 -556.25235 8249.739
## 114 3846.743 889.0649 6804.421 -676.63536 8370.122
## 115 3846.743 812.3919 6881.094 -793.89657 8487.383
## 116 3846.743 737.6092 6955.877 -908.26692 8601.753
## 117 3846.743 664.5834 7028.903 -1019.95025 8713.436
## 118 3846.743 593.1962 7100.290 -1129.12747 8822.614
## 119 3846.743 523.3421 7170.144 -1235.96009 8929.446
## 120 3846.743 454.9264 7238.560 -1340.59297 9034.079
autoplot(ses.1) +
autolayer(fitted(ses.1), series="Fitted") +
ylab("Membaca") + xlab("Periode")
Pada fungsi ses() , terdapat beberapa argumen yang umum
digunakan, yaitu nilia y , gamma ,
beta , alpha , dan h .
Nilai y adalah nilai data deret waktu,
gamma adalah parameter pemulusan untuk komponen musiman,
beta adalah parameter pemulusan untuk tren, dan
alpha adalah parameter pemulusan untuk stasioner, serta
h adalah banyaknya periode yang akan diramalkan.
Kasus di atas merupakan contoh inisialisasi nilai parameter \(\lambda\) dengan nilai alpha
0,2 dan 0,7 dan banyak periode data yang akan diramalkan adalah sebanyak
24 periode. Selanjutnya akan digunakan fungsi HoltWinters()
dengan nilai inisialisasi parameter dan panjang periode peramalan yang
sama dengan fungsi ses() .
#Cara 2 (fungsi Holtwinter)
ses1<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.2)
plot(ses1)
#ramalan
ramalan1<- forecast(ses1, h=24)
ramalan1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3865.948 3059.154 4672.743 2632.062 5099.834
## 98 3865.948 3043.176 4688.721 2607.627 5124.270
## 99 3865.948 3027.503 4704.394 2583.656 5148.240
## 100 3865.948 3012.117 4719.780 2560.126 5171.771
## 101 3865.948 2997.004 4734.893 2537.013 5194.884
## 102 3865.948 2982.149 4749.748 2514.294 5217.603
## 103 3865.948 2967.540 4764.357 2491.951 5239.946
## 104 3865.948 2953.164 4778.732 2469.966 5261.931
## 105 3865.948 2939.012 4792.885 2448.321 5283.575
## 106 3865.948 2925.072 4806.825 2427.002 5304.894
## 107 3865.948 2911.336 4820.561 2405.995 5325.902
## 108 3865.948 2897.795 4834.102 2385.285 5346.612
## 109 3865.948 2884.440 4847.457 2364.861 5367.036
## 110 3865.948 2871.265 4860.632 2344.712 5387.185
## 111 3865.948 2858.262 4873.635 2324.825 5407.072
## 112 3865.948 2845.425 4886.472 2305.192 5426.704
## 113 3865.948 2832.747 4899.150 2285.803 5446.093
## 114 3865.948 2820.223 4911.674 2266.649 5465.247
## 115 3865.948 2807.847 4924.050 2247.722 5484.175
## 116 3865.948 2795.614 4936.283 2229.014 5502.883
## 117 3865.948 2783.520 4948.377 2210.517 5521.380
## 118 3865.948 2771.559 4960.338 2192.224 5539.673
## 119 3865.948 2759.727 4972.170 2174.129 5557.768
## 120 3865.948 2748.021 4983.876 2156.226 5575.671
ses2<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.7)
plot(ses2)
#ramalan
ramalan2<- forecast(ses2, h=24)
ramalan2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3846.743 2877.6896 4815.797 2364.70364 5328.783
## 98 3846.743 2663.8625 5029.624 2037.68339 5655.803
## 99 3846.743 2483.1639 5210.322 1761.32873 5932.157
## 100 3846.743 2323.7560 5369.730 1517.53526 6175.951
## 101 3846.743 2179.5204 5513.966 1296.94600 6396.540
## 102 3846.743 2046.8061 5646.680 1093.97698 6599.509
## 103 3846.743 1923.2268 5770.259 904.97877 6788.507
## 104 3846.743 1807.1214 5886.365 727.41089 6966.075
## 105 3846.743 1697.2784 5996.208 559.42055 7134.066
## 106 3846.743 1592.7821 6100.704 399.60725 7293.879
## 107 3846.743 1492.9203 6200.566 246.88176 7446.604
## 108 3846.743 1397.1261 6296.360 100.37716 7593.109
## 109 3846.743 1304.9396 6388.547 -40.60996 7734.096
## 110 3846.743 1215.9814 6477.505 -176.65968 7870.146
## 111 3846.743 1129.9346 6563.552 -308.25702 8001.743
## 112 3846.743 1046.5305 6646.956 -435.81245 8129.299
## 113 3846.743 965.5399 6727.946 -559.67700 8253.163
## 114 3846.743 886.7644 6806.722 -680.15365 8373.640
## 115 3846.743 810.0318 6883.454 -797.50606 8490.992
## 116 3846.743 735.1909 6958.295 -911.96537 8605.452
## 117 3846.743 662.1083 7031.378 -1023.73556 8717.222
## 118 3846.743 590.6656 7102.821 -1132.99770 8826.484
## 119 3846.743 520.7572 7172.729 -1239.91342 8933.400
## 120 3846.743 452.2882 7241.198 -1344.62769 9038.114
#SES
ses.opt <- ses(train.ts, h = 24, alpha = NULL)
plot(ses.opt)
ses.opt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3942.276 3163.865 4720.687 2751.799 5132.753
## 98 3942.276 3160.328 4724.224 2746.390 5138.163
## 99 3942.276 3156.806 4727.746 2741.004 5143.548
## 100 3942.276 3153.301 4731.251 2735.642 5148.910
## 101 3942.276 3149.811 4734.742 2730.305 5154.247
## 102 3942.276 3146.336 4738.216 2724.990 5159.562
## 103 3942.276 3142.876 4741.676 2719.699 5164.853
## 104 3942.276 3139.431 4745.121 2714.430 5170.122
## 105 3942.276 3136.001 4748.551 2709.184 5175.368
## 106 3942.276 3132.585 4751.967 2703.961 5180.591
## 107 3942.276 3129.184 4755.368 2698.759 5185.793
## 108 3942.276 3125.797 4758.755 2693.579 5190.973
## 109 3942.276 3122.424 4762.128 2688.420 5196.132
## 110 3942.276 3119.064 4765.488 2683.282 5201.270
## 111 3942.276 3115.719 4768.833 2678.166 5206.386
## 112 3942.276 3112.387 4772.166 2673.070 5211.483
## 113 3942.276 3109.068 4775.484 2667.994 5216.558
## 114 3942.276 3105.762 4778.790 2662.938 5221.614
## 115 3942.276 3102.469 4782.083 2657.903 5226.650
## 116 3942.276 3099.190 4785.363 2652.887 5231.666
## 117 3942.276 3095.922 4788.630 2647.890 5236.662
## 118 3942.276 3092.668 4791.884 2642.913 5241.639
## 119 3942.276 3089.426 4795.126 2637.954 5246.598
## 120 3942.276 3086.196 4798.356 2633.015 5251.537
#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.1667138
## beta : FALSE
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 3889.663
plot(sesopt)
#ramalan
ramalanopt<- forecast(sesopt, h=24)
ramalanopt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3889.663 3088.436 4690.891 2664.292 5115.035
## 98 3889.663 3077.378 4701.949 2647.380 5131.947
## 99 3889.663 3066.468 4712.858 2630.695 5148.631
## 100 3889.663 3055.701 4723.625 2614.229 5165.098
## 101 3889.663 3045.072 4734.255 2597.972 5181.355
## 102 3889.663 3034.574 4744.752 2581.917 5197.409
## 103 3889.663 3024.204 4755.123 2566.057 5213.269
## 104 3889.663 3013.957 4765.370 2550.385 5228.941
## 105 3889.663 3003.828 4775.499 2534.895 5244.432
## 106 3889.663 2993.813 4785.513 2519.579 5259.748
## 107 3889.663 2983.910 4795.417 2504.433 5274.894
## 108 3889.663 2974.113 4805.213 2489.450 5289.876
## 109 3889.663 2964.420 4814.906 2474.626 5304.700
## 110 3889.663 2954.828 4824.499 2459.956 5319.370
## 111 3889.663 2945.333 4833.993 2445.435 5333.892
## 112 3889.663 2935.933 4843.394 2431.058 5348.268
## 113 3889.663 2926.624 4852.702 2416.822 5362.505
## 114 3889.663 2917.405 4861.922 2402.722 5376.605
## 115 3889.663 2908.272 4871.055 2388.755 5390.572
## 116 3889.663 2899.223 4880.103 2374.916 5404.411
## 117 3889.663 2890.256 4889.070 2361.202 5418.124
## 118 3889.663 2881.369 4897.957 2347.611 5431.716
## 119 3889.663 2872.560 4906.767 2334.138 5445.188
## 120 3889.663 2863.826 4915.500 2320.781 5458.546
Setelah dilakukan peramalan, akan dilakukan perhitungan keakuratan hasil peramalan. Perhitungan akurasi ini dilakukan baik pada data latih dan data uji.
Perhitungan akurasi data dapat dilakukan dengan cara langsung maupun manual. Secara langsung, nilai akurasi dapat diambil dari objek yang tersimpan pada hasil SES, yaitu sum of squared errors (SSE). Nilai akurasi lain dapat dihitung pula dari nilai SSE tersebut.
#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.2")
akurasi1
## Akurasi lamda=0.2
## SSE 3.794535e+07
## MSE 3.952640e+05
## RMSE 6.287003e+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.7")
akurasi2
## Akurasi lamda=0.7
## SSE 5.380167e+07
## MSE 5.604341e+05
## RMSE 7.486215e+02
#Cara Manual
fitted1<-ramalan1$fitted
sisaan1<-ramalan1$residuals
head(sisaan1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 1387.0000 458.6000 78.8800 881.1040 227.8832
resid1<-training$Jumlah.Pengunjung-ramalan1$fitted
head(resid1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 1387.0000 458.6000 78.8800 881.1040 227.8832
#Cara Manual
SSE.1=sum(sisaan1[2:length(train.ts)]^2)
SSE.1
## [1] 37945345
MSE.1 = SSE.1/length(train.ts)
MSE.1
## [1] 395264
MAPE.1 = sum(abs(sisaan1[2:length(train.ts)]/train.ts[2:length(train.ts)])*
100)/length(train.ts)
MAPE.1
## [1] 13.44329
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.2")
akurasi.1
## Akurasi lamda=0.2
## SSE 3.794535e+07
## MSE 3.952640e+05
## MAPE 1.344329e+01
fitted2<-ramalan2$fitted
sisaan2<-ramalan2$residuals
head(sisaan2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 1387.0000 -234.9000 -358.4700 710.4590 -263.8623
resid2<-training$Jumlah.Pengunjung-ramalan2$fitted
head(resid2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 1387.0000 -234.9000 -358.4700 710.4590 -263.8623
SSE.2=sum(sisaan2[2:length(train.ts)]^2)
SSE.2
## [1] 53801672
MSE.2 = SSE.2/length(train.ts)
MSE.2
## [1] 560434.1
MAPE.2 = sum(abs(sisaan2[2:length(train.ts)]/train.ts[2:length(train.ts)])*
100)/length(train.ts)
MAPE.2
## [1] 16.2115
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.7")
akurasi.2
## Akurasi lamda=0.7
## SSE 5.380167e+07
## MSE 5.604341e+05
## MAPE 1.621150e+01
Berdasarkan nilai SSE, MSE, RMSE, dan MAPE di antara kedua parameter, nilai parameter \(\lambda=0,2\) menghasilkan akurasi yang lebih baik dibanding \(\lambda=0,7\) . Hal ini dilihat dari nilai masing-masing ukuran akurasi yang lebih kecil. Berdasarkan nilai MAPE-nya, hasil ini dapat dikategorikan sebagai peramalan cukup baik.
Akurasi data uji dapat dihitung dengan cara yang hampir sama dengan perhitungan akurasi data latih.
selisih1<-ramalan1$mean-testing$Jumlah.Pengunjung
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(testing)
selisih2<-ramalan2$mean-testing$Jumlah.Pengunjung
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(testing)
selisihopt<-ramalanopt$mean-testing$Jumlah.Pengunjung
SSEtestingopt<-sum(selisihopt^2)
MSEtestingopt<-SSEtestingopt/length(testing)
akurasitesting1 <- matrix(c(SSEtesting1,SSEtesting2,SSEtestingopt))
row.names(akurasitesting1)<- c("SSE1", "SSE2", "SSEopt")
akurasitesting1
## [,1]
## SSE1 17060669
## SSE2 16673594
## SSEopt 17563061
akurasitesting2 <- matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt))
row.names(akurasitesting2)<- c("MSE1", "MSE2", "MSEopt")
akurasitesting2
## [,1]
## MSE1 8530335
## MSE2 8336797
## MSEopt 8781531
#cara lain
accuracy(ramalanopt,testing$Jumlah.Pengunjung)
## ME RMSE MAE MPE MAPE MASE
## Training set 103.7810 630.5016 513.8202 0.9067151 13.49829 0.7428198
## Test set -453.2049 855.4497 689.9839 -18.3766570 23.24567 0.9974962
## ACF1
## Training set -0.1375338
## Test set NA
Metode pemulusan Double Exponential Smoothing (DES) digunakan untuk data yang memiliki pola tren. Metode DES adalah metode semacam SES, hanya saja dilakukan dua kali, yaitu pertama untuk tahapan ‘level’ dan kedua untuk tahapan ‘tren’. Pemulusan menggunakan metode ini akan menghasilkan peramalan tidak konstan untuk periode berikutnya.
#Lamda=0.2 dan gamma=0.2
des.1<- HoltWinters(train.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)
plot(des.1)
#ramalan
ramalandes1<- forecast(des.1, h=24)
ramalandes1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3789.426 2212.0824 5366.770 1377.08701 6201.766
## 98 3754.049 2131.9140 5376.185 1273.20736 6234.892
## 99 3718.673 2037.4873 5399.858 1147.52164 6289.823
## 100 3683.296 1927.9734 5438.618 998.76186 6367.829
## 101 3647.919 1803.0331 5492.804 826.40966 6469.428
## 102 3612.542 1662.7508 5562.333 630.59373 6594.490
## 103 3577.165 1507.5358 5646.794 411.94034 6742.390
## 104 3541.788 1338.0178 5745.558 171.41236 6912.164
## 105 3506.411 1154.9516 5857.871 -89.83593 7102.658
## 106 3471.034 959.1419 5982.927 -370.57363 7312.642
## 107 3435.657 751.3905 6119.924 -669.57448 7540.889
## 108 3400.280 532.4626 6268.098 -985.66837 7786.229
## 109 3364.903 303.0680 6426.739 -1317.76973 8047.577
## 110 3329.527 63.8532 6595.200 -1664.88987 8323.943
## 111 3294.150 -184.6000 6772.899 -2026.13888 8614.438
## 112 3258.773 -441.7716 6959.317 -2400.72140 8918.267
## 113 3223.396 -707.1984 7153.990 -2787.92926 9234.721
## 114 3188.019 -980.4686 7356.507 -3187.13269 9563.171
## 115 3152.642 -1261.2161 7566.500 -3597.77148 9903.056
## 116 3117.265 -1549.1143 7783.645 -4019.34642 10253.877
## 117 3081.888 -1843.8717 8007.648 -4451.41156 10615.188
## 118 3046.511 -2145.2270 8238.250 -4893.56729 10986.590
## 119 3011.134 -2452.9452 8475.214 -5345.45428 11367.723
## 120 2975.758 -2766.8143 8718.329 -5806.74820 11758.263
#Lamda=0.6 dan gamma=0.3
des.2<- HoltWinters(train.ts, gamma = FALSE, beta = 0.3, alpha = 0.6)
plot(des.2)
#ramalan
ramalandes2<- forecast(des.2, h=24)
ramalandes2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3673.080 2577.40213 4768.757 1997.3855 5348.774
## 98 3640.125 2250.55756 5029.693 1514.9648 5765.286
## 99 3607.171 1864.38955 5349.953 941.8167 6272.526
## 100 3574.217 1430.04598 5718.388 294.9904 6853.444
## 101 3541.263 954.90702 6127.619 -414.2270 7496.753
## 102 3508.309 443.93568 6572.682 -1178.2454 8194.863
## 103 3475.354 -99.37607 7050.085 -1991.7241 8942.433
## 104 3442.400 -672.44838 7557.249 -2850.7177 9735.518
## 105 3409.446 -1273.29006 8092.182 -3752.1808 10571.073
## 106 3376.492 -1900.30699 8653.291 -4693.6756 11446.659
## 107 3343.538 -2552.18434 9239.260 -5673.1911 12360.267
## 108 3310.584 -3227.81129 9848.978 -6689.0285 13310.196
## 109 3277.629 -3926.23104 10481.490 -7739.7244 14294.983
## 110 3244.675 -4646.60638 11135.957 -8823.9985 15313.349
## 111 3211.721 -5388.19528 11811.637 -9940.7160 16364.158
## 112 3178.767 -6150.33300 12507.867 -11088.8601 17446.394
## 113 3145.813 -6932.41877 13224.044 -12267.5122 18559.137
## 114 3112.858 -7733.90545 13959.622 -13475.8354 19701.552
## 115 3079.904 -8554.29159 14714.100 -14713.0629 20872.871
## 116 3046.950 -9393.11501 15487.015 -15978.4877 22072.388
## 117 3013.996 -10249.94767 16277.939 -17271.4553 23299.447
## 118 2981.042 -11124.39144 17086.475 -18591.3567 24553.440
## 119 2948.088 -12016.07463 17912.250 -19937.6236 25833.799
## 120 2915.133 -12924.64905 18754.916 -21309.7233 27139.990
Selanjutnya jika ingin membandingkan plot data latih dan data uji adalah sebagai berikut.
#Visually evaluate the prediction
plot(data.ts)
lines(des.1$fitted[,1], lty=2, col="blue")
lines(ramalandes1$mean, col="red")
#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.4376677
## beta : 0.401815
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 3641.16045
## b -73.06322
plot(des.opt)
#ramalan
ramalandesopt<- forecast(des.opt, h=24)
ramalandesopt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 3568.097 2492.79094 4643.404 1923.5582 5212.636
## 98 3495.034 2233.47564 4756.592 1565.6470 5424.421
## 99 3421.971 1901.42710 4942.514 1096.4999 5747.442
## 100 3348.908 1507.88186 5189.933 533.3017 6164.513
## 101 3275.844 1063.37547 5488.313 -107.8348 6659.523
## 102 3202.781 575.90026 5829.662 -814.6865 7220.249
## 103 3129.718 51.18732 6208.248 -1578.4883 7837.924
## 104 3056.655 -506.64188 6619.951 -2392.9371 8506.246
## 105 2983.591 -1094.54780 7061.731 -3253.3843 9220.567
## 106 2910.528 -1710.21674 7531.273 -4156.2914 9977.348
## 107 2837.465 -2351.83136 8026.761 -5098.8789 10773.809
## 108 2764.402 -3017.92293 8546.727 -6078.9007 11607.704
## 109 2691.339 -3707.27475 9089.952 -7094.4960 12477.173
## 110 2618.275 -4418.85744 9655.408 -8144.0905 13380.641
## 111 2545.212 -5151.78450 10242.209 -9226.3284 14316.753
## 112 2472.149 -5905.28096 10849.579 -10340.0244 15284.322
## 113 2399.086 -6678.66081 11476.832 -11484.1295 16282.301
## 114 2326.022 -7471.31031 12123.355 -12657.7050 17309.750
## 115 2252.959 -8282.67535 12788.594 -13859.9034 18365.822
## 116 2179.896 -9112.25184 13472.044 -15089.9538 19449.746
## 117 2106.833 -9959.57810 14173.244 -16347.1502 20560.816
## 118 2033.770 -10824.22885 14891.768 -17630.8421 21698.381
## 119 1960.706 -11705.81037 15627.223 -18940.4273 22861.840
## 120 1887.643 -12603.95653 16379.243 -20275.3460 24050.632
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 -2038.000 -3223.880 -2937.629 -3886.123
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.2 dan gamma=0.2")
akurasides.1
## Akurasi lamda=0.2 dan gamma=0.2
## SSE 1.543365e+08
## MSE 1.607671e+06
## MAPE 2.464457e+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 -2038.0000 -2123.3600 -669.2992 -1262.2010
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.6 dan gamma=0.3")
akurasides.2
## Akurasi lamda=0.6 dan gamma=0.3
## SSE 6.864125e+07
## MSE 7.150130e+05
## MAPE 1.884243e+01
Hasil akurasi dari data latih didapatkan skenario 2 dengan lamda=0.6 dan gamma=0.3 memiliki hasil yang lebih baik. Namun untuk kedua skenario dapat dikategorikan peramalan cukup baik berdasarkan nilai MAPE-nya.
#Akurasi Data Testing
selisihdes1<-ramalandes1$mean-testing$Jumlah.Pengunjung
selisihdes1
## Time Series:
## Start = 97
## End = 120
## Frequency = 1
## [1] -98.57362 596.04947 1293.67256 133.29566 1376.91875 -929.45816
## [7] -1031.83506 -265.21197 618.41112 1231.03421 91.65731 766.28040
## [13] -180.09651 -544.47341 -686.85032 -286.22723 198.39587 -553.98104
## [19] -74.35795 321.26515 29.88824 -2221.48867 -308.86558 -768.24248
SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(testing$Jumlah.Pengunjung)
MAPEtestingdes1<-sum(abs(selisihdes1/testing$Jumlah.Pengunjung)*100)/length(testing$Jumlah.Pengunjung)
selisihdes2<-ramalandes2$mean-testing$Jumlah.Pengunjung
selisihdes2
## Time Series:
## Start = 97
## End = 120
## Frequency = 1
## [1] -214.9204328 482.1253842 1182.1712012 24.2170182 1270.2628352
## [6] -1033.6913478 -1133.6455308 -364.5997138 521.4461032 1136.4919202
## [11] -0.4622628 676.5835542 -267.3706288 -629.3248118 -769.2789948
## [16] -366.2331779 120.8126391 -629.1415439 -147.0957269 250.9500901
## [21] -38.0040929 -2286.9582759 -371.9124589 -828.8666419
SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(testing$Jumlah.Pengunjung)
MAPEtestingdes2<-sum(abs(selisihdes2/testing$Jumlah.Pengunjung)*100)/length(testing$Jumlah.Pengunjung)
selisihdesopt<-ramalandesopt$mean-testing$Jumlah.Pengunjung
selisihdesopt
## Time Series:
## Start = 97
## End = 120
## Frequency = 1
## [1] -319.90277 337.03401 996.97079 -201.09243 1004.84434 -1339.21888
## [7] -1479.28210 -750.34532 95.59146 670.52824 -506.53498 130.40179
## [13] -853.66143 -1255.72465 -1435.78787 -1072.85109 -625.91431 -1415.97753
## [19] -974.04075 -616.10398 -945.16720 -3234.23042 -1359.29364 -1856.35686
SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(testing$Jumlah.Pengunjung)
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing$Jumlah.Pengunjung)*100)/length(testing$Jumlah.Pengunjung)
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 1.540370e+07 1.554365e+07 3.342767e+07
## MSE 6.418209e+05 6.476521e+05 1.392819e+06
## MAPE 1.873972e+01 1.847353e+01 2.754249e+01
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 8530335 641820.9
## ske 2 8336797 647652.1
## ske opt 8781531 1392819.4
data.ts Kedua metode dapat dibandingkan dengan menggunakan ukuran akurasi yang sama. Contoh di atas adalah perbandingan kedua metode dengan ukuran akurasi MSE. Hasilnya didapatkan metode SES lebih baik dibandingkan metode DES dilihat dari MSE yang lebih kecil nilainya.
Melakukan pembagian data dan mengubahnya menjadi data deret waktu.
#membagi data menjadi training dan testing
training <- data[1:96,]
testing<-data[97:120,]
training.ts<-ts(training$Jumlah.Pengunjung, frequency=14)
testing.ts<-ts(testing$Jumlah.Pengunjung, frequency=14)
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)
Metode Holt-Winter untuk peramalan data musiman menggunakan tiga persamaan pemulusan yang terdiri atas persamaan untuk level \((L_t)\), trend \((B_t)\), dan komponen seasonal / musiman \((S_t)\) dengan parameter pemulusan berupa \(\alpha\), \(\beta\), dan \(\gamma\). Metode Holt-Winter musiman terbagi menjadi dua, yaitu metode aditif dan metode multiplikatif. Perbedaan persamaan dan contoh datanya adalah sebagai berikut.
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(7, 12)
## Frequency = 14
## xhat level trend season
## 2.000000 2936.830 3229.910 19.8331240 -312.913265
## 2.071429 3825.642 3298.977 24.7565322 501.908163
## 2.142857 3131.308 3360.405 28.4236995 -257.520408
## 2.214286 3673.147 3413.167 30.8575308 229.122449
## 2.285714 3955.175 3458.595 32.3145881 464.265306
## 2.357143 3537.590 3494.475 32.6710850 10.443878
## 2.428571 3180.704 3520.828 32.0392894 -372.163265
## 2.500000 3239.994 3541.926 30.9452100 -332.877551
## 2.571429 4073.168 3532.073 26.8653280 514.229592
## 2.642857 3492.729 3543.305 25.3019729 -75.877551
## 2.714286 2857.501 3499.261 18.3673923 -660.127551
## 2.785714 4523.242 3540.728 20.6773800 961.836735
## 2.857143 3311.901 3432.557 7.7925368 -128.448980
## 2.928571 2936.866 3468.169 10.5745258 -541.877551
## 3.000000 3183.588 3467.371 9.4371979 -293.219633
## 3.071429 3991.032 3466.090 8.3654333 516.576833
## 3.142857 3218.309 3459.249 6.8447836 -247.785083
## 3.214286 3698.141 3457.232 5.9586065 234.950678
## 3.285714 3807.870 3347.762 -5.5842226 465.691294
## 3.357143 3373.579 3368.604 -2.9416136 7.916695
## 3.428571 3140.054 3505.547 11.0467977 -376.539583
## 3.500000 3216.491 3551.183 14.5057164 -349.197079
## 3.571429 4171.222 3641.190 22.0558870 507.976172
## 3.642857 3684.377 3756.602 31.3914407 -103.615874
## 3.714286 3199.874 3816.518 34.2438957 -650.887600
## 3.785714 4902.691 3948.387 44.0064164 910.297362
## 3.857143 3850.507 3930.055 37.7726053 -117.321024
## 3.928571 3650.902 4142.126 55.2024721 -546.426863
## 4.000000 3962.306 4203.948 55.8644329 -297.506691
## 4.071429 4734.584 4176.552 47.5383094 510.494234
## 4.142857 3970.890 4179.173 43.0466259 -251.329791
## 4.214286 4336.810 4115.642 32.3888271 188.779362
## 4.285714 4441.563 3952.469 12.8326285 476.261729
## 4.357143 4027.800 3952.389 11.5413696 63.870341
## 4.428571 3680.131 4025.170 17.6653629 -362.703908
## 4.500000 3681.415 3988.209 12.2027353 -318.996397
## 4.571429 4531.001 3975.929 9.7544283 545.318387
## 4.642857 3922.591 4003.283 11.5143984 -92.206053
## 4.714286 3262.324 3876.479 -2.3174246 -611.837518
## 4.785714 4818.735 3930.097 3.2760947 885.362118
## 4.857143 3847.526 3895.626 -0.4986045 -47.601557
## 4.928571 3381.754 3923.222 2.3108818 -543.779020
## 5.000000 3674.087 3995.582 9.3158024 -330.811185
## 5.071429 4374.502 3884.681 -2.7059338 492.527500
## 5.142857 3511.937 3815.274 -9.3759778 -293.960987
## 5.214286 3808.091 3715.911 -18.3747237 110.554567
## 5.285714 4200.178 3742.918 -13.8365371 471.096694
## 5.357143 3762.872 3692.046 -17.5400995 88.366314
## 5.428571 3501.899 3883.131 3.3224601 -384.554419
## 5.500000 3601.709 3923.474 7.0244732 -328.789625
## 5.571429 4433.845 3879.557 1.9302984 552.358267
## 5.642857 3744.498 3889.318 2.7133948 -147.533346
## 5.714286 3187.692 3785.132 -7.9765638 -589.463440
## 5.785714 4711.010 3842.217 -1.4703975 870.263321
## 5.857143 3636.810 3689.744 -16.5705917 -36.363611
## 5.928571 3295.106 3813.412 -2.5467966 -515.759337
## 6.000000 3990.617 4321.044 48.4710899 -378.898130
## 6.071429 4710.558 4211.992 32.7187532 465.847324
## 6.142857 4101.130 4384.399 46.6875997 -329.955970
## 6.214286 4408.013 4250.660 28.6449907 128.707314
## 6.285714 4640.370 4166.703 17.3847381 456.282444
## 6.357143 4321.287 4136.814 12.6573386 171.816552
## 6.428571 3669.779 4038.013 1.5115901 -369.746366
## 6.500000 3671.019 4020.569 -0.3839821 -349.166324
## 6.571429 4564.068 4009.981 -1.4043611 555.490652
## 6.642857 3930.605 4111.964 8.9342834 -190.293180
## 6.714286 3418.200 3986.177 -4.5378101 -563.438775
## 6.785714 4849.620 4038.599 1.1581833 809.862544
## 6.857143 3825.331 3825.833 -20.2342121 19.731569
## 6.928571 3668.964 3983.133 -2.4808246 -311.687791
## 7.000000 3733.172 4159.659 15.4198891 -441.907477
## 7.071429 4852.104 4302.245 28.1364559 521.722710
## 7.142857 3846.588 4230.560 18.1543766 -402.126406
## 7.214286 4147.786 4064.397 -0.2773921 83.666303
## 7.285714 4386.642 3959.963 -10.6931135 437.372846
## 7.357143 4041.029 3926.741 -12.9459591 127.233558
## 7.428571 3647.374 4026.389 -1.6865307 -377.328655
## 7.500000 3799.706 4142.828 10.1259870 -353.247840
## 7.571429 4736.890 4132.013 8.0318650 596.845230
## 7.642857 3862.339 4102.267 4.2540688 -244.181554
## 7.714286 3437.605 3986.053 -7.7927139 -540.654802
## 7.785714 4644.907 3932.939 -12.3248209 724.292963
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.01616702
## beta : 0.2592872
## gamma: 0.4310687
##
## Coefficients:
## [,1]
## a 4202.627549
## b -2.486995
## s1 307.585747
## s2 431.703318
## s3 -382.684984
## s4 440.240489
## s5 -1019.133751
## s6 -404.533235
## s7 137.054573
## s8 202.818472
## s9 -295.934394
## s10 -547.235830
## s11 516.580503
## s12 -851.125203
## s13 -726.759955
## s14 -66.728806
winter1.opt$fitted
## Time Series:
## Start = c(2, 1)
## End = c(7, 12)
## Frequency = 14
## xhat level trend season
## 2.000000 2936.830 3229.910 19.833124019 -312.91327
## 2.071429 3776.496 3253.723 20.865045992 501.90816
## 2.142857 3042.666 3278.347 21.839680119 -257.52041
## 2.214286 3555.431 3303.587 22.721379772 229.12245
## 2.285714 3817.175 3329.389 23.520227707 464.26531
## 2.357143 3390.046 3355.429 24.173432136 10.44388
## 2.428571 3033.973 3381.477 24.659500296 -372.16327
## 2.500000 3099.792 3407.624 25.045268883 -332.87755
## 2.571429 3970.645 3431.638 24.777860544 514.22959
## 2.642857 3405.812 3456.809 24.879952840 -75.87755
## 2.714286 2841.152 3477.489 23.790847089 -660.12755
## 2.785714 4489.592 3503.411 24.343539333 961.83673
## 2.857143 3411.219 3517.884 21.783999100 -128.44898
## 2.928571 3020.384 3540.311 21.950758767 -541.87755
## 3.000000 3372.842 3559.992 21.362283196 -208.51249
## 3.071429 4198.286 3577.428 20.344314861 600.51306
## 3.142857 3444.032 3593.193 19.156809965 -168.31780
## 3.214286 3935.952 3607.984 18.024864257 309.94285
## 3.285714 4157.793 3612.833 14.608668257 530.35078
## 3.357143 3697.237 3623.921 13.695702557 59.61997
## 3.428571 3325.828 3643.692 15.270865506 -333.13460
## 3.500000 3314.041 3658.755 15.217092335 -359.93157
## 3.571429 4219.447 3678.498 16.390654407 524.55839
## 3.642857 3533.737 3701.656 18.145185757 -186.06368
## 3.714286 3139.706 3724.542 19.374514398 -604.21102
## 3.785714 4477.339 3752.781 21.672910413 702.88500
## 3.857143 3686.863 3776.291 22.149367043 -111.57771
## 3.928571 3240.250 3815.176 26.488558854 -601.41433
## 4.000000 3565.686 3848.838 28.348714848 -311.50156
## 4.071429 4385.507 3876.869 28.266194712 480.37177
## 4.142857 3653.098 3907.148 28.788057535 -282.83810
## 4.214286 3924.667 3932.458 27.886389075 -35.67778
## 4.285714 4414.700 3951.200 25.515169147 437.98495
## 4.357143 4220.443 3976.105 25.357135672 218.98109
## 4.428571 3690.557 4003.298 25.833153282 -338.57489
## 4.500000 3807.991 4024.547 24.644512341 -241.20090
## 4.571429 4770.833 4045.166 23.600767626 702.06642
## 4.642857 4027.586 4066.312 22.964296919 -61.69103
## 4.714286 3724.344 4076.398 19.625089054 -371.67955
## 4.785714 4863.025 4093.075 18.860722171 751.08868
## 4.857143 4453.476 4108.169 17.883905549 327.42351
## 4.928571 3721.240 4118.527 15.932675626 -413.22013
## 5.000000 3830.761 4134.634 15.977781185 -319.85022
## 5.071429 4684.332 4138.361 12.801320106 533.16926
## 5.142857 3776.805 4140.762 10.104538034 -374.06097
## 5.214286 3870.841 4139.310 7.108145908 -275.57692
## 5.285714 4578.865 4149.072 7.796284131 421.99651
## 5.357143 4420.325 4147.752 5.432619171 267.14036
## 5.428571 3707.638 4159.420 7.049329971 -458.83111
## 5.500000 3826.301 4166.136 6.962816610 -346.79779
## 5.571429 4807.977 4165.350 4.953635562 637.67392
## 5.642857 3768.914 4164.888 3.549444393 -399.52268
## 5.714286 3711.596 4159.401 1.206530382 -449.01146
## 5.785714 4810.034 4157.397 0.374034733 652.26298
## 5.857143 4270.773 4143.964 -3.205991125 130.01525
## 5.928571 3730.264 4141.845 -2.924182485 -408.65674
## 6.000000 3537.854 4173.126 5.944774331 -641.21658
## 6.071429 4438.531 4173.657 4.541100159 260.33260
## 6.142857 3525.287 4193.888 8.609212053 -677.20954
## 6.214286 3998.506 4197.222 7.241448388 -205.95716
## 6.285714 4391.441 4201.981 6.597966673 182.86171
## 6.357143 4646.138 4208.782 6.650612563 430.70492
## 6.428571 3736.540 4201.171 2.952777822 -467.58377
## 6.500000 3653.719 4201.513 2.275616249 -550.06904
## 6.571429 4700.988 4203.243 2.134268799 495.61022
## 6.642857 3578.690 4211.521 3.727243278 -636.55808
## 6.714286 3679.190 4210.047 2.378749918 -533.23604
## 6.785714 4505.357 4212.811 2.478558258 290.06749
## 6.857143 4361.527 4203.563 -0.562067380 158.52616
## 6.928571 4698.221 4208.683 0.911272810 488.62619
## 7.000000 3424.545 4207.424 0.348633625 -783.22797
## 7.071429 4899.258 4223.042 4.307695200 671.90833
## 7.142857 3404.948 4218.518 2.017835445 -815.58782
## 7.214286 3941.724 4212.777 0.005939305 -271.05897
## 7.285714 4394.569 4207.695 -1.313351890 188.18796
## 7.357143 4259.204 4204.432 -1.818766358 56.59057
## 7.428571 3671.721 4208.188 -0.373415134 -536.09302
## 7.500000 3654.600 4216.969 2.000369522 -564.36933
## 7.571429 4878.566 4219.623 2.169721062 656.77335
## 7.642857 3444.245 4216.448 0.784021780 -772.98676
## 7.714286 3691.127 4214.254 0.011682945 -523.13831
## 7.785714 4186.946 4206.503 -2.000961563 -17.55623
xhat1.opt <- winter1.opt$fitted[,2]
#Forecast
forecast1 <- predict(winter1, n.ahead = 24)
forecast1.opt <- predict(winter1.opt, n.ahead = 24)
#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=1)
#Akurasi data training
SSE1<-winter1$SSE
MSE1<-winter1$SSE/length(training.ts)
RMSE1<-sqrt(MSE1)
akurasi1 <- matrix(c(SSE1,MSE1,RMSE1))
row.names(akurasi1)<- c("SSE", "MSE", "RMSE")
colnames(akurasi1) <- c("Akurasi")
akurasi1
## Akurasi
## SSE 2.479281e+07
## MSE 2.582584e+05
## RMSE 5.081913e+02
SSE1.opt<-winter1.opt$SSE
MSE1.opt<-winter1.opt$SSE/length(training.ts)
RMSE1.opt<-sqrt(MSE1.opt)
akurasi1.opt <- matrix(c(SSE1.opt,MSE1.opt,RMSE1.opt))
row.names(akurasi1.opt)<- c("SSE1.opt", "MSE1.opt", "RMSE1.opt")
colnames(akurasi1.opt) <- c("Akurasi")
akurasi1.opt
## Akurasi
## SSE1.opt 18377939.470
## MSE1.opt 191436.869
## RMSE1.opt 437.535
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))
akurasi1.train
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1 Winter 1 24792810 258258.4 508.1913
## 2 Winter1 optimal 18377939 191436.9 437.5350
#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)
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)
akurasi1.test = data.frame(Model_Winter = c("Winter 1","Winter1 optimal"),
Nilai_SSE=c(SSEtesting1,SSEtesting1.opt),
Nilai_MSE=c(MSEtesting1,MSEtesting1.opt))
akurasi1.test
## Model_Winter Nilai_SSE Nilai_MSE
## 1 Winter 1 11204845 11204845
## 2 Winter1 optimal 18955472 18955472
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(7, 12)
## Frequency = 14
## xhat level trend season
## 2.000000 2958.557 3229.910 19.8331240 0.9103971
## 2.071429 3798.899 3299.050 24.7637947 1.1429339
## 2.142857 3139.871 3360.579 28.4403173 0.9264838
## 2.214286 3667.978 3413.440 30.8824324 1.0649346
## 2.285714 3952.637 3458.975 32.3477175 1.1321316
## 2.357143 3537.806 3494.920 32.7074457 1.0028853
## 2.428571 3174.959 3521.285 32.0731572 0.8935096
## 2.500000 3210.540 3542.399 30.9772668 0.8984613
## 2.571429 4121.764 3534.523 27.0919490 1.1572738
## 2.642857 3485.776 3539.708 24.9012167 0.9778844
## 2.714286 2824.856 3495.117 17.9520157 0.8040991
## 2.785714 4578.418 3549.916 21.6367416 1.2819124
## 2.857143 3344.216 3462.432 10.7246354 0.9628752
## 2.928571 2961.752 3495.337 12.9426506 0.8442179
## 3.000000 3243.461 3488.912 11.0058884 0.9267250
## 3.071429 4034.244 3475.431 8.5572390 1.1579385
## 3.142857 3242.397 3463.392 6.4976401 0.9344379
## 3.214286 3703.709 3455.251 5.0337259 1.0703482
## 3.285714 3792.279 3351.402 -5.8544951 1.1335299
## 3.357143 3370.781 3371.612 -3.2481011 1.0007175
## 3.428571 3133.027 3508.707 10.7862186 0.8901925
## 3.500000 3169.415 3559.928 14.8296893 0.8866097
## 3.571429 4244.302 3670.535 24.4074135 1.1486789
## 3.642857 3622.292 3763.490 31.2622048 0.9545530
## 3.714286 3153.225 3837.643 35.5512854 0.8141147
## 3.785714 4999.419 4004.570 48.6888746 1.2334319
## 3.857143 3909.063 3987.034 42.0663866 0.9702073
## 3.928571 3568.642 4196.681 58.8243957 0.8385942
## 4.000000 3992.202 4283.017 61.5756136 0.9188898
## 4.071429 4942.844 4247.475 51.8638455 1.1496753
## 4.142857 3968.253 4224.041 44.3339937 0.9296871
## 4.214286 4307.066 4154.303 32.9268681 1.0286193
## 4.285714 4596.071 4002.893 14.4931117 1.1440451
## 4.357143 4184.253 3979.088 10.6633575 1.0487502
## 4.428571 3638.023 4018.309 13.5190850 0.9023258
## 4.500000 3647.446 3980.622 8.3984837 0.9143714
## 4.571429 4667.133 3969.675 6.4638986 1.1737852
## 4.642857 3843.864 3967.937 5.6437695 0.9673551
## 4.714286 3249.141 3846.872 -7.0271475 0.8461646
## 4.785714 4725.335 3909.065 -0.1051095 1.2088471
## 4.857143 3956.483 3893.187 -1.6823950 1.0166976
## 4.928571 3292.890 3897.705 -1.0624148 0.8450583
## 5.000000 3583.554 4000.566 9.3300048 0.8936775
## 5.071429 4380.554 3895.637 -2.0959107 1.1250821
## 5.142857 3438.924 3833.181 -8.1319811 0.8990536
## 5.214286 3619.559 3741.200 -16.5168828 0.9717764
## 5.285714 4299.668 3810.184 -7.9667453 1.1308318
## 5.357143 3954.580 3751.871 -13.0014138 1.0576941
## 5.428571 3467.380 3899.865 3.0981416 0.8883970
## 5.500000 3600.142 3952.405 8.0423166 0.9090241
## 5.571429 4574.867 3904.752 2.4727872 1.1708739
## 5.642857 3614.792 3889.824 0.7327654 0.9291195
## 5.714286 3279.812 3803.422 -7.9806981 0.8641449
## 5.785714 4627.618 3849.411 -2.5837273 1.2029700
## 5.857143 3790.778 3735.168 -13.7497319 1.0186382
## 5.928571 3333.854 3828.860 -3.0055513 0.8714012
## 6.000000 3843.002 4402.430 54.6520692 0.8622236
## 6.071429 4799.900 4308.629 39.8066932 1.1038223
## 6.142857 3945.366 4458.797 50.8428936 0.8748738
## 6.214286 4363.811 4339.018 33.7806394 0.9979447
## 6.285714 4775.603 4268.822 23.3830508 1.1126221
## 6.357143 4709.129 4225.408 16.7032860 1.1100910
## 6.428571 3671.411 4071.832 -0.3246751 0.9017328
## 6.500000 3616.443 4050.123 -2.4630344 0.8934651
## 6.571429 4712.011 4048.456 -2.3834170 1.1645888
## 6.642857 3716.767 4109.441 3.9533910 0.9035767
## 6.714286 3519.484 4011.628 -6.2232176 0.8786836
## 6.785714 4691.605 4047.176 -2.0461449 1.1598158
## 6.857143 4075.048 3887.931 -17.7659740 1.0529390
## 6.928571 4018.980 3991.341 -5.6484323 1.0083517
## 7.000000 3388.090 4093.794 5.1616875 0.8265741
## 7.071429 4961.514 4336.299 28.8960282 1.1366078
## 7.142857 3564.690 4258.119 18.1884742 0.8335907
## 7.214286 3996.851 4122.829 2.8406438 0.9687763
## 7.285714 4414.657 4049.316 -4.7947917 1.0915153
## 7.357143 4229.529 4018.748 -7.3720642 1.0543836
## 7.428571 3657.677 4082.407 -0.2689417 0.8960197
## 7.500000 3775.206 4211.672 12.6844202 0.8936760
## 7.571429 5002.297 4206.407 10.8894555 1.1861385
## 7.642857 3630.370 4140.695 3.2293473 0.8760706
## 7.714286 3606.431 4059.372 -5.2259177 0.8895662
## 7.785714 4360.236 3965.242 -14.1163459 1.1035429
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(7, 12)
## Frequency = 14
## xhat level trend season
## 2.000000 2958.557 3229.910 19.833124 0.9103971
## 2.071429 3763.882 3272.764 20.411817 1.1429339
## 2.142857 3089.006 3313.203 20.915231 0.9264838
## 2.214286 3590.936 3350.647 21.330723 1.0649346
## 2.285714 3857.452 3385.575 21.672514 1.1321316
## 2.357143 3448.611 3416.778 21.912087 1.0028853
## 2.428571 3096.976 3444.033 22.046408 0.8935096
## 2.500000 3136.740 3469.113 22.122658 0.8984613
## 2.571429 4053.496 3480.766 21.859464 1.1572738
## 2.642857 3441.807 3497.905 21.740815 0.9778844
## 2.714286 2824.341 3491.399 21.030759 0.8040991
## 2.785714 4552.273 3529.693 21.464722 1.2819124
## 2.857143 3391.579 3502.113 20.231886 0.9628752
## 2.928571 2995.695 3528.108 20.376744 0.8442179
## 3.000000 3349.686 3535.688 20.055059 0.9420496
## 3.071429 4182.723 3533.966 19.507664 1.1770801
## 3.142857 3370.359 3532.235 18.973773 0.9490737
## 3.214286 3855.973 3531.889 18.488124 1.0860742
## 3.285714 4021.777 3487.184 16.899636 1.1477401
## 3.357143 3551.329 3497.430 16.732387 1.0105761
## 3.428571 3212.868 3562.367 17.944101 0.8973711
## 3.500000 3194.281 3590.731 18.206025 0.8851032
## 3.571429 4219.298 3651.108 19.266090 1.1495552
## 3.642857 3496.493 3704.386 20.121054 0.9387801
## 3.714286 3111.598 3757.382 20.947451 0.8235379
## 3.785714 4613.170 3843.688 22.590363 1.1931811
## 3.857143 3772.998 3864.543 22.546749 0.9706487
## 3.928571 3319.138 3978.388 24.841720 0.8291152
## 4.000000 3717.547 4044.322 25.874684 0.9133579
## 4.071429 4657.579 4052.658 25.433811 1.1420974
## 4.142857 3777.829 4066.026 25.130497 0.9234135
## 4.214286 4035.336 4056.791 24.266650 0.9887967
## 4.285714 4593.096 4017.186 22.661085 1.1369481
## 4.357143 4360.436 4022.098 22.214937 1.0781648
## 4.428571 3699.388 4042.023 22.157382 0.9102420
## 4.500000 3794.542 4034.185 21.403376 0.9356328
## 4.571429 4870.456 4032.080 20.812448 1.2017233
## 4.642857 3970.083 4033.353 20.321280 0.9793787
## 4.714286 3572.575 3983.206 18.549888 0.8927518
## 4.785714 4782.405 3998.558 18.469498 1.1905333
## 4.857143 4348.102 4005.073 18.169009 1.0807457
## 4.928571 3491.301 3992.128 17.386888 0.8707540
## 5.000000 3622.981 4035.328 18.035748 0.8938209
## 5.071429 4515.444 3995.905 16.591408 1.1253453
## 5.142857 3529.031 3973.127 15.601781 0.8847507
## 5.214286 3602.268 3939.437 14.362707 0.9110903
## 5.285714 4463.760 3998.151 15.477591 1.1121505
## 5.357143 4290.349 3975.949 14.530433 1.0751461
## 5.428571 3551.809 4035.266 15.656231 0.8767902
## 5.500000 3708.593 4065.321 16.018161 0.9086706
## 5.571429 4761.307 4044.179 15.084078 1.1729486
## 5.642857 3620.373 4036.311 14.507114 0.8937388
## 5.714286 3575.893 4007.941 13.429308 0.8892226
## 5.785714 4724.757 4014.766 13.263286 1.1729701
## 5.857143 4134.165 3966.828 11.724867 1.0391128
## 5.928571 3601.272 3996.870 12.185322 0.8982843
## 6.000000 3537.437 4242.405 18.051054 0.8302954
## 6.071429 4537.722 4222.843 17.105571 1.0702305
## 6.142857 3598.182 4315.970 19.016532 0.8300330
## 6.214286 4140.148 4290.077 17.887652 0.9610449
## 6.285714 4554.483 4279.287 17.166764 1.0600564
## 6.357143 4876.775 4283.198 16.833544 1.1341254
## 6.428571 3767.448 4208.409 14.530415 0.8921388
## 6.500000 3657.684 4202.796 14.024062 0.8674034
## 6.571429 4818.341 4212.763 13.922084 1.1399810
## 6.642857 3608.264 4248.200 14.462923 0.8464810
## 6.714286 3737.356 4223.913 13.488858 0.8819923
## 6.785714 4601.902 4233.765 13.397424 1.0835239
## 6.857143 4450.325 4176.329 11.616875 1.0626511
## 6.928571 4825.021 4211.028 12.197105 1.1424966
## 7.000000 3344.474 4201.891 11.660824 0.7937422
## 7.071429 5059.383 4334.083 14.690636 1.1634044
## 7.142857 3388.679 4292.076 13.265418 0.7870872
## 7.214286 3960.497 4250.330 11.882593 0.9292114
## 7.285714 4425.612 4228.699 11.040132 1.0438407
## 7.357143 4288.076 4226.176 10.699198 1.0120846
## 7.428571 3725.683 4266.024 11.431918 0.8710044
## 7.500000 3751.096 4332.381 12.812592 0.8632748
## 7.571429 5085.139 4339.126 12.660061 1.1685177
## 7.642857 3491.343 4308.861 11.581055 0.8080985
## 7.714286 3780.518 4293.709 10.909063 0.8782469
## 7.785714 4222.364 4244.064 9.386894 0.9926915
xhat2.opt <- winter2.opt$fitted[,2]
#Forecast
forecast2 <- predict(winter2, n.ahead = 24)
forecast2.opt <- predict(winter2.opt, n.ahead = 24)
#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)
akurasi1 <- matrix(c(SSE2,MSE2,RMSE2))
row.names(akurasi1)<- c("SSE2", "MSE2", "RMSE2")
colnames(akurasi1) <- c("Akurasi lamda=0.2")
akurasi1
## Akurasi lamda=0.2
## SSE2 2.202380e+07
## MSE2 2.294146e+05
## RMSE2 4.789724e+02
SSE2.opt<-winter2.opt$SSE
MSE2.opt<-winter2.opt$SSE/length(training.ts)
RMSE2.opt<-sqrt(MSE2.opt)
akurasi1.opt <- matrix(c(SSE2.opt,MSE2.opt,RMSE2.opt))
row.names(akurasi1.opt)<- c("SSE2.opt", "MSE2.opt", "RMSE2.opt")
colnames(akurasi1.opt) <- c("Akurasi")
akurasi1.opt
## Akurasi
## SSE2.opt 19055964.045
## MSE2.opt 198499.625
## RMSE2.opt 445.533
akurasi2.train = data.frame(Model_Winter = c("Winter 1","winter2 optimal"),
Nilai_SSE=c(SSE2,SSE2.opt),
Nilai_MSE=c(MSE2,MSE2.opt),Nilai_RMSE=c(RMSE2,RMSE2.opt))
akurasi2.train
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1 Winter 1 22023797 229414.6 478.9724
## 2 winter2 optimal 19055964 198499.6 445.5330
#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)
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)
akurasi2.test = data.frame(Model_Winter = c("Winter 1","winter2 optimal"),
Nilai_SSE=c(SSEtesting2,SSEtesting2.opt),
Nilai_MSE=c(MSEtesting2,MSEtesting2.opt))
akurasi2.test
## Model_Winter Nilai_SSE Nilai_MSE
## 1 Winter 1 10644645 10644645
## 2 winter2 optimal 23446530 23446530