Tugas Praktikum 1 - MPDW
Sandra Berliana Putri
2024-08-25
library(forecast)## Warning: package 'forecast' was built under R version 4.3.3## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(graphics)
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.3.3library(TTR)## Warning: package 'TTR' was built under R version 4.3.2library(TSA)## Warning: package 'TSA' was built under R version 4.3.3## Registered S3 methods overwritten by 'TSA':
## method from
## fitted.Arima forecast
## plot.Arima forecast##
## Attaching package: 'TSA'## The following objects are masked from 'package:stats':
##
## acf, arima## The following object is masked from 'package:utils':
##
## tarlibrary(dplyr)## Warning: package 'dplyr' was built under R version 4.3.2##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(stats)Impor Data
data_penumpangtj <- read.csv ("D:/Sem 5/MPDW/Tugas/Individu/1/Data Penumpang Transjakarta 2023 - 2024 Periode 437 - 547.csv")Eksplorasi Data
View(data_penumpangtj)
str(data_penumpangtj)## 'data.frame': 111 obs. of 2 variables:
## $ Periode : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Penumpang: int 714500 1100220 1148676 1141872 656466 550347 1193240 1186975 1186823 1189852 ...dim(data_penumpangtj)## [1] 111 2Mengubah Data Menjadi Data Time Series
data_penumpangtj.ts <- ts(data_penumpangtj$Penumpang)summary(data_penumpangtj.ts)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 334789 732645 1134568 988720 1211174 1276021Plot Data Time Series
plot.ts(data_penumpangtj.ts, xlab="Periode", ylab="Jumlah Penumpang TJ", main ="Plot Data Time Series")
points(data_penumpangtj.ts)
Single Moving Average & Double Moving Average
Pembagian data untuk data stasioner atau konstan yang akan digunakan sebagai latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji. Tapi jika tidak stasioner atau data trend maka pembagian data sesuai pola, jangan saat baru turun atau naik dibagi alias ditengah-tengah.Apabila dibagi di tengah maka data terbaca seolah-olah selalu turun atau naik padahal ada titik balik dimana data tersebut dari turun ke naik atau sebaliknya.
Pembagian Data dan Merubah Data Menjadi Data Time Series
training_ma <- data_penumpangtj[1:96,]
testing_ma <- data_penumpangtj[97:111,]
training_ma.ts <- ts(training_ma$Penumpang)
testing_ma.ts <- ts(testing_ma$Penumpang)Eksplorasi Data
plot(data_penumpangtj.ts, col="red", main="Plot Semua Data", ylab="Data Jumlah Penumpang Transjakarta" )
points(data_penumpangtj.ts)
plot(training_ma.ts, col="blue", main="Plot Data Latih", ylab="Data Latih")
points(training_ma.ts)
plot(testing_ma.ts, col="blue", main="Plot Data Uji", ylab="Data Uji")
points(testing_ma.ts)
library(ggplot2)
ggplot() +
geom_line(data = training_ma, aes(x = Periode, y = Penumpang, col = "Data Latih")) +
geom_line(data = testing_ma, aes(x = Periode, y = Penumpang, col = "Data Uji")) +
labs(x = "Periode Waktu", y = "Jumlah Penumpang", color = "Legend") +
scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
values = c("blue", "red")) +
theme_bw() + theme(legend.position = "bottom",
plot.caption = element_text(hjust=0.5, size=12))
ggplot() +
geom_line(data = data_penumpangtj, aes(x = Periode, y = Penumpang, col = "Data Latih")) +
geom_line(data = testing_ma, aes(x = Periode, y = Penumpang, col = "Data Uji")) +
labs(x = "Periode Waktu", y = "Jumlah Penumpang", color = "Legend") +
scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
values = c("blue", "red")) +
theme_bw() + theme(legend.position = "bottom",
plot.caption = element_text(hjust=0.5, size=12))
Single Moving Average
Pemulusan menggunakan metode SMA dilakukan dengan fungsi
SMA(). Dalam hal ini akan dilakukan pemulusan dengan
parameter m=4.
data_penumpangtj.sma <- SMA(training_ma.ts, n=4) #karena n=4 maka ada n-1=4-1=3 data yg kosong
data_penumpangtj.sma## Time Series:
## Start = 1
## End = 96
## Frequency = 1
## [1] NA NA NA 1026317.0 1011808.5 874340.2 885481.2
## [8] 896757.0 1029346.2 1189222.5 1158597.2 1046399.0 900289.5 900245.8
## [15] 929444.2 1041933.2 1182372.8 1050528.8 931992.5 790226.8 780721.2
## [22] 904931.0 1012727.5 1131766.5 1111848.8 996286.5 860827.2 739380.5
## [29] 601671.5 511146.0 480781.8 461897.2 499740.5 571593.8 633124.5
## [36] 753205.0 865192.5 991346.0 1093137.2 1031370.8 924661.5 937761.8
## [43] 951603.5 1059940.5 1190508.0 1189026.2 1087388.5 958613.5 953685.5
## [50] 956855.5 932380.8 1054853.0 1051082.5 955018.2 958909.2 963910.0
## [57] 980985.5 1090469.2 1097175.0 1011828.2 904155.8 777858.0 903682.5
## [64] 999413.0 1111450.0 1235186.0 1232862.5 1135313.0 1007562.8 1009873.2
## [71] 1017718.2 1118419.0 1111794.0 1016201.8 891723.2 760516.5 892220.0
## [78] 988659.0 1111404.2 1244362.8 1242823.2 1136614.0 1007741.2 1002277.5
## [85] 1012818.2 1127525.2 1260300.5 1264041.5 1165667.0 1037480.8 1033720.5
## [92] 1032316.0 1127085.0 1247301.0 1238197.0 1124756.0Data 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_penumpangtj.ramal <- c(NA,data_penumpangtj.sma)
data_penumpangtj.ramal #forecast 1 periode ke depan## [1] NA NA NA NA 1026317.0 1011808.5 874340.2
## [8] 885481.2 896757.0 1029346.2 1189222.5 1158597.2 1046399.0 900289.5
## [15] 900245.8 929444.2 1041933.2 1182372.8 1050528.8 931992.5 790226.8
## [22] 780721.2 904931.0 1012727.5 1131766.5 1111848.8 996286.5 860827.2
## [29] 739380.5 601671.5 511146.0 480781.8 461897.2 499740.5 571593.8
## [36] 633124.5 753205.0 865192.5 991346.0 1093137.2 1031370.8 924661.5
## [43] 937761.8 951603.5 1059940.5 1190508.0 1189026.2 1087388.5 958613.5
## [50] 953685.5 956855.5 932380.8 1054853.0 1051082.5 955018.2 958909.2
## [57] 963910.0 980985.5 1090469.2 1097175.0 1011828.2 904155.8 777858.0
## [64] 903682.5 999413.0 1111450.0 1235186.0 1232862.5 1135313.0 1007562.8
## [71] 1009873.2 1017718.2 1118419.0 1111794.0 1016201.8 891723.2 760516.5
## [78] 892220.0 988659.0 1111404.2 1244362.8 1242823.2 1136614.0 1007741.2
## [85] 1002277.5 1012818.2 1127525.2 1260300.5 1264041.5 1165667.0 1037480.8
## [92] 1033720.5 1032316.0 1127085.0 1247301.0 1238197.0 1124756.0Selanjutnya akan dilakukan peramalan sejumlah data uji yaitu 31 periode (1 bulan kedepan). Pada metode SMA, hasil peramalan 31 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 31 periode kedepan.
data_penumpangtj.gab <- cbind(aktual=c(training_ma.ts,rep(NA,31)),pemulusan=c(data_penumpangtj.sma,rep(NA,31)),ramalan=c(data_penumpangtj.ramal,rep(data_penumpangtj.ramal[length(data_penumpangtj.ramal)],30)))
data_penumpangtj.gab #forecast(meramal) 31 periode ke depan## aktual pemulusan ramalan
## [1,] 714500 NA NA
## [2,] 1100220 NA NA
## [3,] 1148676 NA NA
## [4,] 1141872 1026317.0 NA
## [5,] 656466 1011808.5 1026317.0
## [6,] 550347 874340.2 1011808.5
## [7,] 1193240 885481.2 874340.2
## [8,] 1186975 896757.0 885481.2
## [9,] 1186823 1029346.2 896757.0
## [10,] 1189852 1189222.5 1029346.2
## [11,] 1070739 1158597.2 1189222.5
## [12,] 738182 1046399.0 1158597.2
## [13,] 602385 900289.5 1046399.0
## [14,] 1189677 900245.8 900289.5
## [15,] 1187533 929444.2 900245.8
## [16,] 1188138 1041933.2 929444.2
## [17,] 1164143 1182372.8 1041933.2
## [18,] 662301 1050528.8 1182372.8
## [19,] 713388 931992.5 1050528.8
## [20,] 621075 790226.8 931992.5
## [21,] 1126121 780721.2 790226.8
## [22,] 1159140 904931.0 780721.2
## [23,] 1144574 1012727.5 904931.0
## [24,] 1097231 1131766.5 1012727.5
## [25,] 1046450 1111848.8 1131766.5
## [26,] 696891 996286.5 1111848.8
## [27,] 602737 860827.2 996286.5
## [28,] 611444 739380.5 860827.2
## [29,] 495614 601671.5 739380.5
## [30,] 334789 511146.0 601671.5
## [31,] 481280 480781.8 511146.0
## [32,] 535906 461897.2 480781.8
## [33,] 646987 499740.5 461897.2
## [34,] 622202 571593.8 499740.5
## [35,] 727403 633124.5 571593.8
## [36,] 1016228 753205.0 633124.5
## [37,] 1094937 865192.5 753205.0
## [38,] 1126816 991346.0 865192.5
## [39,] 1134568 1093137.2 991346.0
## [40,] 769162 1031370.8 1093137.2
## [41,] 668100 924661.5 1031370.8
## [42,] 1179217 937761.8 924661.5
## [43,] 1189935 951603.5 937761.8
## [44,] 1202510 1059940.5 951603.5
## [45,] 1190370 1190508.0 1059940.5
## [46,] 1173290 1189026.2 1190508.0
## [47,] 783384 1087388.5 1189026.2
## [48,] 687410 958613.5 1087388.5
## [49,] 1170658 953685.5 958613.5
## [50,] 1185970 956855.5 953685.5
## [51,] 685485 932380.8 956855.5
## [52,] 1177299 1054853.0 932380.8
## [53,] 1155576 1051082.5 1054853.0
## [54,] 801713 955018.2 1051082.5
## [55,] 701049 958909.2 955018.2
## [56,] 1197302 963910.0 958909.2
## [57,] 1223878 980985.5 963910.0
## [58,] 1239648 1090469.2 980985.5
## [59,] 727872 1097175.0 1090469.2
## [60,] 855915 1011828.2 1097175.0
## [61,] 793188 904155.8 1011828.2
## [62,] 734457 777858.0 904155.8
## [63,] 1231170 903682.5 777858.0
## [64,] 1238837 999413.0 903682.5
## [65,] 1241336 1111450.0 999413.0
## [66,] 1229401 1235186.0 1111450.0
## [67,] 1221876 1232862.5 1235186.0
## [68,] 848639 1135313.0 1232862.5
## [69,] 730335 1007562.8 1135313.0
## [70,] 1238643 1009873.2 1007562.8
## [71,] 1253256 1017718.2 1009873.2
## [72,] 1251442 1118419.0 1017718.2
## [73,] 703835 1111794.0 1118419.0
## [74,] 856274 1016201.8 1111794.0
## [75,] 755342 891723.2 1016201.8
## [76,] 726615 760516.5 891723.2
## [77,] 1230649 892220.0 760516.5
## [78,] 1242030 988659.0 892220.0
## [79,] 1246323 1111404.2 988659.0
## [80,] 1258449 1244362.8 1111404.2
## [81,] 1224491 1242823.2 1244362.8
## [82,] 817193 1136614.0 1242823.2
## [83,] 730832 1007741.2 1136614.0
## [84,] 1236594 1002277.5 1007741.2
## [85,] 1266654 1012818.2 1002277.5
## [86,] 1276021 1127525.2 1012818.2
## [87,] 1261933 1260300.5 1127525.2
## [88,] 1251558 1264041.5 1260300.5
## [89,] 873156 1165667.0 1264041.5
## [90,] 763276 1037480.8 1165667.0
## [91,] 1246892 1033720.5 1037480.8
## [92,] 1245940 1032316.0 1033720.5
## [93,] 1252232 1127085.0 1032316.0
## [94,] 1244140 1247301.0 1127085.0
## [95,] 1210476 1238197.0 1247301.0
## [96,] 792176 1124756.0 1238197.0
## [97,] NA NA 1124756.0
## [98,] NA NA 1124756.0
## [99,] NA NA 1124756.0
## [100,] NA NA 1124756.0
## [101,] NA NA 1124756.0
## [102,] NA NA 1124756.0
## [103,] NA NA 1124756.0
## [104,] NA NA 1124756.0
## [105,] NA NA 1124756.0
## [106,] NA NA 1124756.0
## [107,] NA NA 1124756.0
## [108,] NA NA 1124756.0
## [109,] NA NA 1124756.0
## [110,] NA NA 1124756.0
## [111,] NA NA 1124756.0
## [112,] NA NA 1124756.0
## [113,] NA NA 1124756.0
## [114,] NA NA 1124756.0
## [115,] NA NA 1124756.0
## [116,] NA NA 1124756.0
## [117,] NA NA 1124756.0
## [118,] NA NA 1124756.0
## [119,] NA NA 1124756.0
## [120,] NA NA 1124756.0
## [121,] NA NA 1124756.0
## [122,] NA NA 1124756.0
## [123,] NA NA 1124756.0
## [124,] NA NA 1124756.0
## [125,] NA NA 1124756.0
## [126,] NA NA 1124756.0
## [127,] NA NA 1124756.0Adapun plot data deret waktu dari hasil peramalan yang dilakukan adalah sebagai berikut.
ts.plot(data_penumpangtj.ts, xlab="Periode", ylab="Jumlah Penumpang", main= "SMA N=4 Data Jumlah Penumpang Transjakarta")
points(data_penumpangtj.ts)
lines(data_penumpangtj.gab[,2],col="green",lwd=2)
lines(data_penumpangtj.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_training.sma = training_ma.ts-data_penumpangtj.ramal[1:length(training_ma.ts)]
SSE_training.sma = sum(error_training.sma[5:length(training_ma.ts)]^2)
MSE_training.sma = mean(error_training.sma[5:length(training_ma.ts)]^2)
MAPE_training.sma = mean(abs((error_training.sma[5:length(training_ma.ts)]/training_ma.ts[5:length(training_ma.ts)])*100))
akurasi_training.sma <- matrix(c(SSE_training.sma, MSE_training.sma, MAPE_training.sma))
row.names(akurasi_training.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_training.sma) <- c("Akurasi Data Latih SMA m = 4")
akurasi_training.sma## Akurasi Data Latih SMA m = 4
## SSE 7.499029e+12
## MSE 8.151119e+10
## MAPE 2.994756e+01Dalam hal ini nilai MAPE data latih pada metode pemulusan SMA berkisar 20% - 50%, nilai ini dapat dikategorikan sebagai nilai akurasi yang layak.
#Menghitung nilai keakuratan data uji
error_testing.sma = testing_ma.ts-data_penumpangtj.gab[97:111,3]
SSE_testing.sma = sum(error_testing.sma^2)
MSE_testing.sma = mean(error_testing.sma^2)
MAPE_testing.sma = mean(abs((error_testing.sma/testing_ma.ts*100)))
akurasi_testing.sma <- matrix(c(SSE_testing.sma, MSE_testing.sma, MAPE_testing.sma))
row.names(akurasi_testing.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_testing.sma) <- c("Akurasi Data Uji SMA m = 4")
akurasi_testing.sma## Akurasi Data Uji SMA m = 4
## SSE 1.096647e+12
## MSE 7.310983e+10
## MAPE 2.886329e+01nilai MAPE data uji pada metode pemulusan SMA sekitar 20% - 50%, nilai ini dapat dikategorikan sebagai nilai akurasi yang layak.
akurasi_training.sma## Akurasi Data Latih SMA m = 4
## SSE 7.499029e+12
## MSE 8.151119e+10
## MAPE 2.994756e+01akurasi_testing.sma## Akurasi Data Uji SMA m = 4
## SSE 1.096647e+12
## MSE 7.310983e+10
## MAPE 2.886329e+01Double Moving Average (DMA)
dma <- SMA(data_penumpangtj.sma, n = 4)
At <- 2*data_penumpangtj.sma - dma
Bt <- 2/(4-1)*(data_penumpangtj.sma - dma)
data_penumpangtj.dma<- At+Bt
data_penumpangtj.ramal2<- c(NA, data_penumpangtj.dma)
t = 1:31
f = c()
for (i in t) {
f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}
data_penumpangtj.gab2 <- cbind(aktual = c(training_ma.ts,rep(NA,31)), pemulusan1 = c(data_penumpangtj.sma,rep(NA,31)),pemulusan2 = c(data_penumpangtj.dma, rep(NA,31)),At = c(At, rep(NA,31)), Bt = c(Bt,rep(NA,31)),ramalan = c(data_penumpangtj.ramal2, f[-1]))
data_penumpangtj.gab2## aktual pemulusan1 pemulusan2 At Bt ramalan
## [1,] 714500 NA NA NA NA NA
## [2,] 1100220 NA NA NA NA NA
## [3,] 1148676 NA NA NA NA NA
## [4,] 1141872 1026317.0 NA NA NA NA
## [5,] 656466 1011808.5 NA NA NA NA
## [6,] 550347 874340.2 NA NA NA NA
## [7,] 1193240 885481.2 778805.4 821475.8 -42670.3333 NA
## [8,] 1186975 896757.0 862857.4 876417.2 -13559.8333 778805.42
## [9,] 1186823 1029346.2 1209121.4 1137211.3 71910.0417 862857.42
## [10,] 1189852 1189222.5 1504257.1 1378243.2 126013.8333 1209121.35
## [11,] 1070739 1158597.2 1308791.4 1248713.8 60077.6667 1504257.08
## [12,] 738182 1046399.0 947245.2 986906.8 -39661.5000 1308791.42
## [13,] 602385 900289.5 611393.6 726951.9 -115558.3750 947245.25
## [14,] 1189677 900245.8 731683.9 799108.6 -67424.7500 611393.56
## [15,] 1187533 929444.2 905027.0 914793.9 -9766.9167 731683.88
## [16,] 1188138 1041933.2 1206858.4 1140888.3 65970.0417 905026.96
## [17,] 1164143 1182372.8 1463829.0 1351246.5 112582.5000 1206858.35
## [18,] 662301 1050528.8 1049627.1 1049987.8 -360.6667 1463829.00
## [19,] 713388 931992.5 732468.6 812278.2 -79809.5417 1049627.08
## [20,] 621075 790226.8 459304.4 591673.3 -132368.9583 732468.65
## [21,] 1126121 780721.2 601311.1 673075.2 -71764.0417 459304.35
## [22,] 1159140 904931.0 993202.9 957894.1 35308.7500 601311.15
## [23,] 1144574 1012727.5 1247020.6 1153303.4 93717.2500 993202.88
## [24,] 1097231 1131766.5 1422149.7 1305996.4 116153.2917 1247020.62
## [25,] 1046450 1111848.8 1231065.9 1183379.1 47686.8750 1422149.73
## [26,] 696891 996286.5 884835.1 929415.7 -44580.5417 1231065.94
## [27,] 602737 860827.2 586902.2 696472.2 -109570.0000 884835.15
## [28,] 611444 739380.5 426538.4 551675.2 -125136.8333 586902.25
## [29,] 495614 601671.5 271888.3 403801.6 -131913.2917 426538.42
## [30,] 334789 511146.0 232628.8 344035.7 -111406.8750 271888.27
## [31,] 481280 480781.8 310009.8 378318.6 -68308.7917 232628.81
## [32,] 535906 461897.2 375269.1 409920.4 -34651.2500 310009.77
## [33,] 646987 499740.5 518655.7 511089.6 7566.0833 375269.12
## [34,] 622202 571593.8 685077.8 639684.2 45393.6250 518655.71
## [35,] 727403 633124.5 785683.7 724660.0 61023.6667 685077.81
## [36,] 1016228 753205.0 984520.1 891994.1 92526.0417 785683.67
## [37,] 1094937 865192.5 1130881.8 1024606.1 106275.7083 984520.10
## [38,] 1126816 991346.0 1292394.3 1171975.0 120419.3333 1130881.77
## [39,] 1134568 1093137.2 1372165.7 1260554.3 111611.3750 1292394.33
## [40,] 769162 1031370.8 1091552.6 1067479.9 24072.7500 1372165.69
## [41,] 668100 924661.5 782215.9 839194.1 -56978.2500 1091552.62
## [42,] 1179217 937761.8 839476.6 878790.7 -39314.0417 782215.88
## [43,] 1189935 951603.5 935360.4 941857.6 -6497.2500 839476.65
## [44,] 1202510 1059940.5 1212355.0 1151389.2 60965.7917 935360.38
## [45,] 1190370 1190508.0 1449765.6 1346062.6 103703.0417 1212354.98
## [46,] 1173290 1189026.2 1341120.7 1280282.9 60837.7917 1449765.60
## [47,] 783384 1087388.5 1013509.6 1043061.2 -29551.5417 1341120.73
## [48,] 687410 958613.5 712329.2 810842.9 -98513.7083 1013509.65
## [49,] 1170658 953685.5 797863.9 860192.6 -62328.6250 712329.23
## [50,] 1185970 956855.5 903055.1 924575.2 -21520.1667 797863.94
## [51,] 685485 932380.8 902375.6 914377.7 -12002.0417 903055.08
## [52,] 1177299 1054853.0 1188868.5 1135262.3 53606.2083 902375.65
## [53,] 1155576 1051082.5 1138231.8 1103372.1 34859.7083 1188868.52
## [54,] 801713 955018.2 882826.0 911702.9 -28876.9167 1138231.77
## [55,] 701049 958909.2 882148.4 912852.8 -30704.3333 882825.96
## [56,] 1197302 963910.0 933376.7 945590.0 -12213.3333 882148.42
## [57,] 1223878 980985.5 1008118.4 997265.2 10853.1667 933376.67
## [58,] 1239648 1090469.2 1243637.2 1182370.0 61267.1667 1008118.42
## [59,] 727872 1097175.0 1203908.4 1161215.1 42693.3750 1243637.17
## [60,] 855915 1011828.2 956351.2 978542.0 -22190.8333 1203908.44
## [61,] 793188 904155.8 701236.9 782404.4 -81167.5417 956351.17
## [62,] 734457 777858.0 494697.6 607961.8 -113264.1667 701236.90
## [63,] 1231170 903682.5 910851.5 907983.9 2867.5833 494697.58
## [64,] 1238837 999413.0 1171305.8 1102548.7 68757.1250 910851.46
## [65,] 1241336 1111450.0 1383698.5 1274799.1 108899.4167 1171305.81
## [66,] 1229401 1235186.0 1523107.9 1407939.1 115168.7500 1383698.54
## [67,] 1221876 1232862.5 1379753.5 1320997.1 58756.4167 1523107.88
## [68,] 848639 1135313.0 1062996.5 1091923.1 -28926.5833 1379753.54
## [69,] 730335 1007562.8 765615.6 862394.4 -96778.8750 1062996.54
## [70,] 1238643 1009873.2 865657.2 923343.6 -57686.4167 765615.56
## [71,] 1253256 1017718.2 976220.6 992819.7 -16599.0417 865657.21
## [72,] 1251442 1118419.0 1251795.1 1198444.7 53350.4583 976220.65
## [73,] 703835 1111794.0 1190698.8 1159136.9 31561.9167 1251795.15
## [74,] 856274 1016201.8 933149.2 966370.2 -33221.0000 1190698.79
## [75,] 755342 891723.2 653704.5 748912.0 -95207.5000 933149.25
## [76,] 726615 760516.5 452945.9 575974.1 -123028.2500 653704.50
## [77,] 1230649 892220.0 895644.4 894274.6 1369.7500 452945.88
## [78,] 1242030 988659.0 1164291.2 1094038.3 70252.8750 895644.38
## [79,] 1246323 1111404.2 1400078.1 1284608.6 115469.5417 1164291.19
## [80,] 1258449 1244362.8 1553031.5 1429564.0 123467.5000 1400078.10
## [81,] 1224491 1242823.2 1402841.5 1338834.2 64007.2917 1553031.50
## [82,] 817193 1136614.0 1057968.9 1089426.9 -31458.0417 1402841.48
## [83,] 730832 1007741.2 757501.1 857597.2 -100096.0417 1057968.90
## [84,] 1236594 1002277.5 843800.0 907191.0 -63391.0000 757501.15
## [85,] 1266654 1012818.2 967744.1 985773.8 -18029.6667 843800.00
## [86,] 1276021 1127525.2 1277416.4 1217459.9 59956.4583 967744.08
## [87,] 1261933 1260300.5 1526250.7 1419870.6 106380.0833 1277416.40
## [88,] 1251558 1264041.5 1427158.4 1361911.6 65246.7500 1526250.71
## [89,] 873156 1165667.0 1101139.4 1126950.4 -25811.0417 1427158.38
## [90,] 763276 1037480.8 796827.9 893089.1 -96261.1250 1101139.40
## [91,] 1246892 1033720.5 881208.9 942213.6 -61004.6250 796827.94
## [92,] 1245940 1032316.0 974015.9 997335.9 -23320.0417 881208.94
## [93,] 1252232 1127085.0 1242809.1 1196519.4 46289.6250 974015.90
## [94,] 1244140 1247301.0 1475960.0 1384496.4 91463.5833 1242809.06
## [95,] 1210476 1238197.0 1366484.1 1315169.2 51314.8333 1475959.96
## [96,] 792176 1124756.0 1025458.1 1065177.2 -39719.1667 1366484.08
## [97,] NA NA NA NA NA 1025458.08
## [98,] NA NA NA NA NA 985738.92
## [99,] NA NA NA NA NA 946019.75
## [100,] NA NA NA NA NA 906300.58
## [101,] NA NA NA NA NA 866581.42
## [102,] NA NA NA NA NA 826862.25
## [103,] NA NA NA NA NA 787143.08
## [104,] NA NA NA NA NA 747423.92
## [105,] NA NA NA NA NA 707704.75
## [106,] NA NA NA NA NA 667985.58
## [107,] NA NA NA NA NA 628266.42
## [108,] NA NA NA NA NA 588547.25
## [109,] NA NA NA NA NA 548828.08
## [110,] NA NA NA NA NA 509108.92
## [111,] NA NA NA NA NA 469389.75
## [112,] NA NA NA NA NA 429670.58
## [113,] NA NA NA NA NA 389951.42
## [114,] NA NA NA NA NA 350232.25
## [115,] NA NA NA NA NA 310513.08
## [116,] NA NA NA NA NA 270793.92
## [117,] NA NA NA NA NA 231074.75
## [118,] NA NA NA NA NA 191355.58
## [119,] NA NA NA NA NA 151636.42
## [120,] NA NA NA NA NA 111917.25
## [121,] NA NA NA NA NA 72198.08
## [122,] NA NA NA NA NA 32478.92
## [123,] NA NA NA NA NA -7240.25
## [124,] NA NA NA NA NA -46959.42
## [125,] NA NA NA NA NA -86678.58
## [126,] NA NA NA NA NA -126397.75
## [127,] NA NA NA NA NA -166116.92Hasil pemulusan menggunakan metode DMA divisualisasikan sebagai berikut
ts.plot(data_penumpangtj.ts, xlab="Periode", ylab="Jumlah Penumpang", main= "DMA N=4 Data Jumlah Penumpang Transjakarta")
points(data_penumpangtj.ts)
lines(data_penumpangtj.gab2[,3],col="green",lwd=2)
lines(data_penumpangtj.gab2[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=6, 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_training.dma = training_ma.ts-data_penumpangtj.ramal2[1:length(training_ma.ts)]
SSE_training.dma = sum(error_training.dma[8:length(training_ma.ts)]^2)
MSE_training.dma = mean(error_training.dma[8:length(training_ma.ts)]^2)
MAPE_training.dma = mean(abs((error_training.dma[8:length(training_ma.ts)]/training_ma.ts[8:length(training_ma.ts)])*100))
akurasi_training.dma <- matrix(c(SSE_training.dma, MSE_training.dma, MAPE_training.dma))
row.names(akurasi_training.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_training.dma) <- c("Akurasi Data Latih DMA m = 4")
akurasi_training.dma## Akurasi Data Latih DMA m = 4
## SSE 1.175866e+13
## MSE 1.321197e+11
## MAPE 3.358593e+01Perhitungan akurasi pada data latih menggunakan nilai MAPE menghasilkan nilai MAPE yang berkisar 20% - 50% sehingga dikategorikan layak. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.
#Menghitung nilai keakuratan data uji
error_testing.dma = testing_ma.ts-data_penumpangtj.gab2[97:111,6]
SSE_testing.dma = sum(error_testing.dma^2)
MSE_testing.dma = mean(error_testing.dma^2)
MAPE_testing.dma = mean(abs((error_testing.dma/testing_ma.ts*100)))
akurasi_testing.dma <- matrix(c(SSE_testing.dma, MSE_testing.dma, MAPE_testing.dma))
row.names(akurasi_testing.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_testing.dma) <- c("Akurasi Data Uji DMA m = 4")
akurasi_testing.dma## Akurasi Data Uji DMA m = 4
## SSE 2.822163e+12
## MSE 1.881442e+11
## MAPE 4.325208e+01perbandinganMAPE.smadma <- cbind(MAPE_training.sma,MAPE_training.dma,MAPE_testing.sma,MAPE_testing.dma)
perbandinganMAPE.smadma## MAPE_training.sma MAPE_training.dma MAPE_testing.sma MAPE_testing.dma
## [1,] 29.94756 33.58593 28.86329 43.25208Pada data latih dan data uji, metode SMA lebih baik dibandingkan dengan metode DMA.
Single Exponential Smoothing & Double Exponential Smoothing
Pembagian Data
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji. Tapi jika data tidak stasioner maka jangan membagi data tepat di titik balik.
training_es <- data_penumpangtj[1:96,]
testing_es <- data_penumpangtj[97:111,]
training_es.ts <- ts(training_es$Penumpang)
testing_es.ts <- ts(testing_es$Penumpang)Eksplorasi
Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.
plot(data_penumpangtj.ts, col="red", main="Plot Semua Data", ylab="Data Jumlah Penumpang Transjakarta" )
points(data_penumpangtj.ts)
plot(training_es.ts, col="blue", main="Plot Data Latih", ylab="Data Latih")
points(training_es.ts)
plot(testing_es.ts, col="blue", main="Plot Data Uji", ylab="Data Uji")
points(testing_es.ts)
library(ggplot2)
ggplot() +
geom_line(data = data_penumpangtj, aes(x = Periode, y = Penumpang, col = "Data Latih")) +
geom_line(data = testing_es, aes(x = Periode, y = Penumpang, col = "Data Uji")) +
labs(x = "Periode Waktu", y = "Jumlah Penumpang", color = "Legend") +
scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
values = c("blue", "red")) +
theme_bw() + theme(legend.position = "bottom",
plot.caption = element_text(hjust=0.5, size=12))
SES
Nilai alpha 0,2 dan 0,7 dan banyak periode data yang
akan diramalkan adalah sebanyak 15 periode (1,5 bulan) dengan
menggunakan fungsi Holtwinters
ses1<- HoltWinters(training_es.ts, gamma = FALSE, beta = FALSE, alpha = 0.2)
plot(ses1)
ramalan1<- forecast(ses1, h=15)
ramalan1## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 1097061 766381.4 1427741 591330.1 1602792
## 98 1097061 759832.6 1434290 581314.7 1612808
## 99 1097061 753408.7 1440714 571490.1 1622632
## 100 1097061 747102.6 1447020 561845.7 1632276
## 101 1097061 740908.2 1453214 552372.2 1641750
## 102 1097061 734819.6 1459303 543060.6 1651062
## 103 1097061 728831.8 1465290 533902.9 1660219
## 104 1097061 722939.7 1471183 524891.8 1669230
## 105 1097061 717139.0 1476983 516020.4 1678102
## 106 1097061 711425.6 1482697 507282.5 1686840
## 107 1097061 705795.6 1488327 498672.1 1695450
## 108 1097061 700245.5 1493877 490183.9 1703938
## 109 1097061 694771.9 1499350 481812.8 1712309
## 110 1097061 689371.8 1504750 473554.1 1720568
## 111 1097061 684042.3 1510080 465403.3 1728719ses2<- HoltWinters(training_es.ts, gamma = FALSE, beta = FALSE, alpha = 0.7)
plot(ses2)
ramalan2<- forecast(ses2, h=15)
ramalan2## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 920562.1 589706.773 1251417 414562.55 1426562
## 98 920562.1 516701.709 1324422 302910.94 1538213
## 99 920562.1 455007.396 1386117 208557.63 1632567
## 100 920562.1 400582.150 1440542 125321.40 1715803
## 101 920562.1 351337.087 1489787 50007.58 1791117
## 102 920562.1 306025.623 1535099 -19290.33 1860414
## 103 920562.1 263833.048 1577291 -83818.30 1924942
## 104 920562.1 224192.218 1616932 -144443.72 1985568
## 105 920562.1 186689.509 1654435 -201799.16 2042923
## 106 920562.1 151012.267 1690112 -256362.79 2097487
## 107 920562.1 116917.334 1724207 -308506.50 2149631
## 108 920562.1 84211.171 1756913 -358526.26 2199650
## 109 920562.1 52736.748 1788387 -406662.23 2247786
## 110 920562.1 22364.567 1818760 -453112.47 2294237
## 111 920562.1 -7013.651 1848138 -498042.58 2339167Nilai alpha dioptimalkan menyesuaikan dari error-nya paling minimum
ses_opt<- HoltWinters(training_es.ts, gamma = FALSE, beta = FALSE, alpha = NULL)
plot(ses_opt)
ramalan_opt<- forecast(ses_opt, h=15)
ramalan_opt## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 891162.2 560395.75 1221929 385298.54 1397026
## 98 891162.2 474157.42 1308167 253408.40 1528916
## 99 891162.2 402920.94 1379404 144461.60 1637863
## 100 891162.2 340829.51 1441495 49500.95 1732824
## 101 891162.2 285065.99 1497258 -35781.99 1818106
## 102 891162.2 234017.50 1548307 -113853.92 1896178
## 103 891162.2 186658.33 1595666 -186283.52 1968608
## 104 891162.2 142288.21 1640036 -254141.75 2036466
## 105 891162.2 100403.83 1681921 -318198.38 2100523
## 106 891162.2 60629.03 1721695 -379028.69 2161353
## 107 891162.2 22673.92 1759651 -437076.02 2219401
## 108 891162.2 -13690.51 1796015 -492690.63 2275015
## 109 891162.2 -48648.94 1830973 -546154.93 2328479
## 110 891162.2 -82352.84 1864677 -597700.59 2380025
## 111 891162.2 -114928.29 1897253 -647520.44 2429845Akurasi Data Latih
#Cara Manual
fitted1<-ramalan1$fitted
sisaan1<-ramalan1$residuals
head(sisaan1)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 385720.0 357032.0 278821.6 -262348.7 -315998.0resid1<-training_es$Penumpang-ramalan1$fitted
head(resid1)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 385720.0 357032.0 278821.6 -262348.7 -315998.0SSE1=sum(sisaan1[2:length(training_es.ts)]^2)
SSE1## [1] 6.297022e+12MSE1 = SSE1/length(training_es.ts)
MSE1## [1] 65593977399MAPE1 = sum(abs(sisaan1[2:length(training_es.ts)]/training_es.ts[2:length(training_es.ts)])*
100)/length(training_es.ts)
MAPE1## [1] 27.22067akurasi1 <- matrix(c(SSE1,MSE1,MAPE1))
row.names(akurasi1)<- c("SSE", "MSE", "MAPE")
colnames(akurasi1) <- c("Akurasi SES Data Latih lamda=0.2")
akurasi1## Akurasi SES Data Latih lamda=0.2
## SSE 6.297022e+12
## MSE 6.559398e+10
## MAPE 2.722067e+01fitted2<-ramalan1$fitted
sisaan2<-ramalan2$residuals
head(sisaan2)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 385720.0 164172.0 42447.6 -472671.7 -247920.5resid2<-training_es$Penumpang-ramalan2$fitted
head(resid2)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 385720.0 164172.0 42447.6 -472671.7 -247920.5SSE2=sum(sisaan2[2:length(training_es.ts)]^2)
SSE2## [1] 6.266068e+12MSE2 = SSE2/length(training_es.ts)
MSE2## [1] 65271543403MAPE2 = sum(abs(sisaan2[2:length(training_es.ts)]/training_es.ts[2:length(training_es.ts)])*
100)/length(training_es.ts)
MAPE2## [1] 22.10205akurasi2 <- matrix(c(SSE2,MSE2,MAPE2))
row.names(akurasi2)<- c("SSE", "MSE", "MAPE")
colnames(akurasi2) <- c("Akurasi SES Data Latih lamda=0.7")
akurasi2## Akurasi SES Data Latih lamda=0.7
## SSE 6.266068e+12
## MSE 6.527154e+10
## MAPE 2.210205e+01fitted_opt<-ramalan_opt$fitted
sisaan_opt<-ramalan_opt$residuals
head(sisaan_opt)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 385720.00 138044.09 25258.39 -479539.44 -217497.77resid_opt<-training_es$Penumpang-ramalan_opt$fitted
head(resid_opt)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 385720.00 138044.09 25258.39 -479539.44 -217497.77SSE_opt=sum(sisaan_opt[2:length(training_es.ts)]^2)
SSE_opt## [1] 6.26235e+12MSE_opt = SSE_opt/length(training_es.ts)
MSE_opt## [1] 65232815977MAPE_opt = sum(abs(sisaan_opt[2:length(training_es.ts)]/training_es.ts[2:length(training_es.ts)])*
100)/length(training_es.ts)
MAPE_opt## [1] 21.28483akurasi_opt <- matrix(c(SSE_opt,MSE_opt,MAPE_opt))
row.names(akurasi_opt)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_opt) <- c("Akurasi SES Data Latih lamda=optimum")
akurasi_opt## Akurasi SES Data Latih lamda=optimum
## SSE 6.262350e+12
## MSE 6.523282e+10
## MAPE 2.128483e+01akurasi_ses_data_latih <- cbind(akurasi1, akurasi2, akurasi_opt)
akurasi_ses_data_latih## Akurasi SES Data Latih lamda=0.2 Akurasi SES Data Latih lamda=0.7
## SSE 6.297022e+12 6.266068e+12
## MSE 6.559398e+10 6.527154e+10
## MAPE 2.722067e+01 2.210205e+01
## Akurasi SES Data Latih lamda=optimum
## SSE 6.262350e+12
## MSE 6.523282e+10
## MAPE 2.128483e+01Berdasarkan nilai SSE, MSE, dan MAPE di antara kedua parameter, nilai parameter \(\lambda=0,7\) menghasilkan akurasi yang lebih baik dibanding \(\lambda=0,2\) . Hal ini dilihat dari nilai masing-masing ukuran akurasi yang lebih kecil. Berdasarkan nilai MAPE-nya, hasil ini dapat dikategorikan sebagai peramalan yang layak.
Akurasi Data Uji
selisih1<-ramalan1$mean-testing_es$Penumpang
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(testing_es)
MAPEtesting1 <-sum(abs(selisih1/testing_es$Penumpang)*100)/length(testing_es$Penumpang)
selisih2<-ramalan2$mean-testing_es$Penumpang
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(testing_es)
MAPEtesting2 <-sum(abs(selisih2/testing_es$Penumpang)*100)/length(testing_es$Penumpang)
selisihopt<-ramalan_opt$mean-testing_es$Penumpang
SSEtestingopt<-sum(selisihopt^2)
MSEtestingopt<-SSEtestingopt/length(testing_es)
MAPEtestingopt <-sum(abs(selisihopt/testing_es$Penumpang)*100)/length(testing_es$Penumpang)
akurasitesting1 <- matrix(c(SSEtesting1,SSEtesting2,SSEtestingopt))
row.names(akurasitesting1)<- c("SSE1", "SSE2", "SSEopt")
akurasitesting1## [,1]
## SSE1 1.012736e+12
## SSE2 1.018567e+12
## SSEopt 1.110339e+12akurasitesting2 <- matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt))
row.names(akurasitesting2)<- c("MSE1", "MSE2", "MSEopt")
akurasitesting2## [,1]
## MSE1 506367805511
## MSE2 509283579070
## MSEopt 555169717803akurasitesting3 <- matrix(c(MAPEtesting1,MAPEtesting2,MAPEtestingopt))
row.names(akurasitesting3)<- c("MAPE1", "MAPE2", "MAPEopt")
akurasitesting3## [,1]
## MAPE1 28.31674
## MAPE2 26.60333
## MAPEopt 26.39244Double Exponential Smoothing
#Lamda=0.2 dan beta=0.2
des.1<- HoltWinters(training_es.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)
plot(des.1)
ramalandes1<- forecast(des.1, h=15)
ramalandes1## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 1123096 602341.47 1643851 326670.53 1919522
## 98 1117785 582242.08 1653327 298742.96 1936826
## 99 1112473 557435.38 1667511 263616.19 1961330
## 100 1107161 527647.65 1686675 220871.60 1993451
## 101 1101850 492767.00 1710933 170338.05 2033362
## 102 1096538 452821.20 1740255 112058.02 2081018
## 103 1091227 407945.45 1774508 46238.29 2136215
## 104 1085915 358347.61 1813482 -26803.27 2198633
## 105 1080603 304276.84 1856930 -106685.57 2267892
## 106 1075292 245998.87 1904585 -193002.23 2343586
## 107 1069980 183778.41 1956182 -285348.41 2425309
## 108 1064668 117868.06 2011469 -383337.80 2512675
## 109 1059357 48502.15 2070212 -486612.00 2605326
## 110 1054045 -24105.88 2132196 -594844.60 2702935
## 111 1048734 -99763.93 2197231 -707741.80 2805209#Lamda=0.6 dan beta=0.3
des.2<- HoltWinters(training_es.ts, gamma = FALSE, beta = 0.3, alpha = 0.6)
plot(des.2)
ramalandes2<- forecast(des.2, h=15)
ramalandes2## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 917082.91 522819.42 1311346 314108.93 1520057
## 98 853369.01 353353.36 1353385 88661.06 1618077
## 99 789655.11 162540.63 1416770 -169433.72 1748744
## 100 725941.21 -45607.36 1497490 -454040.51 1905923
## 101 662227.31 -268434.98 1592890 -761097.84 2085552
## 102 598513.41 -504156.37 1701183 -1087874.49 2284901
## 103 534799.51 -751514.97 1821114 -1432448.72 2502048
## 104 471085.61 -1009582.47 1951754 -1793400.81 2735572
## 105 407371.71 -1277642.38 2092386 -2169634.96 2984378
## 106 343657.81 -1555121.07 2242437 -2560273.89 3247590
## 107 279943.91 -1841545.41 2401433 -2964594.02 3524482
## 108 216230.01 -2136515.71 2568976 -3381984.06 3814444
## 109 152516.11 -2439687.65 2744720 -3811917.44 4116950
## 110 88802.21 -2750760.00 2928364 -4253933.43 4431538
## 111 25088.31 -3069465.73 3119642 -4707623.69 4757800Selanjutnya jika ingin membandingkan plot data latih dan data uji adalah sebagai berikut.
plot(data_penumpangtj.ts)
lines(des.1$fitted[,1], lty=2, col="blue")
lines(ramalandes1$mean, col="red")
Untuk mendapatkan nilai parameter optimum dari DES, argumen
alpha dan beta dapat dibuat NULL
seperti berikut.
#Lamda dan gamma optimum
des.opt<- HoltWinters(training_es.ts, gamma = FALSE)
des.opt## Holt-Winters exponential smoothing with trend and without seasonal component.
##
## Call:
## HoltWinters(x = training_es.ts, gamma = FALSE)
##
## Smoothing parameters:
## alpha: 1
## beta : 0.1117501
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 792176.00
## b -38845.72plot(des.opt)
ramalandesopt<- forecast(des.opt, h=15)
ramalandesopt## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 753330.3 390080.65 1116580 197787.9 1308873
## 98 714484.6 171309.35 1257660 -116230.2 1545199
## 99 675638.9 -26189.24 1377467 -397714.6 1748992
## 100 636793.1 -216328.17 1489914 -667943.3 1941530
## 101 597947.4 -404097.90 1599993 -934548.7 2130443
## 102 559101.7 -591852.19 1710056 -1201130.4 2319334
## 103 520256.0 -780863.40 1821375 -1469634.4 2510146
## 104 481410.3 -971875.96 1934697 -1741199.2 2704020
## 105 442564.6 -1165346.54 2050476 -2016523.3 2901652
## 106 403718.8 -1361562.71 2169000 -2296046.3 3103484
## 107 364873.1 -1560707.05 2290453 -2580047.6 3309794
## 108 326027.4 -1762894.31 2414949 -2868702.7 3520757
## 109 287181.7 -1968193.95 2542557 -3162117.7 3736481
## 110 248336.0 -2176644.59 2673317 -3460351.8 3957024
## 111 209490.3 -2388263.36 2807244 -3763431.1 4182412Akurasi Data Latih
ssedes.train1<-des.1$SSE
msedes.train1<-ssedes.train1/length(training_es.ts)
sisaandes1<-ramalandes1$residuals
head(sisaandes1)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA -337264.0 -648844.6 -1350757.4 -1478970.3mapedes.train1 <- sum(abs(sisaandes1[3:length(training_es.ts)]/training_es.ts[3:length(training_es.ts)])
*100)/length(training_es.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 beta=0.2")
akurasides.1## Akurasi lamda=0.2 dan beta=0.2
## SSE 1.637263e+13
## MSE 1.705483e+11
## MAPE 3.655001e+01ssedes.train2<-des.2$SSE
msedes.train2<-ssedes.train2/length(training_es.ts)
sisaandes2<-ramalandes2$residuals
head(sisaandes2)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA -337264.0 -466722.1 -913097.3 -548002.9mapedes.train2 <- sum(abs(sisaandes2[3:length(training_es.ts)]/training_es.ts[3:length(training_es.ts)])
*100)/length(training_es.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 beta=0.3")
akurasides.2## Akurasi lamda=0.6 dan beta=0.3
## SSE 8.868374e+12
## MSE 9.237889e+10
## MAPE 2.622848e+01ssedes.train.opt<-des.opt$SSE
msedes.train.opt<-ssedes.train.opt/length(training_es.ts)
sisaandes.opt<-ramalandesopt$residuals
head(sisaandes.opt)## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA -337264.0 -354834.7 -793783.9 -325791.5mapedes.train.opt <- sum(abs(sisaandes.opt[3:length(training_es.ts)]/training_es.ts[3:length(training_es.ts)])
*100)/length(training_es.ts)
akurasides.opt <- matrix(c(ssedes.train.opt,msedes.train.opt,mapedes.train.opt))
row.names(akurasides.opt)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.opt) <- c("Akurasi lamda dan beta optimum")
akurasides.opt## Akurasi lamda dan beta optimum
## SSE 7.625285e+12
## MSE 7.943006e+10
## MAPE 2.222091e+01akurasides.1## Akurasi lamda=0.2 dan beta=0.2
## SSE 1.637263e+13
## MSE 1.705483e+11
## MAPE 3.655001e+01akurasides.2## Akurasi lamda=0.6 dan beta=0.3
## SSE 8.868374e+12
## MSE 9.237889e+10
## MAPE 2.622848e+01akurasides.opt## Akurasi lamda dan beta optimum
## SSE 7.625285e+12
## MSE 7.943006e+10
## MAPE 2.222091e+01Hasil akurasi dari data latih didapatkan skenario 2 dengan lamda=0.6 dan beta=0.3 memiliki hasil yang lebih baik dibandingkan skenario 2. Namun untuk kedua skenario dapat dikategorikan peramalan yang layak berdasarkan nilai MAPE-nya.
Akurasi Data Uji
selisihdes1<-ramalandes1$mean-testing_es$Penumpang
head(selisihdes1)## Time Series:
## Start = 97
## End = 102
## Frequency = 1
## [1] 472625.3 693154.7 278283.0 -104710.6 -119941.2 -121983.8SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(testing_es$Penumpang)
MAPEtestingdes1<-sum(abs(selisihdes1/testing_es$Penumpang)*100)/length(testing_es$Penumpang)
selisihdes2<-ramalandes2$mean-testing_es$Penumpang
selisihdes2## Time Series:
## Start = 97
## End = 111
## Frequency = 1
## [1] 266611.91 428739.01 -44534.89 -485930.79 -559563.69 -620008.59
## [7] -526648.49 -368171.39 -792641.29 -855702.19 -936572.09 -981757.99
## [13] -1030955.89 -768563.79 -806709.69SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(testing_es$Penumpang)
MAPEtestingdes2<-sum(abs(selisihdes2/testing_es$Penumpang)*100)/length(testing_es$Penumpang)
selisihdesopt<-ramalandesopt$mean-testing_es$Penumpang
selisihdesopt## Time Series:
## Start = 97
## End = 111
## Frequency = 1
## [1] 102859.3 289854.6 -158551.1 -575078.9 -623843.6 -659420.3 -541192.0
## [8] -357846.7 -757448.4 -795641.2 -851642.9 -871960.6 -896290.3 -609030.0
## [15] -622307.7SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(testing_es$Penumpang)
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing_es$Penumpang)*100)/length(testing_es$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 1.053283e+12 7.109305e+12 5.949314e+12
## MSE 7.021890e+10 4.739537e+11 3.966209e+11
## MAPE 2.885977e+01 6.317559e+01 5.621130e+01Perbandingan SES dan DES
MAPEfull <-
matrix(c(MAPE1,MAPE2,MAPE_opt,MAPEtestingdes1,MAPEtestingdes2,
MAPEtestingdesopt),nrow=3,ncol=2)
row.names(MAPEfull)<- c("ske 1", "ske 2", "ske opt")
colnames(MAPEfull) <- c("ses","des")
MAPEfull## ses des
## ske 1 27.22067 28.85977
## ske 2 22.10205 63.17559
## ske opt 21.28483 56.21130Kedua metode dapat dibandingkan dengan menggunakan ukuran akurasi yang sama. Kasus di atas adalah perbandingan kedua metode dengan ukuran akurasi MAPE. Hasilnya didapatkan metode SES lebih baik dibandingkan metode DES dilihat dari MAPE yang lebih kecil nilainya.
Pemulusan Data Musiman
Pembagian Data
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji. Tapi jika data tidak stasioner maka jangan membagi data tepat di titik balik.
training_w <- data_penumpangtj[1:96,]
testing_w <- data_penumpangtj[97:111,]
training_w.ts <- ts(training_w$Penumpang, frequency = 12)
testing_w.ts <- ts(testing_w$Penumpang, frequency = 12)Eksplorasi
Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.
plot(data_penumpangtj.ts, col="red", main="Plot Semua Data", ylab="Data Jumlah Penumpang Transjakarta" )
points(data_penumpangtj.ts)
plot(training_es.ts, col="blue", main="Plot Data Latih", ylab="Data Latih")
points(training_es.ts)
plot(testing_es.ts, col="blue", main="Plot Data Uji", ylab="Data Uji")
points(testing_es.ts)
Winter Aditif
Pemulusan
winter1 <- HoltWinters(training_w.ts,alpha=0.2,beta=0.1,gamma=0.1,seasonal = "additive")
winter1$fitted## xhat level trend season
## Jan 2 523602.9 1009686.1 -3308.8989 -482774.271
## Feb 2 1168491.1 1022133.6 -1733.2569 148090.729
## Mar 2 1195383.1 1024637.5 -1309.5382 172055.146
## Apr 2 1196760.5 1021758.0 -1466.5408 176469.063
## May 2 1167605.2 1018566.9 -1638.9904 150677.271
## Jun 2 645325.7 1016235.5 -1708.2345 -369201.563
## Jul 2 1166153.3 1017922.3 -1368.7284 149599.687
## Aug 2 1059855.3 926000.5 -10424.0339 144278.771
## Sep 2 947401.2 827820.4 -19199.6393 138780.354
## Oct 2 967002.1 844364.8 -15625.2425 138262.562
## Nov 2 851453.2 867167.1 -11782.4844 -3931.396
## Dec 2 545782.4 914008.8 -5920.0691 -362306.354
## Jan 3 547015.6 1018378.4 5108.9038 -476471.703
## Feb 3 1288257.4 1123374.2 15097.5909 149785.604
## Mar 3 1194895.9 1020198.5 3270.2627 171427.135
## Apr 3 1072243.4 905037.0 -8572.9158 175779.264
## May 3 936915.6 804304.2 -17788.9028 150400.295
## Jun 3 303796.5 698255.0 -26614.9350 -367843.538
## Jul 3 765221.9 677838.6 -25995.0854 113378.465
## Aug 3 672557.5 595055.1 -31673.9240 109176.349
## Sep 3 654721.8 536050.9 -34406.9542 153077.941
## Oct 3 619168.9 500096.9 -34561.6510 153633.595
## Nov 3 451159.2 466141.9 -34500.9886 19518.266
## Dec 3 139723.1 486889.7 -28976.1123 -318190.463
## Jan 4 185251.6 633214.5 -11446.0144 -436516.954
## Feb 4 912929.6 803705.6 6747.6940 102476.291
## Mar 4 988310.4 853230.6 11025.4220 124054.422
## Apr 4 1046373.4 893507.5 13950.5733 138915.316
## May 4 975518.3 852015.8 8406.3450 115096.166
## Jun 4 435832.3 798938.5 2257.9784 -365364.140
## Jul 4 1057662.2 949873.4 17125.6717 90663.111
## Aug 4 1111469.0 993453.6 19771.1279 98244.229
## Sep 4 1205484.1 1031433.0 21591.9480 152459.154
## Oct 4 1225168.0 1050002.1 21289.6665 153876.245
## Nov 4 1122786.0 1060916.2 20252.1063 41617.771
## Dec 4 778681.9 1013287.9 13464.0654 -248070.071
## Jan 5 656394.1 1008497.6 11638.6282 -363742.121
## Feb 5 1264500.1 1122989.0 21923.9069 119587.203
## Mar 5 1285315.2 1129206.9 20353.3052 135755.027
## Apr 5 1154689.2 1029594.1 8356.7013 116738.403
## May 5 1141784.4 1042472.8 8808.8967 90502.700
## Jun 5 757231.4 1054040.0 9084.7290 -305893.366
## Jul 5 1183240.4 1072021.1 9974.3617 101244.935
## Aug 5 1091415.2 985557.2 330.5345 105527.509
## Sep 5 1160763.3 1007065.0 2448.2707 151250.028
## Oct 5 1175572.8 1022136.2 3710.5638 149726.004
## Nov 5 1058119.5 1038661.8 4992.0675 14465.607
## Dec 5 720619.7 977604.4 -1612.8830 -255371.820
## Jan 6 681542.6 1003050.6 1093.0228 -322601.006
## Feb 6 1143103.4 1026472.7 3325.9308 113304.796
## Mar 6 1030990.9 948069.3 -4846.9976 87768.611
## Apr 6 1100961.9 983258.1 -843.4166 118547.184
## May 6 1103509.9 1009989.7 1914.0851 91606.029
## Jun 6 741804.8 1039469.1 4670.6078 -302334.836
## Jul 6 1218751.1 1141658.9 14422.5312 62669.627
## Aug 6 1285189.9 1156706.4 14485.0300 113998.453
## Sep 6 1245934.5 1083881.3 5754.0119 156299.201
## Oct 6 1136809.4 986515.4 -4557.9778 154852.018
## Nov 6 987848.6 1002324.1 -2521.3063 -11954.195
## Dec 6 811122.9 1052884.3 2786.8412 -244548.197
## Jan 7 841658.8 1143734.9 11593.2225 -313669.374
## Feb 7 1217213.2 1127763.4 8836.7466 80613.083
## Mar 7 1169813.2 1064412.3 1617.9618 103782.935
## Apr 7 1106041.8 983136.0 -6671.4623 129577.191
## May 7 988951.3 900579.2 -14259.9974 102632.120
## Jun 7 661905.6 934658.8 -9426.0442 -263327.142
## Jul 7 1106353.7 1041257.6 2176.4445 62919.622
## Aug 7 1155478.1 1071427.9 4975.8313 79074.381
## Sep 7 1219084.4 1096997.9 7035.2490 115051.242
## Oct 7 1275256.6 1105114.5 7143.3809 162998.704
## Nov 7 1027905.7 1020645.1 -2017.8905 9278.396
## Dec 7 741930.5 959212.5 -7959.3635 -209322.672
## Jan 8 727424.5 1050185.9 1933.9066 -324695.278
## Feb 8 1224422.1 1159965.7 12718.4967 51737.944
## Mar 8 1267379.7 1183003.9 13750.4744 70625.239
## Apr 8 1308529.7 1195665.1 13641.5412 99223.050
## May 8 1332382.3 1197912.3 12502.1076 121967.933
## Jun 8 904969.5 1118569.1 3317.5809 -216917.188
## Jul 8 1168148.9 1093548.0 483.7103 74117.169
## Aug 8 1199151.0 1109780.3 2058.5725 87312.051
## Sep 8 1239674.8 1121196.7 2994.3532 115483.770
## Oct 8 1256301.6 1126702.5 3245.4963 126353.619
## Nov 8 1116030.4 1127515.7 3002.2639 -14487.497
## Dec 8 984548.6 1149407.1 4891.1750 -169749.591xhat1 <- winter1$fitted[,2]
winter1.opt<- HoltWinters(training_w.ts, alpha= NULL, beta = NULL, gamma = NULL, seasonal = "additive")
winter1.opt## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## HoltWinters(x = training_w.ts, alpha = NULL, beta = NULL, gamma = NULL, seasonal = "additive")
##
## Smoothing parameters:
## alpha: 0.1349383
## beta : 0
## gamma: 0.2397883
##
## Coefficients:
## [,1]
## a 1046080.6274
## b -3308.8989
## s1 -78199.4726
## s2 53484.0215
## s3 53388.0169
## s4 77402.9925
## s5 64736.0040
## s6 -83212.2039
## s7 105120.9383
## s8 104956.8055
## s9 118170.0365
## s10 119235.9427
## s11 -743.7171
## s12 -51122.2817winter1.opt$fitted## xhat level trend season
## Jan 2 523602.9 1009686.1 -3308.899 -482774.271
## Feb 2 1161789.7 1017007.9 -3308.899 148090.729
## Mar 2 1186208.3 1017462.1 -3308.899 172055.146
## Apr 2 1187492.1 1014331.9 -3308.899 176469.063
## May 2 1158478.5 1011110.2 -3308.899 150677.271
## Jun 2 636055.2 1008565.6 -3308.899 -369201.563
## Jul 2 1155089.1 1008798.3 -3308.899 149599.687
## Aug 2 1086856.9 945887.0 -3308.899 144278.771
## Sep 2 1015197.7 879726.3 -3308.899 138780.354
## Oct 2 1026338.8 891385.2 -3308.899 138262.562
## Nov 2 898755.9 905996.2 -3308.899 -3931.396
## Dec 2 570242.4 935857.6 -3308.899 -362306.354
## Jan 3 533918.4 1003659.7 -3308.899 -466432.367
## Feb 3 1220077.5 1069510.9 -3308.899 153875.433
## Mar 3 1164625.2 995604.1 -3308.899 172329.929
## Apr 3 1089769.1 916475.0 -3308.899 176603.047
## May 3 997165.0 848621.7 -3308.899 151852.258
## Jun 3 410568.1 777634.3 -3308.899 -363757.345
## Jul 3 818767.9 764099.9 -3308.899 57976.882
## Aug 3 759602.9 715251.0 -3308.899 47660.849
## Sep 3 840237.2 681756.8 -3308.899 161789.358
## Oct 3 814871.9 652371.0 -3308.899 165809.734
## Nov 3 666813.7 623063.6 -3308.899 47059.061
## Dec 3 371629.4 627930.5 -3308.899 -252992.207
## Jan 4 348176.7 711602.7 -3308.899 -360117.072
## Feb 4 851101.4 809060.3 -3308.899 45349.975
## Mar 4 895423.5 842955.9 -3308.899 55776.514
## Apr 4 945991.1 871916.8 -3308.899 77383.254
## May 4 889252.6 844746.8 -3308.899 47814.673
## Jun 4 428810.8 811596.0 -3308.899 -379476.329
## Jul 4 894207.9 909545.6 -3308.899 -12028.808
## Aug 4 944091.8 946141.7 -3308.899 1259.017
## Sep 4 1096097.5 977703.3 -3308.899 121703.133
## Oct 4 1109650.4 987115.4 -3308.899 125843.900
## Nov 4 1048712.2 992393.9 -3308.899 59627.195
## Dec 4 830691.1 953282.0 -3308.899 -119282.022
## Jan 5 722114.8 930639.0 -3308.899 -205215.312
## Feb 5 1087088.8 987855.8 -3308.899 102541.918
## Mar 5 1099963.5 997889.8 -3308.899 105382.658
## Apr 5 976046.2 938651.8 -3308.899 40703.289
## May 5 961131.4 962499.6 -3308.899 1940.611
## Jun 5 758301.6 985428.8 -3308.899 -223818.287
## Jul 5 1033983.2 987977.7 -3308.899 49314.358
## Aug 5 991297.5 939743.3 -3308.899 54863.146
## Sep 5 1102181.6 964232.3 -3308.899 141258.233
## Oct 5 1113080.8 977344.9 -3308.899 139044.778
## Nov 5 992395.6 991114.7 -3308.899 4589.720
## Dec 5 799799.5 952111.5 -3308.899 -149003.069
## Jan 6 840892.6 956374.7 -3308.899 -112173.239
## Feb 6 1066372.7 946628.6 -3308.899 123053.009
## Mar 6 914629.4 898531.6 -3308.899 19406.675
## Apr 6 1017076.7 937936.1 -3308.899 82449.496
## May 6 1003516.9 964551.2 -3308.899 42274.594
## Jun 6 775210.9 993333.2 -3308.899 -214813.385
## Jul 6 1028256.3 1051312.0 -3308.899 -19746.748
## Aug 6 1168415.9 1074129.8 -3308.899 97595.008
## Sep 6 1190863.8 1027670.7 -3308.899 166501.924
## Oct 6 1124208.8 962218.8 -3308.899 165298.837
## Nov 6 920761.8 974351.5 -3308.899 -50280.853
## Dec 6 875237.0 1015908.8 -3308.899 -137362.938
## Jan 7 937986.8 1063364.4 -3308.899 -122068.680
## Feb 7 1079353.7 1028459.5 -3308.899 54203.162
## Mar 7 1076806.9 995048.5 -3308.899 85067.238
## Apr 7 1073502.4 948361.7 -3308.899 128449.602
## May 7 986541.3 898244.4 -3308.899 91605.813
## Jun 7 803966.1 927875.0 -3308.899 -120599.970
## Jul 7 1000784.9 983677.7 -3308.899 20416.109
## Aug 7 1041455.5 1013501.3 -3308.899 31263.144
## Sep 7 1107137.9 1039473.1 -3308.899 70973.664
## Oct 7 1237726.9 1051999.7 -3308.899 189036.120
## Nov 7 1007324.7 991944.6 -3308.899 18688.992
## Dec 7 888691.3 951326.3 -3308.899 -59326.096
## Jan 8 821014.7 994962.8 -3308.899 -170639.191
## Feb 8 1056408.2 1051787.7 -3308.899 7929.359
## Mar 8 1093189.3 1078113.0 -3308.899 18385.231
## Apr 8 1150759.3 1097574.1 -3308.899 56494.156
## May 8 1246799.4 1107866.8 -3308.899 142241.483
## Jun 8 1021098.5 1054139.1 -3308.899 -29731.637
## Jul 8 1084079.6 1016040.0 -3308.899 71348.492
## Aug 8 1107666.3 1034700.8 -3308.899 76274.464
## Sep 8 1142057.8 1050050.3 -3308.899 95316.416
## Oct 8 1160103.3 1061608.1 -3308.899 101804.062
## Nov 8 1027665.7 1069639.0 -3308.899 -38664.363
## Dec 8 1100529.3 1090998.2 -3308.899 12839.958xhat1.opt <- winter1.opt$fitted[,2]Peramalan
forecast1 <- predict(winter1, n.ahead = 15)
forecast1.opt <- predict(winter1.opt, n.ahead = 15)Plot Deret Waktu
plot(training_w.ts,main="Winter 0.2;0.1;0.1",ylab="Jumlah Penumpang Transjakarta",type="l",col="black",
xlim=c(1,12),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 Latih
SSE1<-winter1$SSE
MSE1<-winter1$SSE/length(training_w.ts)
RMSE1<-sqrt(MSE1)
akurasi1 <- matrix(c(SSE1,MSE1,RMSE1))
row.names(akurasi1)<- c("SSE", "MSE", "RMSE")
colnames(akurasi1) <- c("Akurasi")
akurasi1## Akurasi
## SSE 9.190104e+12
## MSE 9.573025e+10
## RMSE 3.094030e+05SSE1.opt<-winter1.opt$SSE
MSE1.opt<-winter1.opt$SSE/length(training_w.ts)
RMSE1.opt<-sqrt(MSE1.opt)
akurasi1.opt <- matrix(c(SSE1.opt,MSE1.opt,RMSE1.opt))
row.names(akurasi1.opt)<- c("SSE1.opt", "MSE1.opt", "RMSE1.opt")
colnames(akurasi1.opt) <- c("Akurasi Data Latih")
akurasi1.opt## Akurasi Data Latih
## SSE1.opt 7.997864e+12
## MSE1.opt 8.331109e+10
## RMSE1.opt 2.886366e+05akurasi1.train = data.frame(Model_Winter = c("Winter 1","Winter1 optimal"),
Nilai_SSE=c(SSE1,SSE1.opt),
Nilai_MSE=c(MSE1,MSE1.opt),Nilai_RMSE=c(RMSE1,RMSE1.opt))
akurasi1.train## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1 Winter 1 9.190104e+12 95730246823 309403.0
## 2 Winter1 optimal 7.997864e+12 83311086953 288636.6Akurasi Data Uji
forecast1<-data.frame(forecast1)
testing_w.ts<-data.frame(testing_w.ts)
selisih1<-forecast1-testing_w.ts
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(testing_w.ts)
akurasitesting1 <- matrix(c(SSEtesting1,MSEtesting1))
row.names(akurasitesting1)<- c("SSE", "MSE")
colnames(akurasitesting1) <- c("Akurasi")
akurasitesting1## Akurasi
## SSE 1.42488e+12
## MSE 1.42488e+12forecast1.opt<-data.frame(forecast1.opt)
selisih1.opt<-forecast1.opt-testing_w.ts
SSEtesting1.opt<-sum(selisih1.opt^2)
MSEtesting1.opt<-SSEtesting1.opt/length(testing_w.ts)
akurasitesting1.opt <- matrix(c(SSEtesting1.opt,MSEtesting1.opt))
row.names(akurasitesting1.opt)<- c("SSE", "MSE")
colnames(akurasitesting1.opt) <- c("Akurasi")
akurasitesting1.opt## Akurasi
## SSE 1.062436e+12
## MSE 1.062436e+12Winter Multiplikatif
Pemulusan
winter2 <- HoltWinters(training_w.ts,alpha=0.2,beta=0.1,gamma=0.3,seasonal = "multiplicative")
winter2$fitted## xhat level trend season
## Jan 2 555273.8 1009686.1 -3308.8989 0.5517551
## Feb 2 1162851.1 1023454.0 -1601.2125 1.1379830
## Mar 2 1196606.2 1026567.5 -1129.7485 1.1669224
## Apr 2 1198670.6 1023882.6 -1285.2555 1.1721823
## May 2 1168513.6 1020800.3 -1464.9639 1.1463486
## Jun 2 650989.7 1018572.8 -1541.2172 0.6400880
## Jul 2 1161083.2 1020565.9 -1187.7887 1.1390113
## Aug 2 1056678.0 940766.9 -9048.9080 1.1341179
## Sep 2 945325.9 854900.0 -16730.7028 1.1278460
## Oct 2 965237.6 870229.6 -13524.6786 1.1266862
## Nov 2 872996.1 891124.9 -10082.6831 0.9908675
## Dec 2 620395.9 935858.4 -4601.0635 0.6661917
## Jan 3 610147.9 1074409.8 9714.1883 0.5628027
## Feb 3 1446782.9 1239170.2 25218.8068 1.1442546
## Mar 3 1334191.7 1133318.2 12111.7255 1.1647956
## Apr 3 1192385.0 1019836.3 -447.6408 1.1697060
## May 3 1041869.9 920057.5 -10380.7516 1.1453188
## Jun 3 510578.3 814287.4 -19919.6831 0.6427480
## Jul 3 731992.5 739668.5 -25389.6119 1.0247994
## Aug 3 642579.5 665349.8 -30282.5212 1.0118291
## Sep 3 684943.9 613982.0 -32391.0491 1.1777073
## Oct 3 639097.3 575145.0 -33035.6385 1.1789085
## Nov 3 536535.8 539243.1 -33322.2652 1.0605134
## Dec 3 395775.1 541916.1 -29722.7416 0.7727064
## Jan 4 426652.8 672785.5 -13663.5261 0.6473048
## Feb 4 859894.1 865604.0 6984.6801 0.9854518
## Mar 4 932270.6 926761.2 12401.9290 0.9926610
## Apr 4 1014499.8 979921.7 16477.7900 1.0181656
## May 4 944812.8 948207.4 11658.5787 0.9843174
## Jun 4 532807.1 903641.7 6036.1485 0.5857097
## Jul 4 1082473.8 1130404.9 28108.8524 0.9343642
## Aug 4 1175726.2 1181515.7 30409.0523 0.9701314
## Sep 4 1450485.5 1217446.5 30961.2199 1.1618685
## Oct 4 1440944.2 1203632.3 26483.6820 1.1713889
## Nov 4 1381301.5 1184417.4 21913.8214 1.1450433
## Dec 4 1106727.8 1101895.4 11470.2430 0.9940380
## Jan 5 859265.6 1028999.1 3033.5880 0.8325953
## Feb 5 1178326.6 1106833.1 10513.6303 1.0545756
## Mar 5 1177126.0 1118796.3 10658.5869 1.0422072
## Apr 5 990805.0 1035108.8 1223.9754 0.9560684
## May 5 984119.4 1075345.5 5125.2442 0.9108247
## Jun 5 814772.8 1118119.3 8890.1096 0.7229511
## Jul 5 1082338.8 1123396.6 8528.8194 0.9561927
## Aug 5 1026842.2 1052173.7 553.6533 0.9754113
## Sep 5 1211820.1 1087678.7 4048.7895 1.1100023
## Oct 5 1226820.5 1093900.1 4266.0483 1.1171538
## Nov 5 1121326.1 1100462.6 4495.6950 1.0148130
## Dec 5 917888.8 1027416.1 -3258.5231 0.8962379
## Jan 6 905234.4 1010327.8 -4641.5004 0.9001160
## Feb 6 1028393.7 980790.3 -7131.0997 1.0562152
## Mar 6 840317.0 918000.8 -12696.9487 0.9282154
## Apr 6 982969.4 989519.8 -4275.3470 0.9976909
## May 6 983059.2 1036536.4 853.8480 0.9476272
## Jun 6 790884.7 1091900.5 6304.8687 0.7201611
## Jul 6 1076505.0 1219988.2 18483.1515 0.8692208
## Aug 6 1310597.5 1271919.9 21828.0084 1.0130239
## Sep 6 1352147.1 1202544.0 12707.6208 1.1126478
## Oct 6 1237558.0 1103480.1 1530.4612 1.1199513
## Nov 6 1021427.6 1105204.3 1549.8369 0.9229038
## Dec 6 1025702.9 1156993.0 6573.7277 0.8815162
## Jan 7 1070345.3 1214782.8 11695.3371 0.8726982
## Feb 7 1122140.8 1142483.4 3295.8625 0.9793691
## Mar 7 1114422.3 1091485.8 -2133.4864 1.0230137
## Apr 7 1067502.1 1019151.8 -9153.5355 1.0569346
## May 7 933977.7 945493.4 -15604.0219 1.0043965
## Jun 7 789708.1 988964.0 -9696.5671 0.8064274
## Jul 7 980010.8 1091446.6 1521.3540 0.8966510
## Aug 7 1068004.4 1152369.5 7461.5064 0.9208276
## Sep 7 1185392.7 1201194.8 11597.8849 0.9774076
## Oct 7 1381404.4 1220793.1 12397.9248 1.1201869
## Nov 7 1101863.6 1132455.8 2324.4020 0.9709930
## Dec 7 975234.9 1058357.0 -5317.9099 0.9261146
## Jan 8 883080.3 1109481.2 326.2966 0.7957059
## Feb 8 1119996.8 1206218.4 9967.3882 0.9209093
## Mar 8 1185667.5 1250070.6 13355.8697 0.9384539
## Apr 8 1256345.9 1279679.9 14981.2143 0.9704052
## May 8 1408520.4 1293674.3 14882.5350 1.0763922
## Jun 8 1099766.0 1209083.0 4935.1500 0.9058892
## Jul 8 1082778.4 1139728.7 -2493.7932 0.9521149
## Aug 8 1124440.6 1171708.4 953.5560 0.9588787
## Sep 8 1183582.4 1198004.0 3487.7542 0.9850941
## Oct 8 1221060.6 1215429.4 4881.5223 1.0006143
## Nov 8 1091068.8 1224924.0 5342.8277 0.8868554
## Dec 8 1243280.3 1257195.0 8035.6500 0.9826511xhat2 <- winter2$fitted[,2]
winter2.opt<- HoltWinters(training_w.ts, alpha= NULL, beta = NULL, gamma = NULL, seasonal = "multiplicative")## Warning in HoltWinters(training_w.ts, alpha = NULL, beta = NULL, gamma = NULL,
## : optimization difficulties: ERROR: ABNORMAL_TERMINATION_IN_LNSRCHwinter2.opt$fitted## xhat level trend season
## Jan 2 555273.8 1009686.1 -3308.89889 0.5517551
## Feb 2 1147839.8 1011870.6 -3208.91897 1.1379830
## Mar 2 1176095.8 1011027.0 -3165.87015 1.1669224
## Apr 2 1178438.7 1008491.8 -3154.39354 1.1721823
## May 2 1149472.4 1005869.7 -3144.70448 1.1463486
## Jun 2 640356.0 1003548.4 -3129.71921 0.6400880
## Jul 2 1138481.6 1002624.5 -3089.57431 1.1390113
## Aug 2 1102358.7 975523.2 -3526.58409 1.1341179
## Sep 2 1060931.0 944693.6 -4023.49397 1.1278460
## Oct 2 1059572.9 944388.9 -3955.81314 1.1266862
## Nov 2 933661.1 946118.7 -3852.33528 0.9908675
## Dec 2 634453.0 955961.1 -3603.09275 0.6661917
## Jan 3 556334.2 997051.1 -2789.68536 0.5595452
## Feb 3 1200837.8 1050616.2 -1764.03759 1.1449067
## Mar 3 1190154.9 1020532.9 -2279.44338 1.1688199
## Apr 3 1153901.0 985918.9 -2867.92685 1.1737957
## May 3 1091250.2 953317.9 -3409.06419 1.1487946
## Jun 3 587444.1 916550.5 -4016.18252 0.6437502
## Jul 3 941162.4 887283.3 -4475.74584 1.0661014
## Aug 3 891622.1 855054.2 -4980.85230 1.0488766
## Sep 3 937581.2 828253.8 -5377.96499 1.1393957
## Oct 3 916339.8 806467.0 -5676.60435 1.1442942
## Nov 3 799897.3 784252.5 -5977.59136 1.0277825
## Dec 3 571037.3 773736.8 -6060.18325 0.7438513
## Jan 4 510604.1 806182.5 -5359.38241 0.6375991
## Feb 4 908784.1 859786.1 -4286.26474 1.0622843
## Mar 4 924434.1 868705.1 -4045.93143 1.0691312
## Apr 4 942135.4 877304.6 -3815.78739 1.0785890
## May 4 893586.2 863170.9 -4003.57110 1.0400607
## Jun 4 501302.5 845218.8 -4257.43207 0.5961064
## Jul 4 889435.9 914128.8 -2925.79533 0.9761116
## Aug 4 907106.6 931009.7 -2565.31764 0.9770178
## Sep 4 1020495.5 947897.1 -2211.28148 1.0791064
## Oct 4 1031559.9 955813.9 -2026.95043 1.0815411
## Nov 4 971970.5 962218.1 -1873.50503 1.0121059
## Dec 4 791311.3 948356.5 -2091.68723 0.8362472
## Jan 5 703253.5 938271.0 -2237.17316 0.7513120
## Feb 5 1076175.4 976059.6 -1508.71055 1.1042783
## Mar 5 1086530.1 980947.8 -1392.28803 1.1092073
## Apr 5 997486.4 956293.5 -1815.65325 1.0450598
## May 5 959522.8 965547.8 -1614.18177 0.9954242
## Jun 5 702343.0 976605.2 -1383.55992 0.7201881
## Jul 5 1012477.2 984098.9 -1221.99615 1.0301160
## Aug 5 989898.1 963426.0 -1575.99874 1.0291606
## Sep 5 1079432.0 974815.9 -1340.02240 1.1088432
## Oct 5 1084802.9 981857.0 -1187.48726 1.1061861
## Nov 5 967726.1 989675.6 -1023.57788 0.9788339
## Dec 5 794476.3 972886.6 -1310.50580 0.8177190
## Jan 6 810804.9 976410.1 -1222.52804 0.8314349
## Feb 6 1092209.4 973824.3 -1247.33860 1.1230056
## Mar 6 987565.6 952081.0 -1620.36132 1.0390389
## Apr 6 1037689.3 965544.8 -1345.83243 1.0762190
## May 6 1003387.4 976223.9 -1126.98114 1.0290130
## Jun 6 729062.2 989974.4 -856.21334 0.7370830
## Jul 6 1007976.1 1032791.3 -61.36830 0.9760307
## Aug 6 1114829.6 1046829.8 195.24655 1.0647593
## Sep 6 1168417.3 1030940.5 -97.48933 1.1334580
## Oct 6 1138509.2 1005976.4 -550.05845 1.1323646
## Nov 6 947587.1 1011115.6 -446.51343 0.9375838
## Dec 6 854402.9 1031644.4 -64.76623 0.8282471
## Jan 7 880529.9 1062421.5 496.55050 0.8284080
## Feb 7 1112550.0 1049195.1 246.79544 1.0601349
## Mar 7 1117855.8 1033888.9 -36.26650 1.0812525
## Apr 7 1123859.3 1012282.0 -428.85002 1.1106941
## May 7 1056392.7 988842.4 -847.64156 1.0692290
## Jun 7 816359.4 998480.2 -656.80901 0.8181402
## Jul 7 1041788.2 1031297.8 -47.58000 1.0102187
## Aug 7 1066982.2 1044276.4 189.49535 1.0215577
## Sep 7 1120978.2 1056524.5 408.96030 1.0605949
## Oct 7 1222163.0 1063212.8 523.24262 1.1489345
## Nov 7 1027799.1 1041058.5 110.51622 0.9871587
## Dec 7 909991.7 1021814.3 -241.73784 0.8907754
## Jan 8 836520.3 1045162.0 187.58667 0.8002302
## Feb 8 1100916.9 1079932.0 816.98150 1.0186611
## Mar 8 1116140.7 1091808.4 1018.26177 1.0213337
## Apr 8 1151161.4 1102010.7 1185.40987 1.0434785
## May 8 1220008.4 1109386.3 1298.06996 1.0984295
## Jun 8 968199.1 1090368.3 928.32075 0.8872007
## Jul 8 1123398.0 1076436.1 657.86030 1.0429899
## Aug 8 1141823.9 1084711.8 796.50404 1.0518795
## Sep 8 1176807.6 1091876.5 912.40492 1.0768846
## Oct 8 1190379.4 1097295.1 994.41694 1.0838485
## Nov 8 1034762.6 1101480.8 1052.49739 0.9385318
## Dec 8 1052314.2 1114578.7 1271.72268 0.9430602xhat2.opt <- winter2.opt$fitted[,2]Peramalan
forecast2 <- predict(winter2, n.ahead = 15)
forecast2.opt <- predict(winter2.opt, n.ahead = 15)Plot Deret Waktu
plot(training_w.ts,main="Winter 0.2;0.1;0.1",ylab="Jumlah Penumpang Transjakarta",type="l",col="black",
xlim=c(1,12),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 Latih
SSE2<-winter2$SSE
MSE2<-winter2$SSE/length(training_w.ts)
RMSE2<-sqrt(MSE2)
akurasi1 <- matrix(c(SSE2,MSE2,RMSE2))
row.names(akurasi1)<- c("SSE2", "MSE2", "RMSE2")
colnames(akurasi1) <- c("Akurasi lamda=0.2")
akurasi1## Akurasi lamda=0.2
## SSE2 9.271219e+12
## MSE2 9.657520e+10
## RMSE2 3.107655e+05SSE2.opt<-winter2.opt$SSE
MSE2.opt<-winter2.opt$SSE/length(training_w.ts)
RMSE2.opt<-sqrt(MSE2.opt)
akurasi1.opt <- matrix(c(SSE2.opt,MSE2.opt,RMSE2.opt))
row.names(akurasi1.opt)<- c("SSE2.opt", "MSE2.opt", "RMSE2.opt")
colnames(akurasi1.opt) <- c("Akurasi")
akurasi1.opt## Akurasi
## SSE2.opt 7.612045e+12
## MSE2.opt 7.929213e+10
## RMSE2.opt 2.815886e+05akurasi2.train = data.frame(Model_Winter = c("Winter 1","winter2 optimal"),
Nilai_SSE=c(SSE2,SSE2.opt),
Nilai_MSE=c(MSE2,MSE2.opt),Nilai_RMSE=c(RMSE2,RMSE2.opt))
akurasi2.train## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1 Winter 1 9.271219e+12 96575196963 310765.5
## 2 winter2 optimal 7.612045e+12 79292132946 281588.6Akurasi Data Uji
forecast2<-data.frame(forecast2)
testing_w.ts<-data.frame(testing_w.ts)
selisih2<-forecast2-testing_w.ts
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(testing_w.ts)
forecast2.opt<-data.frame(forecast2.opt)
selisih2.opt<-forecast2.opt-testing_w.ts
SSEtesting2.opt<-sum(selisih2.opt^2)
MSEtesting2.opt<-SSEtesting2.opt/length(testing_w.ts)