Tugas Pertemuan 1
Muhammad Fahrezi Maulana
2024-08-25
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(ggplot2)
library(forecast)## Warning: package 'forecast' was built under R version 4.4.1## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(graphics)
library(TTR)## Warning: package 'TTR' was built under R version 4.4.1library(TSA)## Warning: package 'TSA' was built under R version 4.4.1## Registered S3 methods overwritten by 'TSA':
## method from
## fitted.Arima forecast
## plot.Arima forecast
##
## Attaching package: 'TSA'
##
## The following object is masked from 'package:readr':
##
## spec
##
## The following objects are masked from 'package:stats':
##
## acf, arima
##
## The following object is masked from 'package:utils':
##
## tardata <- read.csv("D:\\Statistika dan Sains Data\\Semester 5\\MPDW\\dt_pt1.csv")
str(data)## 'data.frame': 115 obs. of 2 variables:
## $ Tanggal : chr "2023-01-01" "2023-01-02" "2023-01-03" "2023-01-04" ...
## $ Penumpang.Berangkat: int 4521 5283 5352 5989 5884 6299 6002 6354 5380 5660 ...Data
Data yang digunakan adalah data yang berasal dari DEPHUB, berupa data harian penumpang berangkat di Bandara Sultan Aji (BPN) di Kalimantan Timur. Periode data yang digunakan secara keseluruhan adalah dari 1 Januari 2023 hingga 31 Juni 2024 dengan total 571 periode. Data ini kemudian dibagi ke 5 mahasiswa yang tergabung dalam kelompok. Sehingga data yang digunakan pada tugas ini berjumlah 115 hari (periode).
data$Tanggal <- as.Date(data$Tanggal, format = "%Y-%m-%d")
data## Tanggal Penumpang.Berangkat
## 1 2023-01-01 4521
## 2 2023-01-02 5283
## 3 2023-01-03 5352
## 4 2023-01-04 5989
## 5 2023-01-05 5884
## 6 2023-01-06 6299
## 7 2023-01-07 6002
## 8 2023-01-08 6354
## 9 2023-01-09 5380
## 10 2023-01-10 5660
## 11 2023-01-11 5878
## 12 2023-01-12 5630
## 13 2023-01-13 6313
## 14 2023-01-14 6148
## 15 2023-01-15 6292
## 16 2023-01-16 5512
## 17 2023-01-17 5188
## 18 2023-01-18 5894
## 19 2023-01-19 6453
## 20 2023-01-20 7702
## 21 2023-01-21 6865
## 22 2023-01-22 5755
## 23 2023-01-23 5831
## 24 2023-01-24 5437
## 25 2023-01-25 6355
## 26 2023-01-26 6175
## 27 2023-01-27 6493
## 28 2023-01-28 6374
## 29 2023-01-29 5764
## 30 2023-01-30 5300
## 31 2023-01-31 5790
## 32 2023-02-01 6126
## 33 2023-02-02 6204
## 34 2023-02-03 6403
## 35 2023-02-04 6010
## 36 2023-02-05 6303
## 37 2023-02-06 5823
## 38 2023-02-07 4358
## 39 2023-02-08 6570
## 40 2023-02-09 6790
## 41 2023-02-10 7166
## 42 2023-02-11 7166
## 43 2023-02-12 6792
## 44 2023-02-13 6057
## 45 2023-02-14 5962
## 46 2023-02-15 7170
## 47 2023-02-16 7140
## 48 2023-02-17 7705
## 49 2023-02-18 7315
## 50 2023-02-19 6951
## 51 2023-02-20 6230
## 52 2023-02-21 6725
## 53 2023-02-22 7459
## 54 2023-02-23 7299
## 55 2023-02-24 7718
## 56 2023-02-25 8149
## 57 2023-02-26 7459
## 58 2023-02-27 7220
## 59 2023-02-28 7080
## 60 2023-03-01 7000
## 61 2023-03-02 6561
## 62 2023-03-03 7210
## 63 2023-03-04 6619
## 64 2023-03-05 6679
## 65 2023-03-06 6231
## 66 2023-03-07 6465
## 67 2023-03-08 7095
## 68 2023-03-09 6874
## 69 2023-03-10 7455
## 70 2023-03-11 7263
## 71 2023-03-12 7144
## 72 2023-03-13 7138
## 73 2023-03-14 7062
## 74 2023-03-15 7859
## 75 2023-03-16 7575
## 76 2023-03-17 7967
## 77 2023-03-18 7228
## 78 2023-03-19 6406
## 79 2023-03-20 6359
## 80 2023-03-21 6758
## 81 2023-03-22 6404
## 82 2023-03-23 4694
## 83 2023-03-24 4133
## 84 2023-03-25 4439
## 85 2023-03-26 5278
## 86 2023-03-27 5034
## 87 2023-03-28 4731
## 88 2023-03-29 5134
## 89 2023-03-30 5500
## 90 2023-03-31 5180
## 91 2023-04-01 4917
## 92 2023-04-02 4189
## 93 2023-04-03 4151
## 94 2023-04-04 4738
## 95 2023-04-05 5515
## 96 2023-04-06 6257
## 97 2023-04-07 5134
## 98 2023-04-08 4956
## 99 2023-04-09 5453
## 100 2023-04-10 5851
## 101 2023-04-11 5516
## 102 2023-04-12 6565
## 103 2023-04-13 7383
## 104 2023-04-14 9547
## 105 2023-04-15 10906
## 106 2023-04-16 10741
## 107 2023-04-17 11050
## 108 2023-04-18 12021
## 109 2023-04-19 12388
## 110 2023-04-20 11618
## 111 2023-04-21 10021
## 112 2023-04-22 5159
## 113 2023-04-23 5808
## 114 2023-04-24 7209
## 115 2023-04-25 7411data_ts <- ts(data$Penumpang.Berangkat)Statistik Deskriptif
summary(data_ts)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4133 5645 6355 6567 7166 12388Visualisasi Data
ts.plot(data_ts, xlab="Time Period ", ylab="Penumpang Berangkat",
main = "Time Series Plot")
points(data_ts)
## Membagi Data Train dan Data Test
training_ma <- data[1:92,]
testing_ma <- data[93:115,]
train_ma.ts <- ts(training_ma$Penumpang.Berangkat)
test_ma.ts <- ts(testing_ma$Penumpang.Berangkat)plot(data_ts, col="red",main="Plot semua data")
points(data_ts)
plot(train_ma.ts, col="blue",main="Plot data latih")
points(train_ma.ts)
plot(test_ma.ts, col="blue",main="Plot data uji")
points(test_ma.ts)
library(ggplot2)
ggplot() +
geom_line(data = training_ma, aes(x = Tanggal, y = Penumpang.Berangkat, col = "Data Latih")) +
geom_line(data = testing_ma, aes(x = Tanggal, y = Penumpang.Berangkat, col = "Data Uji")) +
labs(x = "Periode Waktu", y = "Sales", 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))
# Smooting ## Single Moving Average (SMA)
data.sma4<-SMA(train_ma.ts, n=4)library(ggplot2)
ggplot()+
geom_line(data = training_ma, aes(x = Tanggal, y = Penumpang.Berangkat, col = "train_dt"))+
geom_line(data = data[1:92,], aes(x = Tanggal, y = data.sma4, col = "SMA n=4"))+
labs(x = "Periode Waktu", y = "Penumpang Berangkat", color = "Legend")+
scale_colour_manual(name="Keterangan:", breaks = c("train_dt", "SMA n=4","SMA n=6"),
values = c("blue", "green"))+
theme_bw() + theme(legend.position = "bottom",
plot.caption = element_text(hjust=0.5, size=12))## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_line()`).
Forecasting SMA
forecast 20 period ke depan
data_ramal <- c(NA,data.sma4)
data.gab<-cbind(aktual=c(train_ma.ts,rep(NA,20)),pemulusan=c(data.sma4,rep(NA,20)),ramalan=c(data_ramal,rep(data_ramal[length(data_ramal)],19)))
data.gab## aktual pemulusan ramalan
## [1,] 4521 NA NA
## [2,] 5283 NA NA
## [3,] 5352 NA NA
## [4,] 5989 5286.25 NA
## [5,] 5884 5627.00 5286.25
## [6,] 6299 5881.00 5627.00
## [7,] 6002 6043.50 5881.00
## [8,] 6354 6134.75 6043.50
## [9,] 5380 6008.75 6134.75
## [10,] 5660 5849.00 6008.75
## [11,] 5878 5818.00 5849.00
## [12,] 5630 5637.00 5818.00
## [13,] 6313 5870.25 5637.00
## [14,] 6148 5992.25 5870.25
## [15,] 6292 6095.75 5992.25
## [16,] 5512 6066.25 6095.75
## [17,] 5188 5785.00 6066.25
## [18,] 5894 5721.50 5785.00
## [19,] 6453 5761.75 5721.50
## [20,] 7702 6309.25 5761.75
## [21,] 6865 6728.50 6309.25
## [22,] 5755 6693.75 6728.50
## [23,] 5831 6538.25 6693.75
## [24,] 5437 5972.00 6538.25
## [25,] 6355 5844.50 5972.00
## [26,] 6175 5949.50 5844.50
## [27,] 6493 6115.00 5949.50
## [28,] 6374 6349.25 6115.00
## [29,] 5764 6201.50 6349.25
## [30,] 5300 5982.75 6201.50
## [31,] 5790 5807.00 5982.75
## [32,] 6126 5745.00 5807.00
## [33,] 6204 5855.00 5745.00
## [34,] 6403 6130.75 5855.00
## [35,] 6010 6185.75 6130.75
## [36,] 6303 6230.00 6185.75
## [37,] 5823 6134.75 6230.00
## [38,] 4358 5623.50 6134.75
## [39,] 6570 5763.50 5623.50
## [40,] 6790 5885.25 5763.50
## [41,] 7166 6221.00 5885.25
## [42,] 7166 6923.00 6221.00
## [43,] 6792 6978.50 6923.00
## [44,] 6057 6795.25 6978.50
## [45,] 5962 6494.25 6795.25
## [46,] 7170 6495.25 6494.25
## [47,] 7140 6582.25 6495.25
## [48,] 7705 6994.25 6582.25
## [49,] 7315 7332.50 6994.25
## [50,] 6951 7277.75 7332.50
## [51,] 6230 7050.25 7277.75
## [52,] 6725 6805.25 7050.25
## [53,] 7459 6841.25 6805.25
## [54,] 7299 6928.25 6841.25
## [55,] 7718 7300.25 6928.25
## [56,] 8149 7656.25 7300.25
## [57,] 7459 7656.25 7656.25
## [58,] 7220 7636.50 7656.25
## [59,] 7080 7477.00 7636.50
## [60,] 7000 7189.75 7477.00
## [61,] 6561 6965.25 7189.75
## [62,] 7210 6962.75 6965.25
## [63,] 6619 6847.50 6962.75
## [64,] 6679 6767.25 6847.50
## [65,] 6231 6684.75 6767.25
## [66,] 6465 6498.50 6684.75
## [67,] 7095 6617.50 6498.50
## [68,] 6874 6666.25 6617.50
## [69,] 7455 6972.25 6666.25
## [70,] 7263 7171.75 6972.25
## [71,] 7144 7184.00 7171.75
## [72,] 7138 7250.00 7184.00
## [73,] 7062 7151.75 7250.00
## [74,] 7859 7300.75 7151.75
## [75,] 7575 7408.50 7300.75
## [76,] 7967 7615.75 7408.50
## [77,] 7228 7657.25 7615.75
## [78,] 6406 7294.00 7657.25
## [79,] 6359 6990.00 7294.00
## [80,] 6758 6687.75 6990.00
## [81,] 6404 6481.75 6687.75
## [82,] 4694 6053.75 6481.75
## [83,] 4133 5497.25 6053.75
## [84,] 4439 4917.50 5497.25
## [85,] 5278 4636.00 4917.50
## [86,] 5034 4721.00 4636.00
## [87,] 4731 4870.50 4721.00
## [88,] 5134 5044.25 4870.50
## [89,] 5500 5099.75 5044.25
## [90,] 5180 5136.25 5099.75
## [91,] 4917 5182.75 5136.25
## [92,] 4189 4946.50 5182.75
## [93,] NA NA 4946.50
## [94,] NA NA 4946.50
## [95,] NA NA 4946.50
## [96,] NA NA 4946.50
## [97,] NA NA 4946.50
## [98,] NA NA 4946.50
## [99,] NA NA 4946.50
## [100,] NA NA 4946.50
## [101,] NA NA 4946.50
## [102,] NA NA 4946.50
## [103,] NA NA 4946.50
## [104,] NA NA 4946.50
## [105,] NA NA 4946.50
## [106,] NA NA 4946.50
## [107,] NA NA 4946.50
## [108,] NA NA 4946.50
## [109,] NA NA 4946.50
## [110,] NA NA 4946.50
## [111,] NA NA 4946.50
## [112,] NA NA 4946.50Plot SMA
ts.plot(data_ts, xlab="Time Period ", ylab="Penumpang Berangkat",
main = "Time Series Plot")
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)
## Evaluasi Model ### Data Training
error_train.sma = train_ma.ts-data_ramal[1:length(train_ma.ts)]
SSE_train.sma = sum(error_train.sma[5:length(train_ma.ts)]^2)
MSE_train.sma = mean(error_train.sma[5:length(train_ma.ts)]^2)
MAPE_train.sma = mean(abs((error_train.sma[5:length(train_ma.ts)]/train_ma.ts[5:length(train_ma.ts)])*100))
akurasi_train.sma <- matrix(c(SSE_train.sma, MSE_train.sma, MAPE_train.sma))
row.names(akurasi_train.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.sma) <- c("Akurasi m = 4")
akurasi_train.sma## Akurasi m = 4
## SSE 4.438776e+07
## MSE 5.044063e+05
## MAPE 9.509175e+00Data Test
error_test.sma = test_ma.ts-data.gab[93:112,3]## Warning in `-.default`(test_ma.ts, data.gab[93:112, 3]): longer object length
## is not a multiple of shorter object lengthSSE_test.sma = sum(error_test.sma^2)
MSE_test.sma = mean(error_test.sma^2)
MAPE_test.sma = mean(abs((error_test.sma/test_ma.ts*100)))
akurasi_test.sma <- matrix(c(SSE_test.sma, MSE_test.sma, MAPE_test.sma))
row.names(akurasi_test.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.sma) <- c("Akurasi m = 4")
akurasi_test.sma## Akurasi m = 4
## SSE 3.278803e+08
## MSE 1.425567e+07
## MAPE 2.930339e+01Double Moving Average (DMA)
dma <- SMA(data.sma4, n = 4)
At <- 2*data.sma4 - dma
Bt <- 2/(4-1)*(data.sma4 - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)
t = 1:20
f = c()
for (i in t) {
f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}
data.gab2 <- cbind(aktual = c(train_ma.ts,rep(NA,20)), pemulusan1 = c(data.sma4,rep(NA,20)),pemulusan = c(data.dma, rep(NA,20)),At = c(At, rep(NA,20)), Bt = c(Bt,rep(NA,20)),ramalan = c(data_ramal, f[-1]))
data.gab2## aktual pemulusan1 pemulusan At Bt ramalan
## [1,] 4521 NA NA NA NA NA
## [2,] 5283 NA NA NA NA NA
## [3,] 5352 NA NA NA NA NA
## [4,] 5989 5286.25 NA NA NA NA
## [5,] 5884 5627.00 NA NA NA 5286.250
## [6,] 6299 5881.00 NA NA NA 5627.000
## [7,] 6002 6043.50 6600.271 6377.562 222.708333 5881.000
## [8,] 6354 6134.75 6490.062 6347.938 142.125000 6043.500
## [9,] 5380 6008.75 5995.000 6000.500 -5.500000 6134.750
## [10,] 5660 5849.00 5582.333 5689.000 -106.666667 6008.750
## [11,] 5878 5818.00 5593.625 5683.375 -89.750000 5849.000
## [12,] 5630 5637.00 5318.354 5445.812 -127.458333 5818.000
## [13,] 6313 5870.25 5998.062 5946.938 51.125000 5637.000
## [14,] 6148 5992.25 6263.708 6155.125 108.583333 5870.250
## [15,] 6292 6095.75 6423.979 6292.688 131.291667 5992.250
## [16,] 5512 6066.25 6166.458 6126.375 40.083333 6095.750
## [17,] 5188 5785.00 5451.979 5585.188 -133.208333 6066.250
## [18,] 5894 5721.50 5395.458 5525.875 -130.416667 5785.000
## [19,] 6453 5761.75 5641.958 5689.875 -47.916667 5721.500
## [20,] 7702 6309.25 7000.708 6724.125 276.583333 5761.750
## [21,] 6865 6728.50 7725.583 7326.750 398.833333 6309.250
## [22,] 5755 6693.75 7227.812 7014.188 213.625000 6728.500
## [23,] 5831 6538.25 6489.604 6509.062 -19.458333 6693.750
## [24,] 5437 5972.00 5120.125 5460.875 -340.750000 6538.250
## [25,] 6355 5844.50 5148.458 5426.875 -278.416667 5972.000
## [26,] 6175 5949.50 5738.562 5822.938 -84.375000 5844.500
## [27,] 6493 6115.00 6356.250 6259.750 96.500000 5949.500
## [28,] 6374 6349.25 6823.729 6633.938 189.791667 6115.000
## [29,] 5764 6201.50 6280.979 6249.188 31.791667 6349.250
## [30,] 5300 5982.75 5683.792 5803.375 -119.583333 6201.500
## [31,] 5790 5807.00 5343.458 5528.875 -185.416667 5982.750
## [32,] 6126 5745.00 5429.896 5555.938 -126.041667 5807.000
## [33,] 6204 5855.00 5867.604 5862.562 5.041667 5745.000
## [34,] 6403 6130.75 6541.271 6377.062 164.208333 5855.000
## [35,] 6010 6185.75 6530.125 6392.375 137.750000 6130.750
## [36,] 6303 6230.00 6446.042 6359.625 86.416667 6185.750
## [37,] 5823 6134.75 6075.479 6099.188 -23.708333 6230.000
## [38,] 4358 5623.50 4923.500 5203.500 -280.000000 6134.750
## [39,] 6570 5763.50 5472.771 5589.062 -116.291667 5623.500
## [40,] 6790 5885.25 5941.083 5918.750 22.333333 5763.500
## [41,] 7166 6221.00 6800.479 6568.688 231.791667 5885.250
## [42,] 7166 6923.00 8131.021 7647.812 483.208333 6221.000
## [43,] 6792 6978.50 7772.771 7455.062 317.708333 6923.000
## [44,] 6057 6795.25 6904.938 6861.062 43.875000 6978.500
## [45,] 5962 6494.25 5988.417 6190.750 -202.333333 6795.250
## [46,] 7170 6495.25 6169.312 6299.688 -130.375000 6494.250
## [47,] 7140 6582.25 6566.417 6572.750 -6.333333 6495.250
## [48,] 7705 6994.25 7582.167 7347.000 235.166667 6582.250
## [49,] 7315 7332.50 8134.896 7813.938 320.958333 6994.250
## [50,] 6951 7277.75 7662.854 7508.812 154.041667 7332.500
## [51,] 6230 7050.25 6861.188 6936.812 -75.625000 7277.750
## [52,] 6725 6805.25 6286.604 6494.062 -207.458333 7050.250
## [53,] 7459 6841.25 6587.292 6688.875 -101.583333 6805.250
## [54,] 7299 6928.25 6964.917 6950.250 14.666667 6841.250
## [55,] 7718 7300.25 7852.750 7631.750 221.000000 6928.250
## [56,] 8149 7656.25 8447.500 8131.000 316.500000 7300.250
## [57,] 7459 7656.25 8107.917 7927.250 180.666667 7656.250
## [58,] 7220 7636.50 7760.146 7710.688 49.458333 7656.250
## [59,] 7080 7477.00 7261.167 7347.500 -86.333333 7636.500
## [60,] 7000 7189.75 6689.542 6889.625 -200.083333 7477.000
## [61,] 6561 6965.25 6378.792 6613.375 -234.583333 7189.750
## [62,] 7210 6962.75 6652.854 6776.812 -123.958333 6965.250
## [63,] 6619 6847.50 6607.812 6703.688 -95.875000 6962.750
## [64,] 6679 6767.25 6569.854 6648.812 -78.958333 6847.500
## [65,] 6231 6684.75 6466.729 6553.938 -87.208333 6767.250
## [66,] 6465 6498.50 6163.500 6297.500 -134.000000 6684.750
## [67,] 7095 6617.50 6576.667 6593.000 -16.333333 6498.500
## [68,] 6874 6666.25 6748.750 6715.750 33.000000 6617.500
## [69,] 7455 6972.25 7444.958 7255.875 189.083333 6666.250
## [70,] 7263 7171.75 7696.438 7486.562 209.875000 6972.250
## [71,] 7144 7184.00 7493.062 7369.438 123.625000 7171.750
## [72,] 7138 7250.00 7425.833 7355.500 70.333333 7184.000
## [73,] 7062 7151.75 7089.042 7114.125 -25.083333 7250.000
## [74,] 7859 7300.75 7432.625 7379.875 52.750000 7151.750
## [75,] 7575 7408.50 7626.417 7539.250 87.166667 7300.750
## [76,] 7967 7615.75 8026.688 7862.312 164.375000 7408.500
## [77,] 7228 7657.25 7926.729 7818.938 107.791667 7615.750
## [78,] 6406 7294.00 6960.875 7094.125 -133.250000 7657.250
## [79,] 6359 6990.00 6324.583 6590.750 -266.166667 7294.000
## [80,] 6758 6687.75 5905.250 6218.250 -313.000000 6990.000
## [81,] 6404 6481.75 5845.708 6100.125 -254.416667 6687.750
## [82,] 4694 6053.75 5221.146 5554.188 -333.041667 6481.750
## [83,] 4133 5497.25 4359.125 4814.375 -455.250000 6053.750
## [84,] 4439 4917.50 3550.729 4097.438 -546.708333 5497.250
## [85,] 5278 4636.00 3569.125 3995.875 -426.750000 4917.500
## [86,] 5034 4721.00 4351.104 4499.062 -147.958333 4636.000
## [87,] 4731 4870.50 5010.917 4954.750 56.166667 4721.000
## [88,] 5134 5044.25 5421.438 5270.562 150.875000 4870.500
## [89,] 5500 5099.75 5376.208 5265.625 110.583333 5044.250
## [90,] 5180 5136.25 5300.521 5234.812 65.708333 5099.750
## [91,] 4917 5182.75 5294.417 5249.750 44.666667 5136.250
## [92,] 4189 4946.50 4705.146 4801.688 -96.541667 5182.750
## [93,] NA NA NA NA NA 4946.500
## [94,] NA NA NA NA NA 4608.604
## [95,] NA NA NA NA NA 4512.062
## [96,] NA NA NA NA NA 4415.521
## [97,] NA NA NA NA NA 4318.979
## [98,] NA NA NA NA NA 4222.438
## [99,] NA NA NA NA NA 4125.896
## [100,] NA NA NA NA NA 4029.354
## [101,] NA NA NA NA NA 3932.812
## [102,] NA NA NA NA NA 3836.271
## [103,] NA NA NA NA NA 3739.729
## [104,] NA NA NA NA NA 3643.188
## [105,] NA NA NA NA NA 3546.646
## [106,] NA NA NA NA NA 3450.104
## [107,] NA NA NA NA NA 3353.562
## [108,] NA NA NA NA NA 3257.021
## [109,] NA NA NA NA NA 3160.479
## [110,] NA NA NA NA NA 3063.938
## [111,] NA NA NA NA NA 2967.396
## [112,] NA NA NA NA NA 2870.854Plot DMA
ts.plot(data_ts, xlab="Time Period ", ylab="Penumpang Berangkat", main= "DMA N=4 Data Sales")
points(data_ts)
lines(data.gab2[,3],col="green",lwd=2)
lines(data.gab2[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.8)
## Evaluasi Model ### Data Training
error_train.dma = train_ma.ts-data.ramal2[1:length(train_ma.ts)]
SSE_train.dma = sum(error_train.dma[8:length(train_ma.ts)]^2)
MSE_train.dma = mean(error_train.dma[8:length(train_ma.ts)]^2)
MAPE_train.dma = mean(abs((error_train.dma[8:length(train_ma.ts)]/train_ma.ts[8:length(train_ma.ts)])*100))
akurasi_train.dma <- matrix(c(SSE_train.dma, MSE_train.dma, MAPE_train.dma))
row.names(akurasi_train.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.dma) <- c("Akurasi m = 4")
akurasi_train.dma## Akurasi m = 4
## SSE 6.752423e+07
## MSE 7.944027e+05
## MAPE 1.186519e+01Data Test
error_test.dma = test_ma.ts-data.gab2[93:112,6]## Warning in `-.default`(test_ma.ts, data.gab2[93:112, 6]): longer object length
## is not a multiple of shorter object lengthSSE_test.dma = sum(error_test.dma^2)
MSE_test.dma = mean(error_test.dma^2)
MAPE_test.dma = mean(abs((error_test.dma/test_ma.ts*100)))
akurasi_test.dma <- matrix(c(SSE_test.dma, MSE_test.dma, MAPE_test.dma))
row.names(akurasi_test.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.dma) <- c("Akurasi m = 4")
akurasi_test.dma## Akurasi m = 4
## SSE 5.419852e+08
## MSE 2.356457e+07
## MAPE 4.208280e+01Single Exponential Smoothing
Plot SES
ses <- ses(train_ma.ts, beta = FALSE, gamma = FALSE,alpha = NULL)
autoplot(ses) +
autolayer(fitted(ses), series="Fitted") +
ylab("Penumpang Berangkat") + xlab("Periode")
## Evaluasi Model ### Data Training
ses_train_error <- train_ma.ts - ses$fitted
RMSE_train_ses <- sqrt(mean(ses_train_error^2, na.rm = T))
MAPE_train_ses <- mean(abs(ses_train_error/train_ma.ts)*100, na.rm = T)
RMSE_train_ses## [1] 592.6191MAPE_train_ses## [1] 7.62407Data Test
ses_prediction <- forecast(ses, h = 10)
ses_test_error <- test_ma.ts - ses_prediction$mean[1]
RMSE_test_ses <- sqrt(mean(ses_test_error^2, na.rm = T))
MAPE_test_ses <- mean(abs(ses_test_error/test_ma.ts)*100, na.rm = T)
RMSE_test_ses## [1] 4287.126MAPE_test_ses## [1] 37.52905Double Exponential Smoothing
Plot DES
des <- HoltWinters(train_ma.ts, beta = NULL, gamma = FALSE,alpha = NULL)
plot(des)
## Presiksi 20 Periode ke Depan
des_predict <- forecast(des, h = 20)Evaluasi Model
Data Training
des_train_error <- train_ma.ts - des$fitted
RMSE_train_des <- sqrt(mean(des_train_error^2, na.rm = T))
MAPE_train_des <- mean(abs(des_train_error/train_ma.ts)*100, na.rm = T)
RMSE_train_des## [1] 3678.799MAPE_train_des## [1] 38.1703Data Test
des_test_error <- test_ma.ts - des_predict$mean[1:20]## Warning in `-.default`(test_ma.ts, des_predict$mean[1:20]): longer object
## length is not a multiple of shorter object lengthRMSE_test_des <- sqrt(mean(des_test_error^2, na.rm = T))
MAPE_test_des <- mean(abs(des_test_error/test_ma.ts)*100, na.rm = T)
RMSE_test_des## [1] 5861.571MAPE_test_des## [1] 55.65319Holt Winters
Plot Holt Winters
train.winter <- ts(training_ma$Penumpang.Berangkat, frequency = 7)
hw <- HoltWinters(train.winter, beta = NULL, gamma = NULL,alpha = NULL,seasonal = "additive")
plot(hw)
## Prediksi 20 Periode ke Depan
hw_predict <- forecast(hw, h = 20)Evaluasi Model
Data Training
hw_train_error <- train.winter - hw$fitted
RMSE_train_hw <- sqrt(mean(hw_train_error^2, na.rm = T))
MAPE_train_hw <- mean(abs(hw_train_error/train.winter)*100, na.rm = T)
RMSE_train_hw## [1] 4550.041MAPE_train_hw## [1] 53.44805Data Test
hw_test_error <- test_ma.ts - hw_predict$mean[1:20]## Warning in `-.default`(test_ma.ts, hw_predict$mean[1:20]): longer object length
## is not a multiple of shorter object lengthRMSE_test_hw <- sqrt(mean(hw_test_error^2, na.rm = T))
MAPE_test_hw <- mean(abs(hw_test_error/test_ma.ts)*100, na.rm = T)
RMSE_test_hw## [1] 4124.856MAPE_test_hw## [1] 36.31245hw## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## HoltWinters(x = train.winter, alpha = NULL, beta = NULL, gamma = NULL, seasonal = "additive")
##
## Smoothing parameters:
## alpha: 0.8771627
## beta : 0
## gamma: 0.8810553
##
## Coefficients:
## [,1]
## a 4237.39235
## b 24.18197
## s1 -375.88151
## s2 -454.90911
## s3 95.32825
## s4 -73.71025
## s5 274.43412
## s6 132.30186
## s7 -38.83046