Pertemuan 1 - Pemulusan
Kheni Hikmah Lestari
Library / Packages
Package R yang akan digunakan adalah forecast,
graphics, TTR, TSA . Kemudian
panggil library package tersebut.
library("forecast")## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary("graphics")
library("TTR")
library("TSA")## Registered S3 methods overwritten by 'TSA':
## method from
## fitted.Arima forecast
## plot.Arima forecast##
## Attaching package: 'TSA'## The following objects are masked from 'package:stats':
##
## acf, arima## The following object is masked from 'package:utils':
##
## tarlibrary("rio")Impor Data
Data yang digunakan adalah data penumpang masuk menurut maskapai penerbangan. Data penumpang maskapai China Eastern Airlines tujuan ke China.
data = import("https://raw.githubusercontent.com/khenihikmah/praktikummpdw/main/Pertemuan1/Data%20Penumpang%20Pesawat.csv")
data## Month Passengers
## 1 1 13224
## 2 2 10789
## 3 3 6434
## 4 4 6433
## 5 5 4002
## 6 6 3540
## 7 7 7214
## 8 8 5294
## 9 9 4570
## 10 10 7315
## 11 11 7210
## 12 12 7801
## 13 13 10677
## 14 14 13367
## 15 15 8047
## 16 16 7286
## 17 17 5440
## 18 18 6423
## 19 19 10193
## 20 20 8830
## 21 21 8170
## 22 22 10606
## 23 23 9898
## 24 24 12807
## 25 25 18810
## 26 26 14584
## 27 27 8525
## 28 28 7987
## 29 29 7595
## 30 30 8146
## 31 31 14233
## 32 32 11762
## 33 33 10758
## 34 34 13648
## 35 35 11995
## 36 36 12600
## 37 37 16191
## 38 38 13642
## 39 39 14349
## 40 40 14261
## 41 41 12606
## 42 42 12565
## 43 43 15547
## 44 44 13013
## 45 45 12823
## 46 46 15167
## 47 47 17486
## 48 48 18651
## 49 49 21201
## 50 50 22568
## 51 51 19143
## 52 52 18401
## 53 53 15417
## 54 54 14021
## 55 55 17872
## 56 56 14866
## 57 57 16354
## 58 58 15542
## 59 59 15501
## 60 60 17671
## 61 61 28195
## 62 62 23112
## 63 63 15725
## 64 64 14801
## 65 65 13887
## 66 66 12924
## 67 67 17184
## 68 68 14702
## 69 69 13758
## 70 70 16287
## 71 71 14964
## 72 72 22199
## 73 73 27937
## 74 74 28596
## 75 75 19387
## 76 76 15145
## 77 77 14393
## 78 78 13101
## 79 79 16482
## 80 80 14852
## 81 81 16740
## 82 82 21313
## 83 83 20606
## 84 84 24804
## 85 85 35429
## 86 86 36264
## 87 87 23066
## 88 88 23386
## 89 89 17894
## 90 90 17799
## 91 91 22409
## 92 92 16729
## 93 93 17522
## 94 94 21301
## 95 95 24107
## 96 96 32365
## 97 97 45646
## 98 98 37151
## 99 99 29907
## 100 100 30467
## 101 101 24784
## 102 102 22659
## 103 103 33972
## 104 104 26180
## 105 105 23997
## 106 106 30318
## 107 107 26439
## 108 108 32959
## 109 109 43647
## 110 110 45129
## 111 111 33745
## 112 112 29896
## 113 113 22655
## 114 114 21210
## 115 115 32686
## 116 116 27857
## 117 117 23826
## 118 118 31235
## 119 119 30048
## 120 120 37872
## 121 121 50330
## 122 122 47541
## 123 123 31185
## 124 124 31263
## 125 125 32392
## 126 126 29729
## 127 127 36012
## 128 128 33170
## 129 129 30961
## 130 130 38057
## 131 131 37204
## 132 132 39130Eksplorasi Data
Melihat data penumpang maskapai penerbangan China Eastern Airlines
menggunakan fungsi View(), kemudian melihat struktur data
menggunakan fungsi str(), dan dimensi data menggunakan
fungsi dim().
str(data)## 'data.frame': 132 obs. of 2 variables:
## $ Month : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Passengers: int 13224 10789 6434 6433 4002 3540 7214 5294 4570 7315 ...dim(data)## [1] 132 2View(data)Mengubah data agar terbaca sebagai data deret waktu dengan fungsi
ts() . Jumlah data yang digunakan adalah sebanyak 132 data
kemudian dipotong menjadi 130 data.
data.ts <- ts(data$`Passengers`)
data.ts## Time Series:
## Start = 1
## End = 132
## Frequency = 1
## [1] 13224 10789 6434 6433 4002 3540 7214 5294 4570 7315 7210 7801
## [13] 10677 13367 8047 7286 5440 6423 10193 8830 8170 10606 9898 12807
## [25] 18810 14584 8525 7987 7595 8146 14233 11762 10758 13648 11995 12600
## [37] 16191 13642 14349 14261 12606 12565 15547 13013 12823 15167 17486 18651
## [49] 21201 22568 19143 18401 15417 14021 17872 14866 16354 15542 15501 17671
## [61] 28195 23112 15725 14801 13887 12924 17184 14702 13758 16287 14964 22199
## [73] 27937 28596 19387 15145 14393 13101 16482 14852 16740 21313 20606 24804
## [85] 35429 36264 23066 23386 17894 17799 22409 16729 17522 21301 24107 32365
## [97] 45646 37151 29907 30467 24784 22659 33972 26180 23997 30318 26439 32959
## [109] 43647 45129 33745 29896 22655 21210 32686 27857 23826 31235 30048 37872
## [121] 50330 47541 31185 31263 32392 29729 36012 33170 30961 38057 37204 39130Menampilkan ringkasan data :
summary(data.ts)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3540 12899 16962 19937 27877 50330Membuat plot data deret waktu :
ts.plot(data.ts, xlab="Time Period ", ylab="Penumpang China Eastern Airlines",
main = "Time Series Plot")
points(data.ts)
Menyimpan plot
#menyimpan plot
#dev.copy(png, "eksplorasi.png")
#dev.off()Single Moving Average & Double Moving Average
Pembagian Data Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
#membagi data latih dan data uji
train <- data[1:104,]
test <- data[105:130,]
train.ts <- ts(train$Passengers)
test.ts <- ts(test$`Passengers`)Single Moving Average (SMA)
Pemulusan menggunakan metode SMA dilakukan dengan fungsi
SMA(). Dalam hal ini akan dilakukan pemulusan dengan
parameter m=4.
data.sma<-SMA(train.ts, n=1)
data.sma## Time Series:
## Start = 1
## End = 104
## Frequency = 1
## [1] 13224 10789 6434 6433 4002 3540 7214 5294 4570 7315 7210 7801
## [13] 10677 13367 8047 7286 5440 6423 10193 8830 8170 10606 9898 12807
## [25] 18810 14584 8525 7987 7595 8146 14233 11762 10758 13648 11995 12600
## [37] 16191 13642 14349 14261 12606 12565 15547 13013 12823 15167 17486 18651
## [49] 21201 22568 19143 18401 15417 14021 17872 14866 16354 15542 15501 17671
## [61] 28195 23112 15725 14801 13887 12924 17184 14702 13758 16287 14964 22199
## [73] 27937 28596 19387 15145 14393 13101 16482 14852 16740 21313 20606 24804
## [85] 35429 36264 23066 23386 17894 17799 22409 16729 17522 21301 24107 32365
## [97] 45646 37151 29907 30467 24784 22659 33972 26180Data 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 13224 10789 6434 6433 4002 3540 7214 5294 4570 7315 7210
## [13] 7801 10677 13367 8047 7286 5440 6423 10193 8830 8170 10606 9898
## [25] 12807 18810 14584 8525 7987 7595 8146 14233 11762 10758 13648 11995
## [37] 12600 16191 13642 14349 14261 12606 12565 15547 13013 12823 15167 17486
## [49] 18651 21201 22568 19143 18401 15417 14021 17872 14866 16354 15542 15501
## [61] 17671 28195 23112 15725 14801 13887 12924 17184 14702 13758 16287 14964
## [73] 22199 27937 28596 19387 15145 14393 13101 16482 14852 16740 21313 20606
## [85] 24804 35429 36264 23066 23386 17894 17799 22409 16729 17522 21301 24107
## [97] 32365 45646 37151 29907 30467 24784 22659 33972 26180Selanjutnya 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(train.ts,rep(NA,26)),pemulusan=c(data.sma,rep(NA,26)),ramalan=c(data.ramal,rep(data.ramal[length(data.ramal)],25)))
data.gab ## aktual pemulusan ramalan
## [1,] 13224 13224 NA
## [2,] 10789 10789 13224
## [3,] 6434 6434 10789
## [4,] 6433 6433 6434
## [5,] 4002 4002 6433
## [6,] 3540 3540 4002
## [7,] 7214 7214 3540
## [8,] 5294 5294 7214
## [9,] 4570 4570 5294
## [10,] 7315 7315 4570
## [11,] 7210 7210 7315
## [12,] 7801 7801 7210
## [13,] 10677 10677 7801
## [14,] 13367 13367 10677
## [15,] 8047 8047 13367
## [16,] 7286 7286 8047
## [17,] 5440 5440 7286
## [18,] 6423 6423 5440
## [19,] 10193 10193 6423
## [20,] 8830 8830 10193
## [21,] 8170 8170 8830
## [22,] 10606 10606 8170
## [23,] 9898 9898 10606
## [24,] 12807 12807 9898
## [25,] 18810 18810 12807
## [26,] 14584 14584 18810
## [27,] 8525 8525 14584
## [28,] 7987 7987 8525
## [29,] 7595 7595 7987
## [30,] 8146 8146 7595
## [31,] 14233 14233 8146
## [32,] 11762 11762 14233
## [33,] 10758 10758 11762
## [34,] 13648 13648 10758
## [35,] 11995 11995 13648
## [36,] 12600 12600 11995
## [37,] 16191 16191 12600
## [38,] 13642 13642 16191
## [39,] 14349 14349 13642
## [40,] 14261 14261 14349
## [41,] 12606 12606 14261
## [42,] 12565 12565 12606
## [43,] 15547 15547 12565
## [44,] 13013 13013 15547
## [45,] 12823 12823 13013
## [46,] 15167 15167 12823
## [47,] 17486 17486 15167
## [48,] 18651 18651 17486
## [49,] 21201 21201 18651
## [50,] 22568 22568 21201
## [51,] 19143 19143 22568
## [52,] 18401 18401 19143
## [53,] 15417 15417 18401
## [54,] 14021 14021 15417
## [55,] 17872 17872 14021
## [56,] 14866 14866 17872
## [57,] 16354 16354 14866
## [58,] 15542 15542 16354
## [59,] 15501 15501 15542
## [60,] 17671 17671 15501
## [61,] 28195 28195 17671
## [62,] 23112 23112 28195
## [63,] 15725 15725 23112
## [64,] 14801 14801 15725
## [65,] 13887 13887 14801
## [66,] 12924 12924 13887
## [67,] 17184 17184 12924
## [68,] 14702 14702 17184
## [69,] 13758 13758 14702
## [70,] 16287 16287 13758
## [71,] 14964 14964 16287
## [72,] 22199 22199 14964
## [73,] 27937 27937 22199
## [74,] 28596 28596 27937
## [75,] 19387 19387 28596
## [76,] 15145 15145 19387
## [77,] 14393 14393 15145
## [78,] 13101 13101 14393
## [79,] 16482 16482 13101
## [80,] 14852 14852 16482
## [81,] 16740 16740 14852
## [82,] 21313 21313 16740
## [83,] 20606 20606 21313
## [84,] 24804 24804 20606
## [85,] 35429 35429 24804
## [86,] 36264 36264 35429
## [87,] 23066 23066 36264
## [88,] 23386 23386 23066
## [89,] 17894 17894 23386
## [90,] 17799 17799 17894
## [91,] 22409 22409 17799
## [92,] 16729 16729 22409
## [93,] 17522 17522 16729
## [94,] 21301 21301 17522
## [95,] 24107 24107 21301
## [96,] 32365 32365 24107
## [97,] 45646 45646 32365
## [98,] 37151 37151 45646
## [99,] 29907 29907 37151
## [100,] 30467 30467 29907
## [101,] 24784 24784 30467
## [102,] 22659 22659 24784
## [103,] 33972 33972 22659
## [104,] 26180 26180 33972
## [105,] NA NA 26180
## [106,] NA NA 26180
## [107,] NA NA 26180
## [108,] NA NA 26180
## [109,] NA NA 26180
## [110,] NA NA 26180
## [111,] NA NA 26180
## [112,] NA NA 26180
## [113,] NA NA 26180
## [114,] NA NA 26180
## [115,] NA NA 26180
## [116,] NA NA 26180
## [117,] NA NA 26180
## [118,] NA NA 26180
## [119,] NA NA 26180
## [120,] NA NA 26180
## [121,] NA NA 26180
## [122,] NA NA 26180
## [123,] NA NA 26180
## [124,] NA NA 26180
## [125,] NA NA 26180
## [126,] NA NA 26180
## [127,] NA NA 26180
## [128,] NA NA 26180
## [129,] NA NA 26180
## [130,] NA NA 26180Adapun plot data deret waktu dari hasil peramalan yang dilakukan adalah sebagai berikut.
ts.plot(data.ts, xlab="Time Period ", ylab="Penumpang China Eastern Airlines", main= "SMA N=1 Data Passengers")
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)
dma <- SMA(data.sma, n = 1)
At <- 2*data.sma - dma
Bt <- 2/(2-1)*(data.sma - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)
t = 1:26
f = c()
for (i in t) {
f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}
data.gab2 <- cbind(aktual = c(train.ts,rep(NA,26)), pemulusan1 = c(data.sma,rep(NA,26)),pemulusan2 = c(data.dma, rep(NA,26)),At = c(At, rep(NA,26)), Bt = c(Bt,rep(NA,26)),ramalan = c(data.ramal2, f[-1]))
data.gab2## aktual pemulusan1 pemulusan2 At Bt ramalan
## [1,] 13224 13224 13224 13224 0 NA
## [2,] 10789 10789 10789 10789 0 13224
## [3,] 6434 6434 6434 6434 0 10789
## [4,] 6433 6433 6433 6433 0 6434
## [5,] 4002 4002 4002 4002 0 6433
## [6,] 3540 3540 3540 3540 0 4002
## [7,] 7214 7214 7214 7214 0 3540
## [8,] 5294 5294 5294 5294 0 7214
## [9,] 4570 4570 4570 4570 0 5294
## [10,] 7315 7315 7315 7315 0 4570
## [11,] 7210 7210 7210 7210 0 7315
## [12,] 7801 7801 7801 7801 0 7210
## [13,] 10677 10677 10677 10677 0 7801
## [14,] 13367 13367 13367 13367 0 10677
## [15,] 8047 8047 8047 8047 0 13367
## [16,] 7286 7286 7286 7286 0 8047
## [17,] 5440 5440 5440 5440 0 7286
## [18,] 6423 6423 6423 6423 0 5440
## [19,] 10193 10193 10193 10193 0 6423
## [20,] 8830 8830 8830 8830 0 10193
## [21,] 8170 8170 8170 8170 0 8830
## [22,] 10606 10606 10606 10606 0 8170
## [23,] 9898 9898 9898 9898 0 10606
## [24,] 12807 12807 12807 12807 0 9898
## [25,] 18810 18810 18810 18810 0 12807
## [26,] 14584 14584 14584 14584 0 18810
## [27,] 8525 8525 8525 8525 0 14584
## [28,] 7987 7987 7987 7987 0 8525
## [29,] 7595 7595 7595 7595 0 7987
## [30,] 8146 8146 8146 8146 0 7595
## [31,] 14233 14233 14233 14233 0 8146
## [32,] 11762 11762 11762 11762 0 14233
## [33,] 10758 10758 10758 10758 0 11762
## [34,] 13648 13648 13648 13648 0 10758
## [35,] 11995 11995 11995 11995 0 13648
## [36,] 12600 12600 12600 12600 0 11995
## [37,] 16191 16191 16191 16191 0 12600
## [38,] 13642 13642 13642 13642 0 16191
## [39,] 14349 14349 14349 14349 0 13642
## [40,] 14261 14261 14261 14261 0 14349
## [41,] 12606 12606 12606 12606 0 14261
## [42,] 12565 12565 12565 12565 0 12606
## [43,] 15547 15547 15547 15547 0 12565
## [44,] 13013 13013 13013 13013 0 15547
## [45,] 12823 12823 12823 12823 0 13013
## [46,] 15167 15167 15167 15167 0 12823
## [47,] 17486 17486 17486 17486 0 15167
## [48,] 18651 18651 18651 18651 0 17486
## [49,] 21201 21201 21201 21201 0 18651
## [50,] 22568 22568 22568 22568 0 21201
## [51,] 19143 19143 19143 19143 0 22568
## [52,] 18401 18401 18401 18401 0 19143
## [53,] 15417 15417 15417 15417 0 18401
## [54,] 14021 14021 14021 14021 0 15417
## [55,] 17872 17872 17872 17872 0 14021
## [56,] 14866 14866 14866 14866 0 17872
## [57,] 16354 16354 16354 16354 0 14866
## [58,] 15542 15542 15542 15542 0 16354
## [59,] 15501 15501 15501 15501 0 15542
## [60,] 17671 17671 17671 17671 0 15501
## [61,] 28195 28195 28195 28195 0 17671
## [62,] 23112 23112 23112 23112 0 28195
## [63,] 15725 15725 15725 15725 0 23112
## [64,] 14801 14801 14801 14801 0 15725
## [65,] 13887 13887 13887 13887 0 14801
## [66,] 12924 12924 12924 12924 0 13887
## [67,] 17184 17184 17184 17184 0 12924
## [68,] 14702 14702 14702 14702 0 17184
## [69,] 13758 13758 13758 13758 0 14702
## [70,] 16287 16287 16287 16287 0 13758
## [71,] 14964 14964 14964 14964 0 16287
## [72,] 22199 22199 22199 22199 0 14964
## [73,] 27937 27937 27937 27937 0 22199
## [74,] 28596 28596 28596 28596 0 27937
## [75,] 19387 19387 19387 19387 0 28596
## [76,] 15145 15145 15145 15145 0 19387
## [77,] 14393 14393 14393 14393 0 15145
## [78,] 13101 13101 13101 13101 0 14393
## [79,] 16482 16482 16482 16482 0 13101
## [80,] 14852 14852 14852 14852 0 16482
## [81,] 16740 16740 16740 16740 0 14852
## [82,] 21313 21313 21313 21313 0 16740
## [83,] 20606 20606 20606 20606 0 21313
## [84,] 24804 24804 24804 24804 0 20606
## [85,] 35429 35429 35429 35429 0 24804
## [86,] 36264 36264 36264 36264 0 35429
## [87,] 23066 23066 23066 23066 0 36264
## [88,] 23386 23386 23386 23386 0 23066
## [89,] 17894 17894 17894 17894 0 23386
## [90,] 17799 17799 17799 17799 0 17894
## [91,] 22409 22409 22409 22409 0 17799
## [92,] 16729 16729 16729 16729 0 22409
## [93,] 17522 17522 17522 17522 0 16729
## [94,] 21301 21301 21301 21301 0 17522
## [95,] 24107 24107 24107 24107 0 21301
## [96,] 32365 32365 32365 32365 0 24107
## [97,] 45646 45646 45646 45646 0 32365
## [98,] 37151 37151 37151 37151 0 45646
## [99,] 29907 29907 29907 29907 0 37151
## [100,] 30467 30467 30467 30467 0 29907
## [101,] 24784 24784 24784 24784 0 30467
## [102,] 22659 22659 22659 22659 0 24784
## [103,] 33972 33972 33972 33972 0 22659
## [104,] 26180 26180 26180 26180 0 33972
## [105,] NA NA NA NA NA 26180
## [106,] NA NA NA NA NA 26180
## [107,] NA NA NA NA NA 26180
## [108,] NA NA NA NA NA 26180
## [109,] NA NA NA NA NA 26180
## [110,] NA NA NA NA NA 26180
## [111,] NA NA NA NA NA 26180
## [112,] NA NA NA NA NA 26180
## [113,] NA NA NA NA NA 26180
## [114,] NA NA NA NA NA 26180
## [115,] NA NA NA NA NA 26180
## [116,] NA NA NA NA NA 26180
## [117,] NA NA NA NA NA 26180
## [118,] NA NA NA NA NA 26180
## [119,] NA NA NA NA NA 26180
## [120,] NA NA NA NA NA 26180
## [121,] NA NA NA NA NA 26180
## [122,] NA NA NA NA NA 26180
## [123,] NA NA NA NA NA 26180
## [124,] NA NA NA NA NA 26180
## [125,] NA NA NA NA NA 26180
## [126,] NA NA NA NA NA 26180
## [127,] NA NA NA NA NA 26180
## [128,] NA NA NA NA NA 26180
## [129,] NA NA NA NA NA 26180
## [130,] NA NA NA NA NA 26180Hasil pemulusan menggunakan metode DMA divisualisasikan sebagai berikut
ts.plot(data.ts, xlab="Time Period ", ylab="Penumpang China Eastern Airlines", main= "DMA N=1 Data Passengers")
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.
#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.816357e+09
## MSE 1.872533e+07
## MAPE 1.815255e+01Perhitungan akurasi pada data latih menggunakan nilai MAPE menghasilkan nilai MAPE sebesar 6% sehingga dikategorikan sangat baik. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.
#Menghitung nilai keakuratan data uji
error_test.dma = test.ts-data.gab2[105:130,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 2.519170e+09
## MSE 9.689116e+07
## MAPE 2.104762e+01Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE sebesar 7% sehingga nilai akurasi ini dapat dikategorikan sebagai sangat baik.
Double Exponential Smoothing
Pembagian Data Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.Data yang dimiliki sebanyak 130 kemudian dibagi 80% sebagai data uji dan 20% sebagai data latih. Didapatkan data uji sebanyak 104 dan data latih sebanyak 26.
#membagi training dan testing
train<-data[1:104,]
test<-data[105:130,]
train.ts <- ts(train$Passengers)
test.ts <- ts(test$Passengers)DES
#Lamda=0.2 dan gamma=0.2
des.1<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.99)
plot(des.1)
#ramalan
ramalandes1<- forecast(des.1, h=26)
ramalandes1## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 105 26256.79 20784.3316 31729.25 17887.3866 34626.20
## 106 26256.79 18556.1636 33957.42 14479.6978 38033.88
## 107 26256.79 16841.2978 35672.28 11857.0368 40656.54
## 108 26256.79 15393.8557 37119.73 9643.3652 42870.22
## 109 26256.79 14117.7955 38395.79 7691.7995 44821.78
## 110 26256.79 12963.6701 39549.91 5926.7171 46586.86
## 111 26256.79 11902.0388 40611.54 4303.0920 48210.49
## 112 26256.79 10913.6896 41599.89 2791.5423 49722.04
## 113 26256.79 9985.2634 42528.32 1371.6370 51141.94
## 114 26256.79 9107.0254 43406.56 28.4879 52485.09
## 115 26256.79 8271.6218 44241.96 -1249.1516 53762.73
## 116 26256.79 7473.3366 45040.25 -2470.0235 54983.61
## 117 26256.79 6707.6219 45805.96 -3641.0830 56154.66
## 118 26256.79 5970.7894 46542.79 -4767.9711 57281.55
## 119 26256.79 5259.7981 47253.78 -5855.3384 58368.92
## 120 26256.79 4572.1061 47941.48 -6907.0726 59420.65
## 121 26256.79 3905.5626 48608.02 -7926.4629 60440.04
## 122 26256.79 3258.3289 49255.25 -8916.3215 61429.90
## 123 26256.79 2628.8180 49884.76 -9879.0753 62392.66
## 124 26256.79 2015.6491 50497.93 -10816.8361 63330.42
## 125 26256.79 1417.6121 51095.97 -11731.4549 64245.04
## 126 26256.79 833.6390 51679.94 -12624.5647 65138.15
## 127 26256.79 262.7819 52250.80 -13497.6152 66011.20
## 128 26256.79 -295.8051 52809.39 -14351.9003 66865.48
## 129 26256.79 -842.8807 53356.46 -15188.5803 67702.16
## 130 26256.79 -1379.1287 53892.71 -16008.7008 68522.28#Lamda=0.6 dan gamma=0.3
des.2<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.9)
plot(des.2)
ramalandes2<- forecast(des.2, h=26)
ramalandes2## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 105 26848.77 21353.882 32343.65 18445.0659 35252.47
## 106 26848.77 19456.155 34241.38 15542.7439 38154.79
## 107 26848.77 17954.519 35743.01 13246.1893 40451.34
## 108 26848.77 16672.098 37025.43 11284.8959 42412.64
## 109 26848.77 15534.107 38163.42 9544.4887 44153.04
## 110 26848.77 14500.550 39196.98 7963.7992 45733.73
## 111 26848.77 13547.060 40150.47 6505.5625 47191.97
## 112 26848.77 12657.490 41040.04 5145.0823 48552.45
## 113 26848.77 11820.484 41877.05 3864.9925 49832.54
## 114 26848.77 11027.698 42669.83 2652.5307 51045.00
## 115 26848.77 10272.785 43424.75 1497.9916 52199.54
## 116 26848.77 9550.787 44146.74 393.7907 53303.74
## 117 26848.77 8857.740 44839.79 -666.1332 54363.66
## 118 26848.77 8190.418 45507.11 -1686.7143 55384.25
## 119 26848.77 7546.153 46151.38 -2672.0333 56369.56
## 120 26848.77 6922.707 46774.82 -3625.5109 57323.04
## 121 26848.77 6318.185 47379.35 -4550.0478 58247.58
## 122 26848.77 5730.961 47966.57 -5448.1296 59145.66
## 123 26848.77 5159.630 48537.90 -6321.9052 60019.44
## 124 26848.77 4602.967 49094.56 -7173.2472 60870.78
## 125 26848.77 4059.898 49637.63 -8003.7998 61701.33
## 126 26848.77 3529.473 50168.06 -8815.0154 62512.55
## 127 26848.77 3010.847 50686.68 -9608.1848 63305.72
## 128 26848.77 2503.267 51194.26 -10384.4613 64081.99
## 129 26848.77 2006.056 51691.48 -11144.8805 64842.41
## 130 26848.77 1518.602 52178.93 -11890.3761 65587.91#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: 1
## beta : 0.0444185
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 26180.0000
## b 113.6111plot(des.opt)
#ramalan
ramalandesopt<- forecast(des.opt, h=26)
ramalandesopt## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 105 26293.61 20637.4588 31949.76 17643.2726 34943.95
## 106 26407.22 18228.6332 34585.81 13899.1498 38915.29
## 107 26520.83 16282.7663 36758.90 10863.0610 42178.61
## 108 26634.44 14555.3552 38713.53 8161.0717 45107.82
## 109 26748.06 12954.0461 40542.06 5651.9386 47844.17
## 110 26861.67 11432.6304 42290.70 3264.9920 50458.34
## 111 26975.28 9964.3393 43986.22 959.2925 52991.26
## 112 27088.89 8532.1775 45645.60 -1291.1521 55468.93
## 113 27202.50 7124.6531 47280.35 -3503.9169 57908.92
## 114 27316.11 5733.6308 48898.59 -5691.4441 60323.67
## 115 27429.72 4353.1465 50506.30 -7862.8546 62722.30
## 116 27543.33 2978.7075 52107.96 -10025.0198 65111.69
## 117 27656.94 1606.8544 53707.03 -12183.2301 67497.12
## 118 27770.56 234.8764 55306.23 -14341.6314 69882.74
## 119 27884.17 -1139.3822 56907.71 -16503.5207 72271.85
## 120 27997.78 -2517.6565 58513.21 -18671.5514 74667.11
## 121 28111.39 -3901.3566 60124.13 -20847.8802 77070.66
## 122 28225.00 -5291.6388 61741.64 -23034.2754 79484.27
## 123 28338.61 -6689.4572 63366.68 -25232.1963 81909.42
## 124 28452.22 -8095.6040 65000.05 -27442.8543 84347.30
## 125 28565.83 -9510.7396 66642.41 -29667.2595 86798.93
## 126 28679.44 -10935.4168 68294.30 -31906.2573 89265.15
## 127 28793.06 -12370.0992 69956.21 -34160.5567 91746.67
## 128 28906.67 -13815.1765 71628.51 -36430.7539 94244.09
## 129 29020.28 -15270.9764 73311.53 -38717.3498 96757.90
## 130 29133.89 -16737.7744 75005.55 -41020.7658 99288.54Selanjutnya akan dilakukan perhitungan akurasi pada data latih maupun data uji dengan ukuran akurasi SSE, MSE dan MAPE.
Akurasi Data Latih
#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 -2435.0000 -4379.3500 -44.7935 -2431.4479 -486.3145mapedes.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.861597e+09
## MSE 1.789998e+07
## MAPE 1.879487e+01ssedes.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 -2435.0000 -4598.5000 -460.8500 -2477.0850 -709.7085mapedes.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 1.877414e+09
## MSE 1.805206e+07
## MAPE 1.906926e+01Akurasi Data Uji
#Akurasi Data Testing
selisihdes1<-ramalandes1$mean-test$Passengers
selisihdes1## Time Series:
## Start = 105
## End = 130
## Frequency = 1
## [1] 2259.7909 -4061.2091 -182.2091 -6702.2091 -17390.2091 -18872.2091
## [7] -7488.2091 -3639.2091 3601.7909 5046.7909 -6429.2091 -1600.2091
## [13] 2430.7909 -4978.2091 -3791.2091 -11615.2091 -24073.2091 -21284.2091
## [19] -4928.2091 -5006.2091 -6135.2091 -3472.2091 -9755.2091 -6913.2091
## [25] -4704.2091 -11800.2091SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(test$Passengers)
MAPEtestingdes1<-sum(abs(selisihdes1/test$Passengers)*100)/length(test$Passengers)
selisihdes2<-ramalandes2$mean-test$Passengers
selisihdes2## Time Series:
## Start = 105
## End = 130
## Frequency = 1
## [1] 2851.7657 -3469.2343 409.7657 -6110.2343 -16798.2343 -18280.2343
## [7] -6896.2343 -3047.2343 4193.7657 5638.7657 -5837.2343 -1008.2343
## [13] 3022.7657 -4386.2343 -3199.2343 -11023.2343 -23481.2343 -20692.2343
## [19] -4336.2343 -4414.2343 -5543.2343 -2880.2343 -9163.2343 -6321.2343
## [25] -4112.2343 -11208.2343SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(test$Passengers)
MAPEtestingdes2<-sum(abs(selisihdes2/test$Passengers)*100)/length(test$Passengers)
selisihdesopt<-ramalandesopt$mean-test$Passengers
selisihdesopt## Time Series:
## Start = 105
## End = 130
## Frequency = 1
## [1] 2296.61109 -3910.77782 81.83327 -6324.55564 -16898.94456
## [6] -18267.33347 -6769.72238 -2807.11129 4547.49980 6106.11089
## [11] -5256.27802 -313.66693 3830.94415 -3464.44476 -2163.83367
## [16] -9874.22258 -22218.61149 -19316.00040 -2846.38931 -2810.77822
## [21] -3826.16714 -1049.55605 -7218.94496 -4263.33387 -1940.72278
## [26] -8923.11169SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(test$Passengers)
MAPEtestingdesopt<-sum(abs(selisihdesopt/test$Passengers)*100)/length(test$Passengers)
akurasitestingdes <-
matrix(c(SSEtestingdes1,MSEtestingdes1,MAPEtestingdes1,SSEtestingdes2,MSEtestingdes2,
MAPEtestingdes2,SSEtestingdesopt,MSEtestingdesopt,MAPEtestingdesopt),
nrow=3,ncol=3)
row.names(akurasitestingdes)<- c("SSE", "MSE", "MAPE")
colnames(akurasitestingdes) <- c("des ske1","des ske2","des opt")
akurasitestingdes## des ske1 des ske2 des opt
## SSE 2.492680e+09 2.298765e+09 2.000302e+09
## MSE 9.587231e+07 8.841403e+07 7.693469e+07
## MAPE 2.090629e+01 1.993601e+01 1.761455e+01Perbandingan Nilai Akurasi Semua Metode
akurasi <- matrix(c(SSE_train.dma, MSE_train.dma, MAPE_train.dma, mapedes.train2 , ssedes.train2, msedes.train2 ), nrow=3)
row.names(akurasi)<- c("SSE", "MSE", "MAPE")
colnames(akurasi) <- c("DMA", "DES")Berdasarkan data testing, DES merupakan model terbaik dilihat dari perbandingan ukuran kebaikan model di atas. MAPE dari DES adalah 5,9% sedangkan MAPE dari DMA adalah 6%.
Eksplorasi Data
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(train.ts, col="blue",main="Plot data latih")
points(train.ts)
#eksplorasi data uji
plot(test.ts, col="green",main="Plot data uji")
points(test.ts)
Eksplorasi data juga dapat dilakukan menggunakan package
ggplot2 dengan terlebih dahulu memanggil library
package ggplot2.
#Eksplorasi dengan GGPLOT
library(ggplot2)
ggplot() +
geom_line(data = train, aes(x = Month, y = Passengers, col = "Data Latih")) +
geom_line(data = test, aes(x = Month, y = Passengers, col = "Data Uji")) +
labs(x = "Periode Waktu", y = "Passengers", 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))