Muhammad Haikal Rasyadan | G1401221026 | P2

Pembagian Data

Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.

kurstrain<-data1[1:85,]
train.ts<-ts(kurstrain$Penumpang)
plot.ts(train.ts, lty=1, xlab="waktu", ylab="Jumlah Penumpang", main="Plot Data Latih Kedatangan Penumpang Antarkota Stasiun Bandung")
points(train.ts)

kurstest<-data1[86:106,]
test.ts<-ts(kurstest$Penumpang)
plot.ts(test.ts, lty=1, xlab="waktu", ylab="Jumlah Penumpang", main="Plot Data Uji Kedatangan Penumpang Antarkota Stasiun Bandung")

Eksplorasi Data

Eksplorasi data dilakukan pada keseluruhan data, data latih serta data uji menggunakan plot data deret waktu.

#eksplorasi keseluruhan data
plot(data1, col="red", main="Plot semua data", type="o")
points(data1)

#eksplorasi data latih
plot(kurstrain, col="blue",main="Plot data latih", type="o")
points(kurstrain)

#eksplorasi data uji
plot(kurstest, col="green",main="Plot data uji", type="o")
points(kurstest)

#Eksplorasi dengan GGPLOT
library(ggplot2)
ggplot() + 
  geom_line(data = kurstrain, aes(x = Tanggal, y = Penumpang, col = "Data Latih")) +
  geom_line(data = kurstest, aes(x = Tanggal, y = Penumpang, col = "Data Uji")) +
  labs(x = "Periode Waktu", y = "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))

Single Moving Average (SMA)

Dilakukan pemulusan dengan parameter m=4.

data.sma<-SMA(train.ts, n=4)
data.sma

## Time Series:
## Start = 1 
## End = 85 
## Frequency = 1 
##  [1]      NA      NA      NA 6690.25 6646.50 6701.00 7092.00 7381.75 7642.00
## [10] 7638.50 7407.25 7095.00 6968.50 6733.75 6839.50 7228.25 7217.25 7201.75
## [19] 6831.25 6426.25 6271.25 6325.25 6691.25 6694.50 6629.00 6109.25 5699.50
## [28] 5324.00 5329.25 5730.75 5658.50 5843.75 5528.75 5099.25 5057.75 5255.50
## [37] 6019.00 6031.25 6097.25 5514.00 4659.25 4645.25 4784.50 5484.75 5692.25
## [46] 5943.50 5535.75 5110.75 5014.50 5169.50 5693.75 5799.50 5998.75 5348.75
## [55] 4803.25 5091.50 5106.00 5704.25 6104.75 5904.75 5658.00 5268.50 5017.25
## [64] 5143.75 5791.75 6017.25 6193.75 5616.75 4794.75 4508.75 4568.50 5218.75
## [73] 5471.50 5755.50 5321.25 4646.25 4394.75 4545.75 5145.75 5393.00 5729.25
## [82] 5185.75 4524.75 4373.00 4519.25

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 6690.25 6646.50 6701.00 7092.00 7381.75
## [10] 7642.00 7638.50 7407.25 7095.00 6968.50 6733.75 6839.50 7228.25 7217.25
## [19] 7201.75 6831.25 6426.25 6271.25 6325.25 6691.25 6694.50 6629.00 6109.25
## [28] 5699.50 5324.00 5329.25 5730.75 5658.50 5843.75 5528.75 5099.25 5057.75
## [37] 5255.50 6019.00 6031.25 6097.25 5514.00 4659.25 4645.25 4784.50 5484.75
## [46] 5692.25 5943.50 5535.75 5110.75 5014.50 5169.50 5693.75 5799.50 5998.75
## [55] 5348.75 4803.25 5091.50 5106.00 5704.25 6104.75 5904.75 5658.00 5268.50
## [64] 5017.25 5143.75 5791.75 6017.25 6193.75 5616.75 4794.75 4508.75 4568.50
## [73] 5218.75 5471.50 5755.50 5321.25 4646.25 4394.75 4545.75 5145.75 5393.00
## [82] 5729.25 5185.75 4524.75 4373.00 4519.25

Selanjutnya akan dilakukan peramalan sejumlah data uji yaitu 21 periode.

data.gab<-cbind(aktual=c(train.ts,rep(NA,21)),pemulusan=c(data.sma,rep(NA,21)),ramalan=c(data.ramal,rep(data.ramal[length(data.ramal)],20)))
data.gab #forecast 21 periode ke depan

##        aktual pemulusan ramalan
##   [1,]   6458        NA      NA
##   [2,]   7493        NA      NA
##   [3,]   6304        NA      NA
##   [4,]   6506   6690.25      NA
##   [5,]   6283   6646.50 6690.25
##   [6,]   7711   6701.00 6646.50
##   [7,]   7868   7092.00 6701.00
##   [8,]   7665   7381.75 7092.00
##   [9,]   7324   7642.00 7381.75
##  [10,]   7697   7638.50 7642.00
##  [11,]   6943   7407.25 7638.50
##  [12,]   6416   7095.00 7407.25
##  [13,]   6818   6968.50 7095.00
##  [14,]   6758   6733.75 6968.50
##  [15,]   7366   6839.50 6733.75
##  [16,]   7971   7228.25 6839.50
##  [17,]   6774   7217.25 7228.25
##  [18,]   6696   7201.75 7217.25
##  [19,]   5884   6831.25 7201.75
##  [20,]   6351   6426.25 6831.25
##  [21,]   6154   6271.25 6426.25
##  [22,]   6912   6325.25 6271.25
##  [23,]   7348   6691.25 6325.25
##  [24,]   6364   6694.50 6691.25
##  [25,]   5892   6629.00 6694.50
##  [26,]   4833   6109.25 6629.00
##  [27,]   5709   5699.50 6109.25
##  [28,]   4862   5324.00 5699.50
##  [29,]   5913   5329.25 5324.00
##  [30,]   6439   5730.75 5329.25
##  [31,]   5420   5658.50 5730.75
##  [32,]   5603   5843.75 5658.50
##  [33,]   4653   5528.75 5843.75
##  [34,]   4721   5099.25 5528.75
##  [35,]   5254   5057.75 5099.25
##  [36,]   6394   5255.50 5057.75
##  [37,]   7707   6019.00 5255.50
##  [38,]   4770   6031.25 6019.00
##  [39,]   5518   6097.25 6031.25
##  [40,]   4061   5514.00 6097.25
##  [41,]   4288   4659.25 5514.00
##  [42,]   4714   4645.25 4659.25
##  [43,]   6075   4784.50 4645.25
##  [44,]   6862   5484.75 4784.50
##  [45,]   5118   5692.25 5484.75
##  [46,]   5719   5943.50 5692.25
##  [47,]   4444   5535.75 5943.50
##  [48,]   5162   5110.75 5535.75
##  [49,]   4733   5014.50 5110.75
##  [50,]   6339   5169.50 5014.50
##  [51,]   6541   5693.75 5169.50
##  [52,]   5585   5799.50 5693.75
##  [53,]   5530   5998.75 5799.50
##  [54,]   3739   5348.75 5998.75
##  [55,]   4359   4803.25 5348.75
##  [56,]   6738   5091.50 4803.25
##  [57,]   5588   5106.00 5091.50
##  [58,]   6132   5704.25 5106.00
##  [59,]   5961   6104.75 5704.25
##  [60,]   5938   5904.75 6104.75
##  [61,]   4601   5658.00 5904.75
##  [62,]   4574   5268.50 5658.00
##  [63,]   4956   5017.25 5268.50
##  [64,]   6444   5143.75 5017.25
##  [65,]   7193   5791.75 5143.75
##  [66,]   5476   6017.25 5791.75
##  [67,]   5662   6193.75 6017.25
##  [68,]   4136   5616.75 6193.75
##  [69,]   3905   4794.75 5616.75
##  [70,]   4332   4508.75 4794.75
##  [71,]   5901   4568.50 4508.75
##  [72,]   6737   5218.75 4568.50
##  [73,]   4916   5471.50 5218.75
##  [74,]   5468   5755.50 5471.50
##  [75,]   4164   5321.25 5755.50
##  [76,]   4037   4646.25 5321.25
##  [77,]   3910   4394.75 4646.25
##  [78,]   6072   4545.75 4394.75
##  [79,]   6564   5145.75 4545.75
##  [80,]   5026   5393.00 5145.75
##  [81,]   5255   5729.25 5393.00
##  [82,]   3898   5185.75 5729.25
##  [83,]   3920   4524.75 5185.75
##  [84,]   4419   4373.00 4524.75
##  [85,]   5840   4519.25 4373.00
##  [86,]     NA        NA 4519.25
##  [87,]     NA        NA 4519.25
##  [88,]     NA        NA 4519.25
##  [89,]     NA        NA 4519.25
##  [90,]     NA        NA 4519.25
##  [91,]     NA        NA 4519.25
##  [92,]     NA        NA 4519.25
##  [93,]     NA        NA 4519.25
##  [94,]     NA        NA 4519.25
##  [95,]     NA        NA 4519.25
##  [96,]     NA        NA 4519.25
##  [97,]     NA        NA 4519.25
##  [98,]     NA        NA 4519.25
##  [99,]     NA        NA 4519.25
## [100,]     NA        NA 4519.25
## [101,]     NA        NA 4519.25
## [102,]     NA        NA 4519.25
## [103,]     NA        NA 4519.25
## [104,]     NA        NA 4519.25
## [105,]     NA        NA 4519.25
## [106,]     NA        NA 4519.25

Adapun plot data deret waktu dari hasil peramalan yang dilakukan adalah sebagai berikut.

ts.plot(data1.ts, xlab="Time Period ", ylab="Jumlah Penumpang", main= "SMA N=4 Data Penumpang")
points(data1.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 = train.ts-data.ramal[1:length(train.ts)]
SSE_train.sma = sum(error_train.sma[5:length(train.ts)]^2)
MSE_train.sma = mean(error_train.sma[5:length(train.ts)]^2)
MAPE_train.sma = mean(abs((error_train.sma[5:length(train.ts)]/train.ts[5:length(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 = 4")
akurasi_train.sma

##      Akurasi m = 4
## SSE   1.003965e+08
## MSE   1.239463e+06
## MAPE  1.665903e+01

Dalam hal ini nilai MAPE data uji pada metode pemulusan SMA sebesar 16%, nilai ini tidak dapat dikategorikan sebagai nilai akurasi yang sangat baik dikarenakan nilainya melebihi batas MAPE kategori sangat baik yaitu 10%. Selanjutnya dilakukan perhitungan nilai MAPE data uji pada metode pemulusan SMA.

#Menghitung nilai keakuratan data uji
error_test.sma = test.ts-data.gab[86:106,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.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   4.234859e+07
## MSE   2.016600e+06
## MAPE  1.977062e+01

Perhitungan akurasi menggunakan data uji menghasilkan nilai MAPE yang lebih dari 10% sehingga dapat dikatakan metode Single Moving Avarage (SMA) kurang cocok digunakan

Double Moving Average (DMA)

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.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,]   6458         NA         NA       NA         NA       NA
##   [2,]   7493         NA         NA       NA         NA       NA
##   [3,]   6304         NA         NA       NA         NA       NA
##   [4,]   6506    6690.25         NA       NA         NA       NA
##   [5,]   6283    6646.50         NA       NA         NA       NA
##   [6,]   7711    6701.00         NA       NA         NA       NA
##   [7,]   7868    7092.00   7607.938 7401.562  206.37500       NA
##   [8,]   7665    7381.75   8092.479 7808.188  284.29167 7607.938
##   [9,]   7324    7642.00   8371.688 8079.812  291.87500 8092.479
##  [10,]   7697    7638.50   7971.729 7838.438  133.29167 8371.688
##  [11,]   6943    7407.25   7223.708 7297.125  -73.41667 7971.729
##  [12,]   6416    7095.00   6510.521 6744.312 -233.79167 7223.708
##  [13,]   6818    6968.50   6453.812 6659.688 -205.87500 6510.521
##  [14,]   6758    6733.75   6204.792 6416.375 -211.58333 6453.812
##  [15,]   7366    6839.50   6723.354 6769.812  -46.45833 6204.792
##  [16,]   7971    7228.25   7704.500 7514.000  190.50000 6723.354
##  [17,]   6774    7217.25   7571.521 7429.812  141.70833 7704.500
##  [18,]   6696    7201.75   7335.188 7281.812   53.37500 7571.521
##  [19,]   5884    6831.25   6350.625 6542.875 -192.25000 7335.188
##  [20,]   6351    6426.25   5604.792 5933.375 -328.58333 6350.625
##  [21,]   6154    6271.25   5585.625 5859.875 -274.25000 5604.792
##  [22,]   6912    6325.25   6094.833 6187.000  -92.16667 5585.625
##  [23,]   7348    6691.25   7129.167 6954.000  175.16667 6094.833
##  [24,]   6364    6694.50   7026.062 6893.438  132.62500 7129.167
##  [25,]   5892    6629.00   6702.333 6673.000   29.33333 7026.062
##  [26,]   4833    6109.25   5406.333 5687.500 -281.16667 6702.333
##  [27,]   5709    5699.50   4726.896 5115.938 -389.04167 5406.333
##  [28,]   4862    5324.00   4296.604 4707.562 -410.95833 4726.896
##  [29,]   5913    5329.25   4852.167 5043.000 -190.83333 4296.604
##  [30,]   6439    5730.75   6080.542 5940.625  139.91667 4852.167
##  [31,]   5420    5658.50   5904.958 5806.375   98.58333 6080.542
##  [32,]   5603    5843.75   6182.396 6046.938  135.45833 5904.958
##  [33,]   4653    5528.75   5259.271 5367.062 -107.79167 6182.396
##  [34,]   4721    5099.25   4377.062 4665.938 -288.87500 5259.271
##  [35,]   5254    5057.75   4516.708 4733.125 -216.41667 4377.062
##  [36,]   6394    5255.50   5289.146 5275.688   13.45833 4516.708
##  [37,]   7707    6019.00   7120.875 6680.125  440.75000 5289.146
##  [38,]   4770    6031.25   6765.208 6471.625  293.58333 7120.875
##  [39,]   5518    6097.25   6508.083 6343.750  164.33333 6765.208
##  [40,]   4061    5514.00   4845.042 5112.625 -267.58333 6508.083
##  [41,]   4288    4659.25   3132.271 3743.062 -610.79167 4845.042
##  [42,]   4714    4645.25   3672.438 4061.562 -389.12500 3132.271
##  [43,]   6075    4784.50   4590.750 4668.250  -77.50000 3672.438
##  [44,]   6862    5484.75   6470.271 6076.062  394.20833 4590.750
##  [45,]   5118    5692.25   6593.188 6232.812  360.37500 6470.271
##  [46,]   5719    5943.50   6722.250 6410.750  311.50000 6593.188
##  [47,]   4444    5535.75   5321.896 5407.438  -85.54167 6722.250
##  [48,]   5162    5110.75   4344.396 4650.938 -306.54167 5321.896
##  [49,]   4733    5014.50   4370.125 4627.875 -257.75000 4344.396
##  [50,]   6339    5169.50   5105.958 5131.375  -25.41667 4370.125
##  [51,]   6541    5693.75   6438.125 6140.375  297.75000 5105.958
##  [52,]   5585    5799.50   6433.146 6179.688  253.45833 6438.125
##  [53,]   5530    5998.75   6554.375 6332.125  222.25000 6433.146
##  [54,]   3739    5348.75   4746.354 4987.312 -240.95833 6554.375
##  [55,]   4359    4803.25   3662.729 4118.938 -456.20833 4746.354
##  [56,]   6738    5091.50   4726.396 4872.438 -146.04167 3662.729
##  [57,]   5588    5106.00   5137.042 5124.625   12.41667 4726.396
##  [58,]   6132    5704.25   6584.250 6232.250  352.00000 5137.042
##  [59,]   5961    6104.75   7109.958 6707.875  402.08333 6584.250
##  [60,]   5938    5904.75   6237.771 6104.562  133.20833 7109.958
##  [61,]   4601    5658.00   5349.771 5473.062 -123.29167 6237.771
##  [62,]   4574    5268.50   4492.667 4803.000 -310.33333 5349.771
##  [63,]   4956    5017.25   4275.792 4572.375 -296.58333 4492.667
##  [64,]   6444    5143.75   4930.208 5015.625  -85.41667 4275.792
##  [65,]   7193    5791.75   6602.479 6278.188  324.29167 4930.208
##  [66,]   5476    6017.25   6891.833 6542.000  349.83333 6602.479
##  [67,]   5662    6193.75   6872.292 6600.875  271.41667 6891.833
##  [68,]   4136    5616.75   5136.542 5328.625 -192.08333 6872.292
##  [69,]   3905    4794.75   3359.958 3933.875 -573.91667 5136.542
##  [70,]   4332    4508.75   3225.833 3739.000 -513.16667 3359.958
##  [71,]   5901    4568.50   4062.354 4264.812 -202.45833 3225.833
##  [72,]   6737    5218.75   5962.188 5664.812  297.37500 4062.354
##  [73,]   4916    5471.50   6354.208 6001.125  353.08333 5962.188
##  [74,]   5468    5755.50   6592.062 6257.438  334.62500 6354.208
##  [75,]   4164    5321.25   5120.417 5200.750  -80.33333 6592.062
##  [76,]   4037    4646.25   3558.958 3993.875 -434.91667 5120.417
##  [77,]   3910    4394.75   3336.938 3760.062 -423.12500 3558.958
##  [78,]   6072    4545.75   4243.667 4364.500 -120.83333 3336.938
##  [79,]   6564    5145.75   5916.792 5608.375  308.41667 4243.667
##  [80,]   5026    5393.00   6264.979 5916.188  348.79167 5916.792
##  [81,]   5255    5729.25   6605.604 6255.062  350.54167 6264.979
##  [82,]   3898    5185.75   4889.604 5008.062 -118.45833 6605.604
##  [83,]   3920    4524.75   3385.688 3841.312 -455.62500 4889.604
##  [84,]   4419    4373.00   3406.021 3792.812 -386.79167 3385.688
##  [85,]   5840    4519.25   4300.188 4387.812  -87.62500 3406.021
##  [86,]     NA         NA         NA       NA         NA 4300.188
##  [87,]     NA         NA         NA       NA         NA 4212.562
##  [88,]     NA         NA         NA       NA         NA 4124.938
##  [89,]     NA         NA         NA       NA         NA 4037.312
##  [90,]     NA         NA         NA       NA         NA 3949.688
##  [91,]     NA         NA         NA       NA         NA 3862.062
##  [92,]     NA         NA         NA       NA         NA 3774.438
##  [93,]     NA         NA         NA       NA         NA 3686.812
##  [94,]     NA         NA         NA       NA         NA 3599.188
##  [95,]     NA         NA         NA       NA         NA 3511.562
##  [96,]     NA         NA         NA       NA         NA 3423.938
##  [97,]     NA         NA         NA       NA         NA 3336.312
##  [98,]     NA         NA         NA       NA         NA 3248.688
##  [99,]     NA         NA         NA       NA         NA 3161.062
## [100,]     NA         NA         NA       NA         NA 3073.438
## [101,]     NA         NA         NA       NA         NA 2985.812
## [102,]     NA         NA         NA       NA         NA 2898.188
## [103,]     NA         NA         NA       NA         NA 2810.562
## [104,]     NA         NA         NA       NA         NA 2722.938
## [105,]     NA         NA         NA       NA         NA 2635.312
## [106,]     NA         NA         NA       NA         NA 2547.688

Hasil pemulusan menggunakan metode DMA divisualisasikan sebagai berikut

ts.plot(data1.ts, xlab="Time Period ", ylab="Jumlah Penumpang", main= "DMA N=4 Data Penumpang")
points(data1.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.

#Menghitung nilai keakuratan data latih
error_train.dma = train.ts-data.ramal2[1:length(train.ts)]
SSE_train.dma = sum(error_train.dma[8:length(train.ts)]^2)
MSE_train.dma = mean(error_train.dma[8:length(train.ts)]^2)
MAPE_train.dma = mean(abs((error_train.dma[8:length(train.ts)]/train.ts[8:length(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 = 4")
akurasi_train.dma

##      Akurasi m = 4
## SSE   1.797752e+08
## MSE   2.304810e+06
## MAPE  2.395268e+01

Perhitungan akurasi pada data latih menggunakan nilai MAPE menghasilkan nilai MAPE yang lebih dari 10% sehingga tidak dapat dikategorikan sebagai akurasi yang sangat baik. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.

#Menghitung nilai keakuratan data uji
error_test.dma = test.ts-data.gab2[86:106,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.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   1.229617e+08
## MSE   5.855319e+06
## MAPE  3.537123e+01

Pada data latih maupun data uji metode SMA lebih baik dibandingkan dengan metode DMA, dikarenakan menghasilkan nilai MAPE yang lebih kecil. Namun untuk kedua metode tersebut menghasilkan nilai MAPE yang lebih dari 10% sehingga dapat dikatakan bahwa metode SMA maupun DMA kurang cocok digunakan untuk data tersebut.

Pembagian Data

#membagi training dan testing
kurstrain2<-data1[1:85,]
train2.ts<-ts(kurstrain2$Penumpang)
plot.ts(train2.ts, lty=1, xlab="waktu", ylab="Jumlah Penumpang", main="Plot Data Latih Kedatangan Penumpang Antarkota Stasiun Bandung")
points(train.ts)

kurstest2<-data1[86:106,]
test2.ts<-ts(kurstest2$Penumpang)
plot.ts(test2.ts, lty=1, xlab="waktu", ylab="Jumlah Penumpang", main="Plot Data Uji Kedatangan Penumpang Antarkota Stasiun Bandung")

Eksplorasi

Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.

#eksplorasi data
plot(data1.ts, col="black",main="Plot semua data")
points(data1.ts)

plot(train2.ts, col="red",main="Plot data latih")
points(train2.ts)

plot(test2.ts, col="blue",main="Plot data uji")
points(test2.ts)

.

#Eksplorasi dengan GGPLOT
library(ggplot2)
ggplot() + 
  geom_line(data = kurstrain2, aes(x = Tanggal, y = Penumpang, col = "Data Latih")) +
  geom_line(data = kurstest2, aes(x = Tanggal, y = Penumpang, col = "Data Uji")) +
  labs(x = "Periode Waktu", y = "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))

SES

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(train2.ts, h = 21, alpha = 0.2)
plot(ses.1)

ses.1

##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
##  86       4925.494 3725.105 6125.882 3089.658 6761.329
##  87       4925.494 3701.333 6149.655 3053.301 6797.686
##  88       4925.494 3678.014 6172.974 3017.637 6833.350
##  89       4925.494 3655.122 6195.865 2982.628 6868.360
##  90       4925.494 3632.636 6218.352 2948.238 6902.749
##  91       4925.494 3610.534 6240.453 2914.437 6936.551
##  92       4925.494 3588.798 6262.190 2881.194 6969.794
##  93       4925.494 3567.409 6283.578 2848.483 7002.505
##  94       4925.494 3546.352 6304.635 2816.279 7034.708
##  95       4925.494 3525.612 6325.375 2784.560 7066.428
##  96       4925.494 3505.175 6345.813 2753.304 7097.684
##  97       4925.494 3485.028 6365.960 2722.491 7128.497
##  98       4925.494 3465.158 6385.829 2692.103 7158.884
##  99       4925.494 3445.556 6405.432 2662.124 7188.864
## 100       4925.494 3426.209 6424.778 2632.536 7218.452
## 101       4925.494 3407.109 6443.878 2603.325 7247.663
## 102       4925.494 3388.247 6462.741 2574.477 7276.511
## 103       4925.494 3369.613 6481.375 2545.979 7305.009
## 104       4925.494 3351.199 6499.788 2517.818 7333.170
## 105       4925.494 3332.999 6517.989 2489.983 7361.005
## 106       4925.494 3315.004 6535.984 2462.462 7388.526

ses.2<- ses(train2.ts, h = 21, alpha = 0.7)
plot(ses.2)

ses.2

##     Point Forecast    Lo 80    Hi 80       Lo 95     Hi 95
##  86       5379.508 4123.613 6635.404 3458.782331  7300.235
##  87       5379.508 3846.493 6912.524 3034.963424  7724.054
##  88       5379.508 3612.307 7146.710 2676.807221  8082.210
##  89       5379.508 3405.714 7353.303 2360.850389  8398.167
##  90       5379.508 3218.784 7540.232 2074.966266  8684.051
##  91       5379.508 3046.786 7712.231 1811.918002  8947.099
##  92       5379.508 2886.627 7872.390 1566.975936  9192.041
##  93       5379.508 2736.155 8022.862 1336.847602  9422.169
##  94       5379.508 2593.798 8165.219 1119.131789  9639.885
##  95       5379.508 2458.370 8300.646  912.013419  9847.004
##  96       5379.508 2328.949 8430.068  714.080879 10044.936
##  97       5379.508 2204.800 8554.217  524.210624 10234.806
##  98       5379.508 2085.326 8673.691  341.491028 10417.526
##  99       5379.508 1970.036 8788.981  165.170322 10593.847
## 100       5379.508 1858.519 8900.498   -5.380098 10764.397
## 101       5379.508 1750.427 9008.590 -170.692199 10929.709
## 102       5379.508 1645.463 9113.554 -331.220908 11090.238
## 103       5379.508 1543.370 9215.647 -487.358889 11246.376
## 104       5379.508 1443.924 9315.092 -639.447850 11398.465
## 105       5379.508 1346.930 9412.086 -787.787351 11546.804
## 106       5379.508 1252.215 9506.802 -932.641744 11691.659

Untuk mendapatkan gambar hasil pemulusan pada data latih dengan fungsi ses() , perlu digunakan fungsi autoplot() dan autolayer() dari library packages ggplot2 .

autoplot(ses.1) +
  autolayer(fitted(ses.1), series="Fitted") +
  ylab("Membaca") + xlab("Periode")

Pada fungsi ses() , terdapat beberapa argumen yang umum digunakan, yaitu nilai 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 21 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(train2.ts, gamma = FALSE, beta = FALSE, alpha = 0.2)
plot(ses1)

#ramalan
ramalan1 <- forecast::forecast(ses1, h = 21)
ramalan1

##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
##  86       4925.494 3726.449 6124.538 3091.713 6759.274
##  87       4925.494 3702.703 6148.284 3055.397 6795.590
##  88       4925.494 3679.410 6171.578 3019.773 6831.215
##  89       4925.494 3656.544 6194.443 2984.803 6866.185
##  90       4925.494 3634.083 6216.904 2950.452 6900.536
##  91       4925.494 3612.006 6238.981 2916.688 6934.300
##  92       4925.494 3590.294 6260.693 2883.482 6967.505
##  93       4925.494 3568.930 6282.058 2850.808 7000.180
##  94       4925.494 3547.896 6303.091 2818.640 7032.347
##  95       4925.494 3527.179 6323.808 2786.956 7064.031
##  96       4925.494 3506.765 6344.223 2755.735 7095.252
##  97       4925.494 3486.640 6364.347 2724.957 7126.031
##  98       4925.494 3466.793 6384.195 2694.603 7156.384
##  99       4925.494 3447.212 6403.775 2664.657 7186.330
## 100       4925.494 3427.887 6423.100 2635.102 7215.885
## 101       4925.494 3408.809 6442.179 2605.924 7245.063
## 102       4925.494 3389.967 6461.020 2577.109 7273.879
## 103       4925.494 3371.354 6479.633 2548.642 7302.345
## 104       4925.494 3352.961 6498.026 2520.513 7330.475
## 105       4925.494 3334.781 6516.206 2492.709 7358.279
## 106       4925.494 3316.806 6534.181 2465.219 7385.769

plot(ramalan1)

ses2<- HoltWinters(train2.ts, gamma = FALSE, beta = FALSE, alpha = 0.7)
plot(ses2)

#ramalan
ramalan2 <- forecast::forecast(ses2, h = 21)
ramalan2

##     Point Forecast    Lo 80    Hi 80       Lo 95     Hi 95
##  86       5379.508 4123.452 6635.565 3458.535281  7300.482
##  87       5379.508 3846.296 6912.721 3034.661862  7724.355
##  88       5379.508 3612.080 7146.937 2676.459591  8082.557
##  89       5379.508 3405.460 7353.557 2360.462120  8398.555
##  90       5379.508 3218.507 7540.510 2074.541225  8684.476
##  91       5379.508 3046.486 7712.531 1811.459127  8947.558
##  92       5379.508 2886.307 7872.710 1566.485556  9192.531
##  93       5379.508 2735.815 8023.202 1336.327623  9422.689
##  94       5379.508 2593.440 8165.577 1118.583806  9640.433
##  95       5379.508 2457.995 8301.022  911.438795  9847.578
##  96       5379.508 2328.557 8430.460  713.480797 10045.536
##  97       5379.508 2204.392 8554.625  523.586120 10235.431
##  98       5379.508 2084.902 8674.115  340.843022 10418.174
##  99       5379.508 1969.597 8789.419  164.499638 10594.517
## 100       5379.508 1858.066 8900.951   -6.072719 10765.090
## 101       5379.508 1749.961 9009.056 -171.406083 10930.423
## 102       5379.508 1644.983 9114.034 -331.955440 11090.972
## 103       5379.508 1542.877 9216.140 -488.113504 11247.130
## 104       5379.508 1443.418 9315.599 -640.222027 11399.239
## 105       5379.508 1346.412 9412.605 -788.580608 11547.598
## 106       5379.508 1251.684 9507.333 -933.453632 11692.471

plot(ramalan2)

Fungsi HoltWinters memiliki argumen yang sama dengan fungsi ses() . Argumen-argumen kedua fungsi dapat dilihat lebih lanjut dengan ?ses() atau ?HoltWinters .

Nilai parameter \(\alpha\) dari kedua fungsi dapat dioptimalkan menyesuaikan dari error-nya paling minimumnya. Caranya adalah dengan membuat parameter \(\alpha =\) NULL .

#SES
ses.opt <- ses(train2.ts, h = 21, alpha = NULL)
plot(ses.opt)

ses.opt

##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
##  86       4945.352 3747.570 6143.134 3113.503 6777.201
##  87       4945.352 3731.961 6158.743 3089.631 6801.074
##  88       4945.352 3716.550 6174.154 3066.061 6824.643
##  89       4945.352 3701.330 6189.375 3042.784 6847.920
##  90       4945.352 3686.294 6204.411 3019.788 6870.916
##  91       4945.352 3671.435 6219.270 2997.064 6893.641
##  92       4945.352 3656.747 6233.957 2974.601 6916.103
##  93       4945.352 3642.226 6248.479 2952.392 6938.312
##  94       4945.352 3627.864 6262.841 2930.427 6960.277
##  95       4945.352 3613.657 6277.048 2908.700 6982.005
##  96       4945.352 3599.600 6291.105 2887.201 7003.503
##  97       4945.352 3585.688 6305.016 2865.925 7024.779
##  98       4945.352 3571.917 6318.787 2844.865 7045.840
##  99       4945.352 3558.283 6332.421 2824.013 7066.691
## 100       4945.352 3544.782 6345.922 2803.365 7087.339
## 101       4945.352 3531.410 6359.295 2782.914 7107.791
## 102       4945.352 3518.162 6372.542 2762.654 7128.051
## 103       4945.352 3505.037 6385.667 2742.580 7148.124
## 104       4945.352 3492.030 6398.674 2722.688 7168.016
## 105       4945.352 3479.139 6411.565 2702.973 7187.732
## 106       4945.352 3466.360 6424.344 2683.429 7207.276

#Lamda Optimum Holt Winter
sesopt<- HoltWinters(train2.ts, gamma = FALSE, beta = FALSE,alpha = NULL)
sesopt

## Holt-Winters exponential smoothing without trend and without seasonal component.
## 
## Call:
## HoltWinters(x = train2.ts, alpha = NULL, beta = FALSE, gamma = FALSE)
## 
## Smoothing parameters:
##  alpha: 0.1697445
##  beta : FALSE
##  gamma: FALSE
## 
## Coefficients:
##       [,1]
## a 4939.948

plot(sesopt)

#ramalan lamda optimum
ramalanopt <- forecast::forecast(sesopt, h = 21)
ramalanopt

##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
##  86       4939.948 3744.489 6135.406 3111.651 6768.244
##  87       4939.948 3727.389 6152.507 3085.499 6794.396
##  88       4939.948 3710.526 6169.369 3059.710 6820.185
##  89       4939.948 3693.892 6186.003 3034.270 6845.625
##  90       4939.948 3677.477 6202.418 3009.166 6870.730
##  91       4939.948 3661.273 6218.622 2984.383 6895.512
##  92       4939.948 3645.271 6234.624 2959.911 6919.984
##  93       4939.948 3629.465 6250.430 2935.738 6944.158
##  94       4939.948 3613.847 6266.048 2911.852 6968.043
##  95       4939.948 3598.412 6281.484 2888.245 6991.650
##  96       4939.948 3583.151 6296.744 2864.906 7014.989
##  97       4939.948 3568.061 6311.835 2841.827 7038.068
##  98       4939.948 3553.134 6326.761 2818.999 7060.896
##  99       4939.948 3538.367 6341.529 2796.414 7083.481
## 100       4939.948 3523.753 6356.142 2774.065 7105.830
## 101       4939.948 3509.289 6370.606 2751.944 7127.951
## 102       4939.948 3494.969 6384.926 2730.044 7149.851
## 103       4939.948 3480.791 6399.105 2708.359 7171.536
## 104       4939.948 3466.748 6413.147 2686.883 7193.012
## 105       4939.948 3452.838 6427.057 2665.610 7214.285
## 106       4939.948 3439.057 6440.838 2644.534 7235.362

plot(ramalanopt)

Setelah dilakukan peramalan, akan dilakukan perhitungan keakuratan hasil peramalan. Perhitungan akurasi ini dilakukan baik pada data latih dan data uji.

#Keakuratan Metode
#Pada data training
SSE1<-ses1$SSE
MSE1<-ses1$SSE/length(train2.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       7.335585e+07
## MSE       8.630100e+05
## RMSE      9.289833e+02

SSE2<-ses2$SSE
MSE2<-ses2$SSE/length(train2.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       7.975877e+07
## MSE       9.383384e+05
## RMSE      9.686787e+02

#Cara Manual
fitted1<-ramalan1$fitted
sisaan1<-ramalan1$residuals
head(sisaan1)

## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA 1035.000 -361.000  -86.800 -292.440 1194.048

resid1<-kurstrain2$Penumpang-ramalan1$fitted
head(resid1)

## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA 1035.000 -361.000  -86.800 -292.440 1194.048

#Cara Manual
SSE.1=sum(sisaan1[2:length(train.ts)]^2)
SSE.1

## [1] 73355852

MSE.1 = SSE.1/length(train.ts)
MSE.1

## [1] 863010

MAPE.1 = sum(abs(sisaan1[2:length(train.ts)]/train.ts[2:length(train.ts)])*
               100)/length(train.ts)
MAPE.1

## [1] 14.28288

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       7.335585e+07
## MSE       8.630100e+05
## MAPE      1.428288e+01

fitted2<-ramalan2$fitted
sisaan2<-ramalan2$residuals
head(sisaan2)

## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA 1035.000 -878.500  -61.550 -241.465 1355.561

resid2<-kurstrain2$Penumpang-ramalan2$fitted
head(resid2)

## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA 1035.000 -878.500  -61.550 -241.465 1355.561

SSE.2=sum(sisaan2[2:length(train.ts)]^2)
SSE.2

## [1] 79758765

MSE.2 = SSE.2/length(train.ts)
MSE.2

## [1] 938338.4

MAPE.2 = sum(abs(sisaan2[2:length(train.ts)]/train.ts[2:length(train.ts)])*
               100)/length(train.ts)
MAPE.2

## [1] 14.00439

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       7.975877e+07
## MSE       9.383384e+05
## MAPE      1.400439e+01

selisih1<-ramalan1$mean-kurstest2$Penumpang
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(kurstest2)
MAPEtesting1<-sum(abs(selisih1/kurstest2$Penumpang)*100)/length(kurstest2$Penumpang)

selisih2<-ramalan2$mean-kurstest2$Penumpang
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(kurstest2)
MAPEtesting2<-sum(abs(selisih2/kurstest2$Penumpang)*100)/length(kurstest2$Penumpang)

selisihopt<-ramalanopt$mean-kurstest2$Penumpang
SSEtestingopt<-sum(selisihopt^2)
MSEtestingopt<-SSEtestingopt/length(kurstest2)
MAPEtestingopt<-sum(abs(selisihopt/kurstest2$Penumpang)*100)/length(kurstest2$Penumpang)

akurasitesting1 <- matrix(c(SSEtesting1,SSEtesting2,SSEtestingopt))
row.names(akurasitesting1)<- c("SSE1", "SSE2", "SSEopt" )
akurasitesting1

##            [,1]
## SSE1   29077264
## SSE2   22447308
## SSEopt 28732773

akurasitesting2 <- matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt))
row.names(akurasitesting2)<- c("MSE1", "MSE2", "MSEopt")
akurasitesting2

##            [,1]
## MSE1   14538632
## MSE2   11223654
## MSEopt 14366386

akurasitesting3 <- matrix(c(MAPEtesting1,MAPEtesting2,MAPEtestingopt))
row.names(akurasitesting3)<- c("MAPE1", "MAPE2", "MAPEopt" )
akurasitesting3

##             [,1]
## MAPE1   17.53311
## MAPE2   16.35872
## MAPEopt 17.45879

#cara lain
accuracy(ramalanopt,kurstest2$Penumpang)

##                     ME      RMSE      MAE       MPE     MAPE      MASE
## Training set -106.4662  933.3444 780.9517 -4.586059 14.53621 0.9732063
## Test set      560.2428 1169.7125 991.6415  6.838177 17.45879 1.2357636
##                   ACF1
## Training set 0.3016086
## Test set            NA

DES

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.

Pemulusan dengan metode DES kali ini akan menggunakan fungsi HoltWinters() . Jika sebelumnya nilai argumen beta dibuat FALSE , kali ini argumen tersebut akan diinisialisasi bersamaan dengan nilai alpha .

#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::forecast(des.1, h = 21)
ramalandes1

##     Point Forecast     Lo 80    Hi 80       Lo 95     Hi 95
##  86       4748.992 3124.6195 6373.364  2264.72883  7233.255
##  87       4729.152 3058.6532 6399.652  2174.34438  7283.960
##  88       4709.313 2978.0036 6440.623  2061.50373  7357.123
##  89       4689.474 2881.8169 6497.131  1924.90106  7454.047
##  90       4669.635 2769.7439 6569.525  1764.00258  7575.266
##  91       4649.795 2641.8714 6657.719  1578.94079  7720.650
##  92       4629.956 2498.6211 6761.291  1370.36065  7889.551
##  93       4610.117 2340.6414 6879.592  1139.25372  8080.980
##  94       4590.277 2168.7094 7011.845   886.80872  8293.746
##  95       4570.438 1983.6540 7157.222   614.29324  8526.583
##  96       4550.599 1786.3009 7314.897   322.97008  8778.227
##  97       4530.759 1577.4381 7484.081    14.04427  9047.475
##  98       4510.920 1357.7965 7664.044  -311.36628  9333.207
##  99       4491.081 1128.0419 7854.120  -652.24339  9634.405
## 100       4471.242  888.7734 8053.710 -1007.67061  9950.154
## 101       4451.402  640.5267 8262.278 -1376.82890 10279.633
## 102       4431.563  383.7786 8479.347 -1758.98893 10622.115
## 103       4411.724  118.9532 8704.494 -2153.50219 10976.949
## 104       4391.884 -153.5723 8937.341 -2559.79174 11343.560
## 105       4372.045 -433.4618 9177.552 -2977.34351 11721.434
## 106       4352.206 -720.4150 9424.826 -3405.69824 12110.110

#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::forecast(des.2, h = 21)
ramalandes2

##     Point Forecast      Lo 80     Hi 80       Lo 95     Hi 95
##  86       5241.663  3759.7166  6723.609   2975.2217  7508.104
##  87       5390.969  3511.5252  7270.414   2516.6075  8265.331
##  88       5540.276  3183.0965  7897.456   1935.2810  9145.271
##  89       5689.583  2789.5085  8589.657   1254.3019 10124.864
##  90       5838.889  2340.7431  9337.036    488.9364 11188.842
##  91       5988.196  1843.5131 10132.879   -350.5495 12326.942
##  92       6137.503  1302.5414 10972.464  -1256.9325 13531.938
##  93       6286.809   721.3175 11852.301  -2224.8760 14798.495
##  94       6436.116   102.5343 12769.698  -3250.2613 16122.494
##  95       6585.423  -551.6518 13722.497  -4329.7909 17500.637
##  96       6734.729 -1239.4627 14708.922  -5460.7450 18930.204
##  97       6884.036 -1959.3958 15727.468  -6640.8259 20408.898
##  98       7033.343 -2710.1570 16776.843  -7868.0543 21934.740
##  99       7182.650 -3490.6140 17855.913  -9140.6985 23505.998
## 100       7331.956 -4299.7632 18963.676 -10457.2235 25121.136
## 101       7481.263 -5136.7055 20099.231 -11816.2545 26778.780
## 102       7630.570 -6000.6282 21261.767 -13216.5485 28477.688
## 103       7779.876 -6890.7915 22450.544 -14656.9739 30216.726
## 104       7929.183 -7806.5170 23664.883 -16136.4934 31994.859
## 105       8078.490 -8747.1796 24904.159 -17654.1509 33811.130
## 106       8227.796 -9712.2005 26167.793 -19209.0611 35664.654

Selanjutnya jika ingin membandingkan plot data latih dan data uji adalah sebagai berikut.

#Visually evaluate the prediction
plot(data1.ts)
lines(des.1$fitted[,1], lty=2, col="blue")
lines(ramalandes1$mean, col="red")

plot(data1.ts)
lines(des.2$fitted[,1], lty=2, col="blue")
lines(ramalandes2$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.8668276
##  beta : 0.09776969
##  gamma: FALSE
## 
## Coefficients:
##       [,1]
## a 5631.118
## b   66.795

plot(des.opt)

#ramalan
ramalandesopt <- forecast::forecast(des.opt, h = 21)
ramalandesopt

##     Point Forecast      Lo 80     Hi 80       Lo 95     Hi 95
##  86       5697.913  4319.6585  7076.168   3590.0545  7805.772
##  87       5764.708  3862.1681  7667.248   2855.0242  8674.392
##  88       5831.503  3452.4777  8210.529   2193.0977  9469.909
##  89       5898.298  3061.5424  8735.054   1559.8546 10236.742
##  90       5965.093  2677.3569  9252.829    936.9345 10993.252
##  91       6031.888  2293.8233  9769.953    315.0113 11748.765
##  92       6098.683  1907.4747 10289.892   -311.2170 12508.583
##  93       6165.478  1516.1992 10814.757   -944.9805 13275.937
##  94       6232.273  1118.6524 11345.894  -1588.3349 14052.881
##  95       6299.068   713.9557 11884.181  -2242.6243 14840.761
##  96       6365.863   301.5267 12430.200  -2908.7390 15640.465
##  97       6432.658  -119.0201 12984.336  -3587.2691 16452.585
##  98       6499.453  -547.9368 13546.843  -4278.5996 17277.506
##  99       6566.248  -985.3817 14117.878  -4982.9731 18115.469
## 100       6633.043 -1431.4471 14697.533  -5700.5303 18966.617
## 101       6699.838 -1886.1771 15285.853  -6431.3391 19831.015
## 102       6766.633 -2349.5815 15882.848  -7175.4140 20708.680
## 103       6833.428 -2821.6442 16488.500  -7932.7308 21599.587
## 104       6900.223 -3302.3307 17102.777  -8703.2364 22503.683
## 105       6967.018 -3791.5925 17725.629  -9486.8570 23420.893
## 106       7033.813 -4289.3713 18356.998 -10283.5031 24351.129

plot(data1.ts)
lines(des.2$fitted[,1], lty=2, col="blue")
lines(ramalandesopt$mean, col="red")

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(train2.ts)
sisaandes1<-ramalandes1$residuals
head(sisaandes1)

## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]        NA        NA -2224.000 -2523.240 -3086.702 -1763.004

mapedes.train1 <- sum(abs(sisaandes1[3:length(train2.ts)]/train.ts[3:length(train2.ts)])
                      *100)/length(train2.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.401172e+08
## MSE                     1.648437e+06
## MAPE                    1.762561e+01

ssedes.train2<-des.2$SSE
msedes.train2<-ssedes.train2/length(train2.ts)
sisaandes2<-ramalandes2$residuals
head(sisaandes2)

## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]         NA         NA -2224.0000 -1322.2800 -1148.5816   778.6424

mapedes.train2 <- sum(abs(sisaandes2[3:length(train2.ts)]/train.ts[3:length(train2.ts)])
                      *100)/length(train2.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                     1.099412e+08
## MSE                     1.293425e+06
## MAPE                    1.657644e+01

#Akurasi Data Testing
selisihdes1<-ramalandes1$mean-kurstest2$Penumpang
selisihdes1

## Time Series:
## Start = 86 
## End = 106 
## Frequency = 1 
##  [1] -1837.0083  -359.8476  -787.6869   795.4738   418.6345   718.7952
##  [7]  -966.0441 -1481.8834 -1135.7227 -1457.5620   623.5987  -786.2406
## [13] -3240.0799 -1714.9192 -2164.7585 -2280.5978 -1314.4371  -179.2764
## [19]  -124.1157  -736.9550 -1930.7943

SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(kurstest2$Penumpang)
MAPEtestingdes1<-sum(abs(selisihdes1/kurstest2$Penumpang)*100)/length(kurstest2$Penumpang)

selisihdes2<-ramalandes2$mean-kurstest2$Penumpang
selisihdes2

## Time Series:
## Start = 86 
## End = 106 
## Frequency = 1 
##  [1] -1344.33729   301.96939    43.27606  1795.58274  1587.88942  2057.19610
##  [7]   541.50278   194.80945   710.11613   557.42281  2807.72949  1567.03617
## [13]  -717.65715   976.64952   695.95620   749.26288  1884.56956  3188.87624
## [19]  3413.18291  2969.48959  1944.79627

SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(kurstest2$Penumpang)
MAPEtestingdes2<-sum(abs(selisihdes2/kurstest2$Penumpang)*100)/length(kurstest2$Penumpang)

selisihdesopt<-ramalandesopt$mean-kurstest2$Penumpang
selisihdesopt

## Time Series:
## Start = 86 
## End = 106 
## Frequency = 1 
##  [1]  -888.08683   675.70817   334.50316  2004.29816  1714.09316  2100.88816
##  [7]   502.68316    73.47816   506.27316   271.06816  2438.86316  1115.65815
## [13] -1251.54685   360.24815    -2.95685   -32.16185  1020.63315  2242.42815
## [19]  2384.22315  1858.01814   750.81314

SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(kurstest2$Penumpang)
MAPEtestingdesopt<-sum(abs(selisihdesopt/kurstest2$Penumpang)*100)/length(kurstest2$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  4.237259e+07 6.384805e+07 3.797470e+07
## MSE  2.017742e+06 3.040384e+06 1.808319e+06
## MAPE 2.022581e+01 2.914051e+01 2.261398e+01

MSEfull <-
  matrix(c(MAPEtesting1,MAPEtesting2,MAPEtestingopt,MAPEtestingdes1,MAPEtestingdes2,
           MAPEtestingdesopt),nrow=3,ncol=2)
row.names(MSEfull)<- c("ske 1", "ske 2", "ske opt")
colnames(MSEfull) <- c("ses","des")
MSEfull

##              ses      des
## ske 1   17.53311 20.22581
## ske 2   16.35872 29.14051
## ske opt 17.45879 22.61398

Winter Aditif

Perhitungan dengan model aditif dilakukan jika plot data asli menunjukkan fluktuasi musiman yang relatif stabil (konstan).

#Pemulusan dengan winter aditif 
winter1 <- HoltWinters(training3.ts,alpha=0.2,beta=0.1,gamma=0.1,seasonal = "additive")
winter1$fitted

## Time Series:
## Start = c(2, 1) 
## End = c(13, 1) 
## Frequency = 7 
##               xhat    level       trend      season
##  2.000000 7282.908 7053.556   30.301020   199.05102
##  2.142857 7037.269 7160.276   37.942857  -160.94898
##  2.285714 7638.864 7255.564   43.677469   339.62245
##  2.428571 6952.689 7310.869   44.840181  -403.02041
##  2.571429 6452.755 7353.771   44.646404  -945.66327
##  2.714286 7941.458 7391.067   43.911312   506.47959
##  2.857143 7696.208 7210.287   21.442154   464.47959
##  3.000000 7276.384 7044.087    2.677985   229.61837
##  3.142857 6931.148 7064.688    4.470315  -138.01053
##  3.285714 7646.670 7277.129   25.267350   344.27330
##  3.428571 6731.881 7127.863    7.813955  -403.79552
##  3.571429 6186.993 7128.500    7.096336  -948.60364
##  3.714286 7492.637 7074.998    1.036476   416.60296
##  3.857143 7215.334 6847.707  -21.796273   389.42292
##  4.000000 6807.409 6613.644  -43.022946   236.78769
##  4.142857 6495.786 6591.539  -40.931121   -54.82239
##  4.285714 6971.624 6721.051  -23.886837   274.45972
##  4.428571 6132.934 6575.639  -36.039315  -406.66599
##  4.571429 5477.712 6491.413  -40.857997  -972.84307
##  4.714286 6593.133 6321.613  -53.752241   325.27197
##  4.857143 6324.115 6091.034  -71.434892   304.51622
##  5.000000 5871.654 5727.176 -100.677200   245.15499
##  5.142857 5548.273 5634.768  -99.850278    13.35475
##  5.285714 5856.877 5713.063  -82.035730   225.84980
##  5.428571 5026.938 5543.652  -90.773278  -425.94072
##  5.571429 4464.419 5568.091  -79.252041 -1024.42005
##  5.714286 5705.616 5526.555  -75.480423   254.54136
##  5.857143 5346.526 5254.152  -95.172749   187.54699
##  6.000000 5291.913 5140.474  -97.023267   248.46267
##  6.142857 5273.499 5263.868  -74.981530    84.61294
##  6.285714 5840.175 5675.586  -26.311515   190.89961
##  6.428571 5007.669 5435.240  -47.715006  -379.85577
##  6.571429 4442.749 5489.591  -37.508392 -1009.33358
##  6.714286 5506.362 5375.733  -45.143376   175.77206
##  6.857143 5197.552 5086.917  -69.510608   180.14492
##  7.000000 5178.144 4920.696  -79.181639   336.62962
##  7.142857 5238.934 5020.886  -61.244525   279.29300
##  7.285714 5360.757 5284.254  -28.783211   105.28565
##  7.428571 4834.252 5206.920  -33.638349  -339.02931
##  7.571429 4294.414 5350.231  -15.943393 -1039.87352
##  7.714286 5429.556 5364.205  -12.951676    78.30313
##  7.857143 5420.900 5297.742  -18.302802   141.46079
##  8.000000 5518.176 5141.859  -32.060800   408.37808
##  8.142857 5667.457 5273.963  -15.644328   409.13826
##  8.285714 5520.719 5433.027    1.826533    85.86510
##  8.428571 5182.573 5447.710    3.112154  -268.24949
##  8.571429 4502.462 5520.308   10.060699 -1027.90665
##  8.714286 5429.366 5377.676   -5.208535    56.89862
##  8.857143 5218.207 5158.394  -26.615858    86.42880
##  9.000000 5913.561 5435.737    3.779998   474.04397
##  9.142857 5850.695 5374.405   -2.731221   479.02170
##  9.285714 5521.837 5427.935    2.894874    91.00758
##  9.428571 5289.885 5518.662   11.678135  -240.45531
##  9.571429 4595.620 5659.963   24.640439 -1088.98359
##  9.714286 5681.697 5685.680   24.748038   -28.73067
##  9.857143 5699.495 5488.888    2.594099   208.01222
## 10.000000 5778.507 5342.783  -12.275792   447.99909
## 10.142857 5966.166 5463.606    1.034073   501.52608
## 10.285714 5861.718 5710.007   25.570744   126.14062
## 10.428571 5487.684 5658.434   17.856376  -188.60609
## 10.571429 4643.943 5711.154   21.342687 -1088.55319
## 10.714286 5524.745 5630.908   11.183825  -117.34642
## 10.857143 5445.464 5318.142  -21.211077   148.53266
## 11.000000 5531.997 5074.239  -43.480359   501.23855
## 11.142857 5668.131 5104.559  -36.100294   599.67276
## 11.285714 5362.793 5282.232  -14.722921    95.28315
## 11.428571 4979.831 5178.151  -23.658772  -174.66084
## 11.571429 4109.042 5252.126  -13.895398 -1129.18864
## 11.714286 4989.500 5249.222  -12.796234  -246.92603
## 11.857143 5073.535 5045.926  -31.846231    59.45553
## 12.000000 5257.015 4781.373  -55.116935   530.75881
## 12.142857 5535.618 4889.253  -38.817225   685.18225
## 12.285714 5097.402 5056.112  -18.249581    59.53974
## 12.428571 4868.297 5023.582  -19.677625  -135.60735
## 12.571429 3944.509 5081.245  -11.943565 -1124.79198
## 12.714286 4724.000 5060.000  -12.873753  -323.12602
## 12.857143 4823.745 4886.326  -28.953748   -33.62728
## 13.000000 5335.332 4776.423  -37.048644   595.95765

xhat1 <- winter1$fitted[,2]

winter1.opt<- HoltWinters(training3.ts, alpha= NULL,  beta = NULL, gamma = NULL, seasonal = "additive")
winter1.opt

## Holt-Winters exponential smoothing with trend and additive seasonal component.
## 
## Call:
## HoltWinters(x = training3.ts, alpha = NULL, beta = NULL, gamma = NULL,     seasonal = "additive")
## 
## Smoothing parameters:
##  alpha: 0.1932087
##  beta : 0.08177298
##  gamma: 0.583315
## 
## Coefficients:
##           [,1]
## a   5146.95839
## b    -14.99438
## s1  1354.05577
## s2  -185.00981
## s3   120.43951
## s4 -1245.32207
## s5 -1254.76422
## s6  -859.74445
## s7   721.12758

winter1.opt$fitted

## Time Series:
## Start = c(2, 1) 
## End = c(13, 1) 
## Frequency = 7 
##               xhat    level       trend      season
##  2.000000 7282.908 7053.556  30.3010204   199.05102
##  2.142857 7033.069 7157.681  36.3377853  -160.94898
##  2.285714 7630.785 7250.229  40.9342706   339.62245
##  2.428571 6942.916 7303.956  41.9804111  -403.02041
##  2.571429 6442.271 7345.953  41.9817347  -945.66327
##  2.714286 7930.905 7382.859  41.5666681   506.47959
##  2.857143 7697.866 7209.402  23.9836030   464.47959
##  3.000000 7439.799 7051.796   9.1344296   378.86860
##  3.142857 7030.607 7046.672   7.9684630   -24.03312
##  3.285714 7629.942 7236.332  22.8259679   370.78392
##  3.428571 6700.104 7093.783   9.3027232  -402.98098
##  3.571429 6153.503 7102.292   9.2378754  -958.02689
##  3.714286 7047.171 7059.460   4.9799229   -17.26851
##  3.857143 6946.081 6929.933  -6.0190626    22.16613
##  4.000000 7096.482 6770.878 -18.5333420   344.13786
##  4.142857 7113.781 6716.701 -21.4480206   418.52851
##  4.285714 6690.724 6740.506 -17.7475384   -32.03401
##  4.428571 6231.810 6659.632 -22.9095364  -404.91261
##  4.571429 5457.931 6571.068 -28.2782818 -1084.85884
##  4.714286 6039.000 6422.048 -38.1517288  -344.89614
##  4.857143 5926.174 6320.137 -43.3654838  -350.59767
##  5.000000 6268.304 6071.164 -60.1786396   257.31811
##  5.142857 6405.301 5942.338 -65.7921709   528.75506
##  5.285714 5632.002 5883.057 -65.2597465  -185.79484
##  5.428571 5143.395 5776.836 -68.6092196  -564.83184
##  5.571429 4356.719 5797.027 -61.3478074 -1378.95996
##  5.714286 5236.057 5792.923 -56.6667877  -500.19865
##  5.857143 4720.526 5636.743 -64.8043104  -851.41242
##  6.000000 5708.742 5675.010 -56.3758180    90.10742
##  6.142857 6250.097 5751.032 -45.5492502   544.61443
##  6.285714 5678.872 5986.969 -22.5312790  -285.56585
##  6.428571 5403.410 5788.836 -36.8907769  -348.53560
##  6.571429 4499.479 5774.085 -35.0803334 -1239.52607
##  6.714286 4869.687 5654.287 -42.0079670  -742.59167
##  6.857143 4848.341 5499.892 -51.1981885  -600.35227
##  7.000000 5782.016 5422.738 -53.3206810   412.59923
##  7.142857 6607.585 5426.024 -48.6917571  1230.25249
##  7.285714 4668.522 5426.488 -44.6721868  -713.29331
##  7.428571 5136.480 5468.658 -37.5707713  -294.60778
##  7.571429 4069.388 5543.636 -28.3673889 -1445.88002
##  7.714286 4548.856 5587.646 -22.4488025 -1016.34150
##  7.857143 5007.326 5683.662 -12.7615890  -663.57512
##  8.000000 6151.284 5617.899 -17.0957292   550.48134
##  8.142857 6972.925 5637.071 -14.1299616  1349.98374
##  8.285714 5016.773 5539.490 -20.9540538  -501.76290
##  8.428571 5595.880 5628.322 -11.9764876   -20.46592
##  8.571429 4321.017 5603.617 -13.0173364 -1269.58264
##  8.714286 4728.148 5478.149 -22.2127701  -727.78773
##  8.857143 4563.892 5384.613 -28.0450389  -792.67649
##  9.000000 6421.752 5776.625   6.3042402   638.82288
##  9.142857 6761.687 5621.841  -6.8684196  1146.71398
##  9.285714 5242.147 5493.312 -16.8169973  -234.34745
##  9.428571 5558.454 5615.383  -5.4596628   -51.46977
##  9.571429 4140.304 5683.255   0.5368811 -1543.48772
##  9.714286 4879.104 5772.803   7.8155259  -901.51397
##  9.857143 5955.153 5721.669   2.9951093   230.48811
## 10.000000 5765.277 5531.619 -12.7907526   246.44786
## 10.142857 6498.271 5649.964  -2.0674305   850.37494
## 10.285714 5894.987 5782.124   8.9087598   103.95434
## 10.428571 5839.520 5710.081   2.2890750   127.14975
## 10.571429 4350.878 5678.072  -0.5156040 -1326.67818
## 10.714286 4587.029 5636.040  -3.9105132 -1045.10008
## 10.857143 5245.943 5500.355 -14.6860632  -239.72656
## 11.000000 5845.826 5309.088 -29.1256727   565.86427
## 11.142857 6439.692 5290.622 -28.2539670  1177.32355
## 11.285714 5203.027 5319.811 -23.5567156   -93.22671
## 11.428571 5256.313 5240.798 -28.0915292    43.60656
## 11.571429 3801.056 5253.606 -24.7470288 -1427.80260
## 11.714286 3913.898 5298.983 -19.0127912 -1366.07222
## 11.857143 4616.846 5303.754 -17.0678691  -669.84031
## 12.000000 5713.712 5150.118 -28.2355109   591.82984
## 12.142857 6485.773 5191.107 -22.5748297  1317.24094
## 12.285714 4934.001 5183.646 -21.3388966  -228.30555
## 12.428571 5303.426 5180.082 -19.8853890   143.22945
## 12.571429 3873.193 5150.840 -20.6504838 -1256.99642
## 12.714286 3806.585 5134.983 -20.2585570 -1308.13867
## 12.857143 4115.678 5136.637 -18.4666911 -1002.49171
## 13.000000 5923.545 5176.774 -13.6744362   760.44498

xhat1.opt <- winter1.opt$fitted[,2]

#Forecast
forecast1 <- predict(winter1, n.ahead = 21)
forecast1.opt <- predict(winter1.opt, n.ahead = 21)

#Plot time series
plot(training3.ts,main="Metode Winter",type="l",col="black",
     xlim=c(1,17),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(training3.ts)
RMSE1<-sqrt(MSE1)
fitted_values <- winter1$fitted[,1]
abs_error <- abs(training3.ts - fitted_values)
MAPE1 <- mean(abs_error / training3.ts * 100)

akurasi1 <- matrix(c(SSE1,MSE1,RMSE1,MAPE1))
row.names(akurasi1)<- c("SSE", "MSE", "RMSE", "MAPE")
colnames(akurasi1) <- c("Akurasi")
akurasi1

##           Akurasi
## SSE  5.018447e+07
## MSE  5.904055e+05
## RMSE 7.683785e+02
## MAPE 1.182947e+01

SSE1.opt<-winter1.opt$SSE
MSE1.opt<-winter1.opt$SSE/length(training3.ts)
RMSE1.opt<-sqrt(MSE1.opt)
fitted_values <- winter1.opt$fitted[,1]
abs_error <- abs(training3.ts - fitted_values)
MAPE1.opt <- mean(abs_error / training3.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  2.581920e+07
## MSE1.opt  3.037553e+05
## RMSE1.opt 5.511400e+02
## MAPE1.opt 8.056276e+00

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  50184469  590405.5   768.3785  11.829466
## 2 Winter1 optimal  25819201  303755.3   551.1400   8.056276

forecast1<-data.frame(forecast1)
testing3.ts<-data.frame(testing3.ts)
selisih1<-forecast1-testing3.ts
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(testing3.ts)
MAPEtesting1<-sum(abs(selisih1/testing3.ts$Penumpang)*100)/length(testing3.ts$Penumpang)

forecast1.opt<-data.frame(forecast1.opt)
selisih1.opt<-forecast1.opt-testing3.ts
SSEtesting1.opt<-sum(selisih1.opt^2)
MSEtesting1.opt<-SSEtesting1.opt/length(testing3.ts)
MAPEtesting1.opt<-sum(abs(selisih1.opt/testing3.ts$Penumpang)*100)/length(testing3.ts$Penumpang)

akurasi1.test = data.frame(Model_Winter = c("Winter 1","Winter 1 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  34678108  34678108   18.18519
## 2 Winter 1 optimal  26662513  26662513   13.34036

forecast1 <- predict(winter1, n.ahead = 21)
forecast1.opt <- predict(winter1.opt, n.ahead = 21)
accuracy(forecast1,testing3.ts$Penumpang)

##                ME     RMSE      MAE      MPE     MAPE
## Test set 989.1085 1285.044 1060.409 16.38362 18.18519

accuracy(forecast1.opt,testing3.ts$Penumpang)

##                ME     RMSE      MAE      MPE     MAPE
## Test set 710.9157 1126.785 779.7187 11.95899 13.34036

Winter Multiplikatif

Model multiplikatif digunakan cocok digunakan jika plot data asli menunjukkan fluktuasi musiman yang bervariasi.

#Pemulusan dengan winter multiplikatif 
winter2 <- HoltWinters(training3.ts,alpha=0.2,beta=0.1,gamma=0.3,seasonal = "multiplicative")
winter2$fitted

## Time Series:
## Start = c(2, 1) 
## End = c(13, 1) 
## Frequency = 7 
##               xhat    level       trend    season
##  2.000000 7273.984 7053.556  30.3010204 1.0268394
##  2.142857 7044.111 7160.016  37.9169371 0.9786297
##  2.285714 7638.700 7255.133  43.6369521 1.0465736
##  2.428571 6943.363 7309.911  44.7510598 0.9440763
##  2.571429 6435.617 7354.586  44.7433762 0.8697569
##  2.714286 7967.791 7394.818  44.2922760 1.0710678
##  2.857143 7704.217 7224.410  22.8222769 1.0630563
##  3.000000 7356.823 7069.214   5.0204635 1.0399461
##  3.142857 6995.432 7076.000   5.1969550 0.9878884
##  3.285714 7657.787 7278.702  24.9475197 1.0484877
##  3.428571 6743.600 7135.067   8.0891998 0.9440645
##  3.571429 6205.651 7133.072   7.0807975 0.8691202
##  3.714286 7298.074 7066.135  -0.3209630 1.0328709
##  3.857143 7076.080 6882.427 -18.6596293 1.0309323
##  4.000000 6915.982 6684.885 -36.5478994 1.0402573
##  4.142857 6743.535 6647.572 -36.6244518 1.0200557
##  4.285714 6830.471 6729.463 -24.7728371 1.0187600
##  4.428571 6200.637 6613.114 -33.9304545 0.9424629
##  4.571429 5555.277 6513.688 -40.4800392 0.8581954
##  4.714286 6246.603 6304.883 -57.3125068 0.9998451
##  4.857143 6058.778 6140.034 -68.0662336 0.9978279
##  5.000000 5970.290 5832.091 -92.0539029 1.0401136
##  5.142857 5870.393 5729.021 -93.1555197 1.0416134
##  5.285714 5673.175 5745.043 -82.2377016 1.0018311
##  5.428571 5144.251 5612.263 -87.2919405 0.9310911
##  5.571429 4607.131 5623.511 -77.4379380 0.8307014
##  5.714286 5364.763 5557.117 -76.3335877 0.9788314
##  5.857143 4989.294 5349.246 -89.4872881 0.9485785
##  6.000000 5428.969 5315.570 -83.9061842 1.0377136
##  6.142857 5702.216 5417.656 -65.3069996 1.0653671
##  6.285714 5649.749 5728.704 -27.6714454 0.9910045
##  6.428571 5207.824 5523.486 -45.4261357 0.9506695
##  6.571429 4583.428 5543.314 -38.9007215 0.8326824
##  6.714286 5060.834 5378.932 -51.4487900 0.9499483
##  6.857143 4895.873 5164.773 -67.7198618 0.9605301
##  7.000000 5389.006 5059.184 -71.5067857 1.0804641
##  7.142857 5810.972 5114.658 -58.8086500 1.1493561
##  7.285714 4952.753 5238.740 -40.5196550 0.9527786
##  7.428571 5009.318 5232.907 -37.0509177 0.9640987
##  7.571429 4306.468 5343.078 -22.3287420 0.8093724
##  7.714286 4877.116 5354.734 -18.9302545 0.9140357
##  7.857143 5126.416 5398.140 -12.6967030 0.9519023
##  8.000000 5876.838 5302.784 -20.9625833 1.1126536
##  8.142857 6409.342 5364.895 -12.6552015 1.1975064
##  8.285714 5151.139 5374.229 -10.4563265 0.9603575
##  8.428571 5430.765 5454.127  -1.4209215 0.9959761
##  8.571429 4463.599 5472.633   0.5718031 0.8155366
##  8.714286 4891.417 5295.506 -17.1980663 0.9267016
##  8.857143 4796.319 5163.402 -28.6886377 0.9340966
##  9.000000 6305.084 5550.448  12.8848219 1.1333286
##  9.142857 6542.832 5436.788   0.2303375 1.2033859
##  9.285714 5251.943 5368.739  -6.5975888 0.9794488
##  9.428571 5516.619 5506.929   7.8810984 1.0003280
##  9.571429 4395.127 5599.058  16.3059591 0.7826967
##  9.714286 5131.703 5667.970  21.5665565 0.9019544
##  9.857143 5675.726 5565.871   9.2000202 1.0180544
## 10.000000 5980.700 5433.679  -4.9392274 1.1016738
## 10.142857 6536.951 5512.848   3.4716020 1.1850204
## 10.285714 5699.981 5627.043  14.5439626 1.0103505
## 10.428571 5710.481 5597.250  10.1102404 1.0183903
## 10.571429 4437.456 5597.839   9.1581276 0.7914141
## 10.714286 4856.890 5530.816   1.5399552 0.8779063
## 10.857143 5222.623 5315.501 -20.1454934 0.9862649
## 11.000000 5695.088 5114.750 -38.2060184 1.1218434
## 11.142857 6160.494 5113.254 -34.5350549 1.2130016
## 11.285714 5152.588 5173.773 -25.0296150 1.0007466
## 11.428571 5154.432 5101.461 -29.7578426 1.0163117
## 11.571429 3977.144 5133.411 -23.5871297 0.7783329
## 11.714286 4290.736 5157.838 -18.7856790 0.8349275
## 11.857143 4772.813 5078.272 -24.8637222 0.9444741
## 12.000000 5462.431 4870.701 -43.1344813 1.1315083
## 12.142857 6078.406 4935.311 -32.3600309 1.2397445
## 12.285714 4905.292 4981.288 -24.5262538 0.9896163
## 12.428571 5112.662 4981.157 -22.0867726 1.0309718
## 12.571429 3909.447 4986.683 -19.3255247 0.7870275
## 12.714286 4069.280 4964.448 -19.6164095 0.8229359
## 12.857143 4406.350 4908.552 -23.2443881 0.9019596
## 13.000000 5649.173 4888.113 -22.9638924 1.1611511

xhat2 <- winter2$fitted[,2]

winter2.opt<- HoltWinters(training3.ts, alpha= NULL,  beta = NULL, gamma = NULL, seasonal = "multiplicative")
winter2.opt$fitted

## Time Series:
## Start = c(2, 1) 
## End = c(13, 1) 
## Frequency = 7 
##               xhat    level      trend    season
##  2.000000 7273.984 7053.556  30.301020 1.0268394
##  2.142857 7038.835 7158.820  33.722166 0.9786297
##  2.285714 7625.592 7249.905  36.340090 1.0465736
##  2.428571 6926.339 7299.677  36.953088 0.9440763
##  2.571429 6416.384 7340.104  37.111645 0.8697569
##  2.714286 7941.150 7377.129  37.107676 1.0710678
##  2.857143 7691.736 7207.806  27.686608 1.0630563
##  3.000000 7469.921 7062.582  19.795331 1.0547195
##  3.142857 7072.734 7062.981  18.910121 0.9987069
##  3.285714 7661.655 7258.951  26.990776 1.0515669
##  3.428571 6748.199 7119.769  19.406978 0.9452350
##  3.571429 6216.150 7128.305  18.910845 0.8697303
##  3.714286 7027.482 7072.035  15.479780 0.9915298
##  3.857143 6931.729 6953.206   9.350207 0.9955724
##  4.000000 7132.652 6808.773   2.331858 1.0472092
##  4.142857 7188.937 6769.626   0.438844 1.0618711
##  4.285714 6719.237 6799.554   1.784634 0.9879286
##  4.428571 6335.435 6730.553  -1.445880 0.9414972
##  4.571429 5607.970 6636.389  -5.677342 0.8457569
##  4.714286 6062.266 6450.329 -13.909593 0.9418693
##  4.857143 5947.253 6362.584 -17.279289 0.9372682
##  5.000000 6275.856 6117.365 -27.681999 1.0305719
##  5.142857 6431.624 6020.371 -30.845265 1.0738118
##  5.285714 5727.579 5990.878 -30.783548 0.9609880
##  5.428571 5320.419 5897.087 -33.659084 0.9073906
##  5.571429 4623.337 5924.734 -30.861214 0.7844312
##  5.714286 5363.140 5901.316 -30.521481 0.9135287
##  5.857143 4822.532 5732.419 -36.836677 0.8467145
##  6.000000 5762.528 5795.897 -32.258516 0.9998073
##  6.142857 6297.712 5887.973 -26.584150 1.0744403
##  6.285714 5704.108 6119.597 -14.800041 0.9343649
##  6.428571 5482.531 5907.993 -23.781774 0.9317358
##  6.571429 4618.307 5891.706 -23.439764 0.7869968
##  6.714286 4880.392 5728.862 -29.801867 0.8563504
##  6.857143 4889.689 5562.881 -36.016812 0.8847131
##  7.000000 5747.268 5487.771 -37.800920 1.0545502
##  7.142857 6527.498 5511.150 -35.008816 1.1919887
##  7.285714 4694.191 5531.384 -32.487625 0.8536605
##  7.428571 5205.578 5596.629 -28.027319 0.9348087
##  7.571429 4168.655 5676.722 -23.092952 0.7373415
##  7.714286 4577.304 5727.141 -19.737990 0.8019941
##  7.857143 5069.324 5850.923 -13.188033 0.8683717
##  8.000000 6232.584 5761.491 -16.667654 1.0849043
##  8.142857 7029.402 5764.133 -15.786412 1.2228564
##  8.285714 5041.882 5669.722 -19.374655 0.8923135
##  8.428571 5646.744 5770.168 -13.906305 0.9809742
##  8.571429 4356.332 5732.834 -14.975501 0.7618818
##  8.714286 4722.305 5558.350 -22.255155 0.8530030
##  8.857143 4550.251 5452.250 -26.081643 0.8385754
##  9.000000 6497.141 5939.749  -2.642875 1.0943278
##  9.142857 6794.459 5773.561 -10.106728 1.1788865
##  9.285714 5301.437 5652.833 -15.155273 0.9403583
##  9.428571 5597.235 5775.753  -8.853795 0.9705796
##  9.571429 4111.486 5836.015  -5.699494 0.7051909
##  9.714286 4887.330 5966.966   0.536966 0.8189907
##  9.857143 6045.828 5892.189  -2.900214 1.0265803
## 10.000000 5746.941 5680.302 -12.437933 1.0139517
## 10.142857 6487.168 5803.198  -6.261584 1.1190684
## 10.285714 5912.498 5921.101  -0.594966 0.9986474
## 10.428571 5832.178 5834.462  -4.521865 1.0003839
## 10.571429 4325.810 5796.452  -6.050191 0.7470656
## 10.714286 4538.910 5740.385  -8.332842 0.7918473
## 10.857143 5162.291 5574.458 -15.525104 0.9286479
## 11.000000 5762.730 5382.925 -23.557755 1.0752632
## 11.142857 6327.035 5384.681 -22.402464 1.1799153
## 11.285714 5197.430 5430.678 -19.280877 0.9604599
## 11.428571 5253.947 5353.714 -21.913387 0.9853981
## 11.571429 3909.865 5374.564 -19.961791 0.7301878
## 11.714286 3967.142 5423.117 -16.834921 0.7338023
## 11.857143 4597.231 5425.023 -15.979623 0.8499157
## 12.000000 5688.500 5249.866 -23.244130 1.0883703
## 12.142857 6428.422 5295.987 -20.078444 1.2184483
## 12.285714 4928.373 5297.813 -19.078762 0.9336278
## 12.428571 5311.427 5299.319 -18.139311 1.0057272
## 12.571429 3960.189 5270.135 -18.643372 0.7541075
## 12.714286 3861.703 5235.258 -19.384276 0.7403752
## 12.857143 4082.051 5231.374 -18.676862 0.7830976
## 13.000000 5944.670 5297.401 -14.811161 1.1253326

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(training3.ts,main="Winter Multiplicative",type="l",col="black",
     xlim=c(1,17),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(training3.ts)
RMSE2<-sqrt(MSE2)
fitted_values <- winter2$fitted[,1]
abs_error <- abs(training3.ts - fitted_values)
MAPE2 <- mean(abs_error / training3.ts * 100)

akurasi2 <- matrix(c(SSE2,MSE2,RMSE2,MAPE2))
row.names(akurasi2)<- c("SSE2", "MSE2", "RMSE2", "MAPE2")
colnames(akurasi2) <- c("Akurasi lamda=0.2")
akurasi1

##           Akurasi
## SSE  5.018447e+07
## MSE  5.904055e+05
## RMSE 7.683785e+02
## MAPE 1.182947e+01

SSE2.opt<-winter2.opt$SSE
MSE2.opt<-winter2.opt$SSE/length(training3.ts)
RMSE2.opt<-sqrt(MSE2.opt)
fitted_values <- winter2.opt$fitted[,1]
abs_error <- abs(training3.ts - fitted_values)
MAPE2.opt <- mean(abs_error / training3.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  2.619855e+07
## MSE2.opt  3.082182e+05
## RMSE2.opt 5.551740e+02
## MAPE2.opt 8.087406e+00

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  30936207  363955.4   603.2871   8.739516
## 2 winter2 optimal  26198549  308218.2   555.1740   8.087406

forecast2<-data.frame(forecast2)
testing3.ts<-data.frame(testing3.ts)
selisih2<-forecast2-testing3.ts
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(testing3.ts)
MAPEtesting2<-sum(abs(selisih2/testing3.ts$Penumpang)*100)/length(testing3.ts$Penumpang)

forecast2.opt<-data.frame(forecast2.opt)
selisih2.opt<-forecast2.opt-testing3.ts
SSEtesting2.opt<-sum(selisih2.opt^2)
MSEtesting2.opt<-SSEtesting2.opt/length(testing3.ts)
MAPEtesting2.opt<-sum(abs(selisih2.opt/testing3.ts$Penumpang)*100)/length(testing3.ts$Penumpang)

akurasi2.test = data.frame(Model_Winter = c("Winter 2","Winter 2 optimal"),
                            Nilai_SSE=c(SSEtesting2,SSEtesting2.opt),
                            Nilai_MSE=c(MSEtesting2,MSEtesting2.opt),Nilai_MAPE=c(MAPEtesting2,MAPEtesting2.opt))
akurasi2.test

##       Model_Winter Nilai_SSE Nilai_MSE Nilai_MAPE
## 1         Winter 2  29070073  29070073   14.88042
## 2 Winter 2 optimal  25810139  25810139   12.91135

forecast2 <- predict(winter2, n.ahead = 21)
forecast2.opt <- predict(winter2.opt, n.ahead = 21)
accuracy(forecast2,testing3.ts$Penumpang)

##                ME     RMSE      MAE      MPE     MAPE
## Test set 835.6942 1176.558 872.1985 13.95179 14.88042

accuracy(forecast2.opt,testing3.ts$Penumpang)

##                ME     RMSE      MAE      MPE     MAPE
## Test set 697.3363 1108.627 761.6365 11.58912 12.91135