tugas1
G14012110834_Dindana Fitriani
2023-09-04
#install.packages("forecast")
#install.packages("graphics")
#install.packages("TTR")
#install.packages("TSA"))library("forecast")## Warning: package 'forecast' was built under R version 4.2.3## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary("graphics")
library("TTR")
library("TSA")## Warning: package 'TSA' was built under R version 4.2.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':
##
## tar#Data yang digunakan dalam kesempatan kali ini adalah data Harga Gula Pasir di Jawa Barat mingguan Minggu tahun 2022-2023 .
library(rio)
# R program to read a file in table format
# Using read.csv()
myData = read.csv("C:\\MAGANG\\1\\1\\data.csv")
myData## Minggu Harga
## 1 1 13700
## 2 2 13700
## 3 3 13700
## 4 4 13650
## 5 5 13700
## 6 6 13700
## 7 7 13700
## 8 8 13700
## 9 9 13700
## 10 10 13700
## 11 11 13700
## 12 12 13700
## 13 13 13750
## 14 14 13700
## 15 15 13750
## 16 16 13750
## 17 17 13750
## 18 18 13750
## 19 19 13750
## 20 20 13750
## 21 21 13750
## 22 22 13800
## 23 23 13850
## 24 24 13800
## 25 25 13950
## 26 26 14400
## 27 27 14500
## 28 28 14500
## 29 29 14500
## 30 30 14500
## 31 31 14500
## 32 32 14550
## 33 33 14550
## 34 34 14650
## 35 35 14700
## 36 36 14750
## 37 37 14800
## 38 38 14950
## 39 39 14950
## 40 40 15000
## 41 41 15000
## 42 42 15050
## 43 43 15050
## 44 44 15050
## 45 45 15050
## 46 46 15000
## 47 47 15000
## 48 48 14950
## 49 49 14950
## 50 50 14900
## 51 51 14850
## 52 52 14850
## 53 53 14850
## 54 54 14800
## 55 55 14750
## 56 56 14700
## 57 57 14700
## 58 58 14650
## 59 59 14550
## 60 60 14550
## 61 61 14500
## 62 62 14500
## 63 63 14550
## 64 64 14550
## 65 65 14550
## 66 66 14550
## 67 67 14550
## 68 68 14550
## 69 69 14550
## 70 70 14550
## 71 71 14550
## 72 72 14550
## 73 73 14600
## 74 74 14600
## 75 75 14550
## 76 76 14550
## 77 77 14550
## 78 78 14600
## 79 79 14600
## 80 80 14650
## 81 81 14600
## 82 82 14600
## 83 83 14650
## 84 84 14600
## 85 85 14600
## 86 86 14600
## 87 87 14650
## 88 88 14600
## 89 89 14650
## 90 90 14700
## 91 91 14750
## 92 92 14750
## 93 93 14750
## 94 94 14750
## 95 95 14850
## 96 96 14850
## 97 97 14950
## 98 98 15000
## 99 99 15000
## 100 100 14950
## 101 101 14950
## 102 102 14950
## 103 103 15000
## 104 104 15050
## 105 105 15100
## 106 106 15150#print(myData)
#data <- import ("https://raw.githubusercontent.com/Dindanafitrianimtd16/Mpdw5/main/Data/data.csv")str(data)## function (..., list = character(), package = NULL, lib.loc = NULL, verbose = getOption("verbose"),
## envir = .GlobalEnv, overwrite = TRUE)dim(data)## NULL#str(data): Menampilkan struktur data seperti tipe data dan jumlah kolom. #dim(data): Menampilkan dimensi data (jumlah baris dan kolom).
data.ts <- ts(myData$Harga)#data.ts: Mengkonversi kolom “Harga” dari myData menjadi objek deret waktu (time series).
summary(data.ts)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 13650 14500 14600 14498 14850 15150#Memberikan ringkasan statistik dari deret waktu, seperti nilai minimum, maksimum, median, dll.
ts.plot(data.ts, xlab="Mingguan ", ylab="Harga",
main = "Harga Gula Perminggu di Jawa Barat")
points(data.ts)
##terlihat bahwa data berpola trend karena terjadi kenaikan sekuler
jangka panjang (perubahan sistematis selama periode waktu yang panjang)
dalam data. Metode pemulusan yang cocok adalah Double Moving Average
(DMA) dan Double Exponential Smoothing (DES).
Pemulusan (Smoothing)
Double Moving Average (DMA)
Pembagian Data
#membagi 80% data latih (training) dan 20% data uji (testing)
training_ma <- myData[1:65,]
testing_ma <- myData[66:106,]
train_ma.ts <- ts(training_ma$Harga)
test_ma.ts <- ts(testing_ma$Harga)#training_ma: Memisahkan 80% data sebagai data latih. #testing_ma: Memisahkan 20% data sebagai data uji. #train_ma.ts: Membuat deret waktu dari data latih. #test_ma.ts: Membuat deret waktu dari data uji
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="yellow",main="Plot semua data")
points(data.ts)
#eksplorasi data latih
plot(train_ma.ts, col="red",main="Plot data latih")
points(train_ma.ts)
#eksplorasi data uji
plot(test_ma.ts, col="blue",main="Plot data uji")
points(test_ma.ts)
Eksplorasi data juga dapat dilakukan menggunakan package
ggplot2 .
#Eksplorasi dengan GGPLOT
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.2.3ggplot() +
geom_line(data = training_ma, aes(x = Minggu, y = Harga, col = "Data Latih")) +
geom_line(data = testing_ma, aes(x = Minggu, y = Harga, col = "Data Uji")) +
labs(x = "Minggu", y = "Harga", color = "Legend") +
scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
values = c("orange", "red")) +
theme_bw() + theme(legend.position = "bottom",
plot.caption = element_text(hjust=0.5, size=12))
Metode DMA
Metode pemulusan Double Moving Average (DMA) pada dasarnya mirip dengan SMA. Namun demikian, metode ini lebih cocok digunakan untuk pola data trend. Proses pemulusan dengan rata rata dalam metode ini dilakukan sebanyak 2 kali.
data.sma <- SMA(train_ma.ts, n=4)
dma <- SMA(data.sma, n = 4)
At <- 2*data.sma - dma
Bt <- 2/(4-1)*(data.sma - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)
t = 1:41
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,41)), pemulusan1 = c(data.sma,rep(NA,41)),pemulusan2 = c(data.dma, rep(NA,41)),At = c(At, rep(NA,41)), Bt = c(Bt,rep(NA,41)),ramalan = c(data.ramal2, f[-1]))
data.gab2## aktual pemulusan1 pemulusan2 At Bt ramalan
## [1,] 13700 NA NA NA NA NA
## [2,] 13700 NA NA NA NA NA
## [3,] 13700 NA NA NA NA NA
## [4,] 13650 13687.5 NA NA NA NA
## [5,] 13700 13687.5 NA NA NA NA
## [6,] 13700 13687.5 NA NA NA NA
## [7,] 13700 13687.5 13687.50 13687.50 0.000000 NA
## [8,] 13700 13700.0 13715.62 13709.38 6.250000 13687.50
## [9,] 13700 13700.0 13710.42 13706.25 4.166667 13715.62
## [10,] 13700 13700.0 13705.21 13703.12 2.083333 13710.42
## [11,] 13700 13700.0 13700.00 13700.00 0.000000 13705.21
## [12,] 13700 13700.0 13700.00 13700.00 0.000000 13700.00
## [13,] 13750 13712.5 13728.12 13721.88 6.250000 13700.00
## [14,] 13700 13712.5 13722.92 13718.75 4.166667 13728.12
## [15,] 13750 13725.0 13745.83 13737.50 8.333333 13722.92
## [16,] 13750 13737.5 13763.54 13753.12 10.416667 13745.83
## [17,] 13750 13737.5 13753.12 13746.88 6.250000 13763.54
## [18,] 13750 13750.0 13770.83 13762.50 8.333333 13753.12
## [19,] 13750 13750.0 13760.42 13756.25 4.166667 13770.83
## [20,] 13750 13750.0 13755.21 13753.12 2.083333 13760.42
## [21,] 13750 13750.0 13750.00 13750.00 0.000000 13755.21
## [22,] 13800 13762.5 13778.12 13771.88 6.250000 13750.00
## [23,] 13850 13787.5 13829.17 13812.50 16.666667 13778.12
## [24,] 13800 13800.0 13841.67 13825.00 16.666667 13829.17
## [25,] 13950 13850.0 13933.33 13900.00 33.333333 13841.67
## [26,] 14400 14000.0 14234.38 14140.62 93.750000 13933.33
## [27,] 14500 14162.5 14511.46 14371.88 139.583333 14234.38
## [28,] 14500 14337.5 14754.17 14587.50 166.666667 14511.46
## [29,] 14500 14475.0 14860.42 14706.25 154.166667 14754.17
## [30,] 14500 14500.0 14718.75 14631.25 87.500000 14860.42
## [31,] 14500 14500.0 14578.12 14546.88 31.250000 14718.75
## [32,] 14550 14512.5 14538.54 14528.12 10.416667 14578.12
## [33,] 14550 14525.0 14551.04 14540.62 10.416667 14538.54
## [34,] 14650 14562.5 14625.00 14600.00 25.000000 14551.04
## [35,] 14700 14612.5 14711.46 14671.88 39.583333 14625.00
## [36,] 14750 14662.5 14782.29 14734.38 47.916667 14711.46
## [37,] 14800 14725.0 14865.62 14809.38 56.250000 14782.29
## [38,] 14950 14800.0 14966.67 14900.00 66.666667 14865.62
## [39,] 14950 14862.5 15029.17 14962.50 66.666667 14966.67
## [40,] 15000 14925.0 15086.46 15021.88 64.583333 15029.17
## [41,] 15000 14975.0 15115.62 15059.38 56.250000 15086.46
## [42,] 15050 15000.0 15098.96 15059.38 39.583333 15115.62
## [43,] 15050 15025.0 15097.92 15068.75 29.166667 15098.96
## [44,] 15050 15037.5 15084.38 15065.62 18.750000 15097.92
## [45,] 15050 15050.0 15086.46 15071.88 14.583333 15084.38
## [46,] 15000 15037.5 15037.50 15037.50 0.000000 15086.46
## [47,] 15000 15025.0 15004.17 15012.50 -8.333333 15037.50
## [48,] 14950 15000.0 14953.12 14971.88 -18.750000 15004.17
## [49,] 14950 14975.0 14917.71 14940.62 -22.916667 14953.12
## [50,] 14900 14950.0 14887.50 14912.50 -25.000000 14917.71
## [51,] 14850 14912.5 14834.38 14865.62 -31.250000 14887.50
## [52,] 14850 14887.5 14814.58 14843.75 -29.166667 14834.38
## [53,] 14850 14862.5 14794.79 14821.88 -27.083333 14814.58
## [54,] 14800 14837.5 14775.00 14800.00 -25.000000 14794.79
## [55,] 14750 14812.5 14750.00 14775.00 -25.000000 14775.00
## [56,] 14700 14775.0 14696.88 14728.12 -31.250000 14750.00
## [57,] 14700 14737.5 14648.96 14684.38 -35.416667 14696.88
## [58,] 14650 14700.0 14606.25 14643.75 -37.500000 14648.96
## [59,] 14550 14650.0 14540.62 14584.38 -43.750000 14606.25
## [60,] 14550 14612.5 14508.33 14550.00 -41.666667 14540.62
## [61,] 14500 14562.5 14447.92 14493.75 -45.833333 14508.33
## [62,] 14500 14525.0 14420.83 14462.50 -41.666667 14447.92
## [63,] 14550 14525.0 14472.92 14493.75 -20.833333 14420.83
## [64,] 14550 14525.0 14509.38 14515.62 -6.250000 14472.92
## [65,] 14550 14537.5 14553.12 14546.88 6.250000 14509.38
## [66,] NA NA NA NA NA 14553.12
## [67,] NA NA NA NA NA 14559.38
## [68,] NA NA NA NA NA 14565.62
## [69,] NA NA NA NA NA 14571.88
## [70,] NA NA NA NA NA 14578.12
## [71,] NA NA NA NA NA 14584.38
## [72,] NA NA NA NA NA 14590.62
## [73,] NA NA NA NA NA 14596.88
## [74,] NA NA NA NA NA 14603.12
## [75,] NA NA NA NA NA 14609.38
## [76,] NA NA NA NA NA 14615.62
## [77,] NA NA NA NA NA 14621.88
## [78,] NA NA NA NA NA 14628.12
## [79,] NA NA NA NA NA 14634.38
## [80,] NA NA NA NA NA 14640.62
## [81,] NA NA NA NA NA 14646.88
## [82,] NA NA NA NA NA 14653.12
## [83,] NA NA NA NA NA 14659.38
## [84,] NA NA NA NA NA 14665.62
## [85,] NA NA NA NA NA 14671.88
## [86,] NA NA NA NA NA 14678.12
## [87,] NA NA NA NA NA 14684.38
## [88,] NA NA NA NA NA 14690.62
## [89,] NA NA NA NA NA 14696.88
## [90,] NA NA NA NA NA 14703.12
## [91,] NA NA NA NA NA 14709.38
## [92,] NA NA NA NA NA 14715.62
## [93,] NA NA NA NA NA 14721.88
## [94,] NA NA NA NA NA 14728.12
## [95,] NA NA NA NA NA 14734.38
## [96,] NA NA NA NA NA 14740.62
## [97,] NA NA NA NA NA 14746.88
## [98,] NA NA NA NA NA 14753.12
## [99,] NA NA NA NA NA 14759.38
## [100,] NA NA NA NA NA 14765.62
## [101,] NA NA NA NA NA 14771.88
## [102,] NA NA NA NA NA 14778.12
## [103,] NA NA NA NA NA 14784.38
## [104,] NA NA NA NA NA 14790.62
## [105,] NA NA NA NA NA 14796.88
## [106,] NA NA NA NA NA 14803.12Visualisasi
ts.plot(data.ts, xlab="Minggu ", ylab="Harga", main= "DMA N=4 Data Harga Gula Per Minggu di Jawa Barat")
points(data.ts)
lines(data.gab2[,3],col="blue",lwd=2)
lines(data.gab2[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","blue","red"), cex=0.8)
Akurasi Data Latih
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.489714e+05
## MSE 1.118916e+04
## MAPE 4.125129e-01#Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE yang kurang dari 10% sehingga nilai akurasi ini dapat dikategorikan sebagai sangat baik.
Akurasi Data Uji
error_test.dma = test_ma.ts-data.gab2[66:106,6]
SSE_test.dma = sum(error_test.dma^2)
MSE_test.dma = mean(error_test.dma^2)
MAPE_test.dma = mean(abs((error_test.dma/test_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 6.625879e+05
## MSE 1.616068e+04
## MAPE 5.943042e-01#Perhitungan akurasi menggunakan data uji menghasilkan nilai MAPE yang kurang dari 10% sehingga nilai akurasi ini dapat dikategorikan sebagai sangat baik.
Double Exponential Smoothing (DES)
Metode Exponential Smoothing adalah metode pemulusan dengan melakukan pembobotan menurun secara eksponensial. Nilai yang lebih baru diberi bobot yang lebih besar dari nilai terdahulu. Terdapat satu atau lebih parameter pemulusan yang ditentukan secara eksplisit dan hasil pemilihan parameter tersebut akan menentukan bobot yang akan diberikan pada nilai pengamatan.
Pembagian Data
Pembagian data latih dan data uji dilakukan dengan perbandingan 61% data latih dan 39% data uji.
#membagi 61% data latih (training) dan 39% data uji (testing)
training <- myData[1:65,]
testing <- myData[66:106,]
train.ts <- ts(training$Harga)
test.ts <- ts(testing$Harga)Eksplorasi Data
Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.
#eksplorasi data
plot(data.ts, col="black",main="Plot semua data")
points(data.ts)
plot(train.ts, col="yellow",main="Plot data latih")
points(train.ts)
plot(test.ts, col="green",main="Plot data uji")
points(test.ts)
Eksplorasi data juga dapat dilakukan menggunakan package
ggplot2 .
#Eksplorasi dengan GGPLOT
library(ggplot2)
ggplot() +
geom_line(data = training, aes(x = Minggu, y = Harga, col = "Data Latih")) +
geom_line(data = testing, aes(x = Minggu, y = Harga, col = "Data Uji")) +
labs(x = "Minggu Waktu", y = "Harga Rata-rata", color = "Legend") +
scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
values = c("brown", "red")) +
theme_bw() + theme(legend.position = "bottom",
plot.caption = element_text(hjust=0.5, size=12))
Metode DES
#Metode pemulusan DES digunakan untuk data yang memiliki pola tren. Metode DES adalah metode semacam SES, hanya saja dilakukan dua kali, yaitu pertama untuk tahapan ‘level’ dan kedua untuk tahapan ‘tren’. Pemulusan menggunakan metode ini akan menghasilkan peramalan tidak konstan untuk Minggu berikutnya.
#beta=0.2 dan alpha=0.2
des.1<- HoltWinters(train.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)
plot(des.1)
#ramalan
ramalandes1<- forecast(des.1, h=41)
ramalandes1## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 66 14404.96 14222.54 14587.38 14125.98 14683.95
## 67 14374.30 14186.70 14561.90 14087.39 14661.21
## 68 14343.63 14149.20 14538.06 14046.28 14640.99
## 69 14312.97 14109.96 14515.97 14002.50 14623.43
## 70 14282.30 14068.94 14495.66 13955.99 14608.61
## 71 14251.64 14026.14 14477.13 13906.77 14596.50
## 72 14220.97 13981.62 14460.32 13854.91 14587.03
## 73 14190.31 13935.44 14445.17 13800.52 14580.09
## 74 14159.64 13887.70 14431.59 13743.74 14575.55
## 75 14128.98 13838.48 14419.48 13684.69 14573.26
## 76 14098.31 13787.88 14408.75 13623.54 14573.08
## 77 14067.65 13735.98 14399.31 13560.41 14574.88
## 78 14036.98 13682.88 14391.08 13495.43 14578.53
## 79 14006.32 13628.64 14383.99 13428.71 14583.92
## 80 13975.65 13573.33 14377.97 13360.36 14590.94
## 81 13944.99 13517.02 14372.95 13290.47 14599.51
## 82 13914.32 13459.75 14368.89 13219.11 14609.53
## 83 13883.66 13401.57 14365.74 13146.37 14620.94
## 84 13852.99 13342.53 14363.45 13072.31 14633.68
## 85 13822.33 13282.66 14361.99 12996.98 14647.67
## 86 13791.66 13222.00 14361.32 12920.43 14662.89
## 87 13761.00 13160.57 14361.42 12842.73 14679.27
## 88 13730.33 13098.41 14362.25 12763.89 14696.77
## 89 13699.67 13035.54 14363.79 12683.97 14715.36
## 90 13669.00 12971.98 14366.03 12602.99 14735.01
## 91 13638.34 12907.74 14368.93 12520.99 14755.68
## 92 13607.67 12842.86 14372.48 12438.00 14777.34
## 93 13577.01 12777.35 14376.66 12354.04 14799.97
## 94 13546.34 12711.22 14381.46 12269.13 14823.55
## 95 13515.68 12644.48 14386.87 12183.30 14848.05
## 96 13485.01 12577.15 14392.87 12096.56 14873.46
## 97 13454.35 12509.25 14399.44 12008.94 14899.75
## 98 13423.68 12440.78 14406.58 11920.46 14926.90
## 99 13393.01 12371.75 14414.28 11831.13 14954.90
## 100 13362.35 12302.18 14422.52 11740.96 14983.74
## 101 13331.68 12232.07 14431.30 11649.97 15013.40
## 102 13301.02 12161.43 14440.60 11558.17 15043.86
## 103 13270.35 12090.28 14450.43 11465.59 15075.12
## 104 13239.69 12018.62 14460.76 11372.22 15107.16
## 105 13209.02 11946.45 14471.60 11278.08 15139.97
## 106 13178.36 11873.78 14482.94 11183.18 15173.54#beta=0.3 dan aplha=0.6
des.2<- HoltWinters(train.ts, gamma = FALSE, beta = 0.3, alpha = 0.6)
plot(des.2)
#ramalan
ramalandes2<- forecast(des.2, h=41)
ramalandes2## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 66 14537.20 14429.99 14644.41 14373.239 14701.16
## 67 14536.15 14400.19 14672.12 14328.212 14744.09
## 68 14535.10 14364.58 14705.63 14274.307 14795.90
## 69 14534.06 14324.26 14743.86 14213.194 14854.92
## 70 14533.01 14279.94 14786.07 14145.975 14920.04
## 71 14531.96 14232.12 14831.80 14073.394 14990.52
## 72 14530.91 14181.13 14880.69 13995.974 15065.85
## 73 14529.86 14127.24 14932.49 13914.100 15145.62
## 74 14528.81 14070.62 14987.00 13828.071 15229.55
## 75 14527.76 14011.45 15044.08 13738.125 15317.40
## 76 14526.72 13949.84 15103.59 13644.459 15408.97
## 77 14525.67 13885.91 15165.43 13547.238 15504.10
## 78 14524.62 13819.75 15229.49 13446.607 15602.63
## 79 14523.57 13751.43 15295.71 13342.691 15704.45
## 80 14522.52 13681.05 15364.00 13235.600 15809.44
## 81 14521.47 13608.65 15434.30 13125.433 15917.51
## 82 14520.43 13534.30 15506.55 13012.282 16028.57
## 83 14519.38 13458.06 15580.70 12896.228 16142.53
## 84 14518.33 13379.96 15656.70 12777.345 16259.31
## 85 14517.28 13300.06 15734.50 12655.704 16378.86
## 86 14516.23 13218.40 15814.06 12531.367 16501.10
## 87 14515.18 13135.01 15895.35 12404.395 16625.97
## 88 14514.13 13049.94 15978.33 12274.843 16753.43
## 89 14513.09 12963.22 16062.96 12142.764 16883.41
## 90 14512.04 12874.87 16149.21 12008.206 17015.87
## 91 14510.99 12784.93 16237.05 11871.215 17150.76
## 92 14509.94 12693.44 16326.45 11731.835 17288.05
## 93 14508.89 12600.40 16417.38 11590.108 17427.68
## 94 14507.84 12505.86 16509.83 11446.072 17569.62
## 95 14506.80 12409.83 16603.76 11299.764 17713.83
## 96 14505.75 12312.34 16699.15 11151.221 17860.27
## 97 14504.70 12213.41 16795.99 11000.475 18008.92
## 98 14503.65 12113.06 16894.24 10847.559 18159.74
## 99 14502.60 12011.31 16993.89 10692.505 18312.70
## 100 14501.55 11908.19 17094.92 10535.340 18467.77
## 101 14500.50 11803.70 17197.31 10376.095 18624.91
## 102 14499.46 11697.87 17301.05 10214.796 18784.12
## 103 14498.41 11590.71 17406.11 10051.469 18945.35
## 104 14497.36 11482.24 17512.47 9886.139 19108.58
## 105 14496.31 11372.48 17620.14 9718.831 19273.79
## 106 14495.26 11261.45 17729.08 9549.568 19440.96Nilai y adalah nilai data deret waktu,
gamma adalah parameter pemulusan untuk komponen musiman,
beta adalah parameter pemulusan untuk tren, dan
alpha adalah parameter pemulusan untuk stasioner, serta
h adalah banyaknya Minggu yang akan diramalkan.
Visualisasi
Selanjutnya jika ingin membandingkan plot data latih dan data uji adalah sebagai berikut.
#Visually evaluate the prediction
plot(data.ts)
lines(des.1$fitted[,1], lty=2, col="orange")
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(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.1770138
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 14550.00000
## b -10.73672plot(des.opt)
#ramalan
ramalandesopt<- forecast(des.opt, h=41)
ramalandesopt## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 66 14539.26 14448.93 14629.60 14401.105 14677.42
## 67 14528.53 14389.00 14668.05 14315.146 14741.91
## 68 14517.79 14332.24 14703.34 14234.018 14801.56
## 69 14507.05 14275.63 14738.48 14153.119 14860.99
## 70 14496.32 14218.17 14774.46 14070.926 14921.71
## 71 14485.58 14159.44 14811.72 13986.796 14984.36
## 72 14474.84 14099.25 14850.43 13900.430 15049.26
## 73 14464.11 14037.51 14890.70 13811.690 15116.52
## 74 14453.37 13974.18 14932.56 13720.517 15186.22
## 75 14442.63 13909.25 14976.01 13626.897 15258.37
## 76 14431.90 13842.73 15021.06 13530.842 15332.95
## 77 14421.16 13774.63 15067.69 13432.378 15409.94
## 78 14410.42 13704.98 15115.87 13331.538 15489.31
## 79 14399.69 13633.80 15165.58 13228.359 15571.01
## 80 14388.95 13561.11 15216.79 13122.882 15655.02
## 81 14378.21 13486.95 15269.47 13015.147 15741.28
## 82 14367.48 13411.34 15323.61 12905.193 15829.76
## 83 14356.74 13334.31 15379.17 12793.062 15920.42
## 84 14346.00 13255.87 15436.13 12678.792 16013.21
## 85 14335.27 13176.06 15494.47 12562.419 16108.11
## 86 14324.53 13094.90 15554.15 12443.981 16205.08
## 87 14313.79 13012.42 15615.17 12323.511 16304.07
## 88 14303.06 12928.62 15677.49 12201.045 16405.07
## 89 14292.32 12843.55 15741.09 12076.613 16508.02
## 90 14281.58 12757.20 15805.96 11950.247 16612.92
## 91 14270.85 12669.62 15872.07 11821.976 16719.71
## 92 14260.11 12580.80 15939.42 11691.830 16828.39
## 93 14249.37 12490.78 16007.97 11559.835 16938.91
## 94 14238.64 12399.56 16077.71 11426.019 17051.25
## 95 14227.90 12307.17 16148.62 11290.405 17165.39
## 96 14217.16 12213.63 16220.70 11153.020 17281.30
## 97 14206.42 12118.94 16293.91 11013.886 17398.96
## 98 14195.69 12023.12 16368.26 10873.026 17518.35
## 99 14184.95 11926.18 16443.72 10730.463 17639.44
## 100 14174.21 11828.15 16520.28 10586.216 17762.21
## 101 14163.48 11729.03 16597.93 10440.307 17886.65
## 102 14152.74 11628.83 16676.65 10292.756 18012.73
## 103 14142.00 11527.58 16756.43 10143.580 18140.43
## 104 14131.27 11425.27 16837.27 9992.800 18269.74
## 105 14120.53 11321.92 16919.14 9840.432 18400.63
## 106 14109.79 11217.55 17002.04 9686.493 18533.10Akurasi 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 NA 0.00 -50.00 12.00 11.12mapedes.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.265543e+06
## MSE 1.946989e+04
## MAPE 6.210092e-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 NA 0.00 -50.00 39.00 17.58mapedes.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 4.338883e+05
## MSE 6.675204e+03
## MAPE 3.303591e-01Hasil akurasi dari data latih didapatkan skenario 2 dengan lamda=0.6 dan gamma=0.3 memiliki hasil yang lebih baik. Hal tersebut dapat dilihat berdasarkan nilai SSE, MSE,dan MAPE nya yang bernilai lebih kecil. Namun, kedua skenario tersebut dapat dikategorikan peramalan sangat baik berdasarkan nilai MAPE-nya.
Akurasi Data Uji
#Akurasi Data Testing
selisihdes1 <- ramalandes1$mean - testing$Harga
selisihdes1## Time Series:
## Start = 66
## End = 106
## Frequency = 1
## [1] -145.0380 -175.7030 -206.3681 -237.0331 -267.6982 -298.3633
## [7] -329.0283 -409.6934 -440.3585 -421.0235 -451.6886 -482.3537
## [13] -563.0187 -593.6838 -674.3488 -655.0139 -685.6790 -766.3440
## [19] -747.0091 -777.6742 -808.3392 -889.0043 -869.6693 -950.3344
## [25] -1030.9995 -1111.6645 -1142.3296 -1172.9947 -1203.6597 -1334.3248
## [31] -1364.9899 -1495.6549 -1576.3200 -1606.9850 -1587.6501 -1618.3152
## [37] -1648.9802 -1729.6453 -1810.3104 -1890.9754 -1971.6405SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(testing$Harga)
MAPEtestingdes1<-sum(abs(selisihdes1/testing$Harga)*100)/length(testing$Harga)
selisihdes2<-ramalandes2$mean-testing$Harga
selisihdes2## Time Series:
## Start = 66
## End = 106
## Frequency = 1
## [1] -12.79957 -13.84801 -14.89646 -15.94490 -16.99335 -18.04179
## [7] -19.09023 -70.13868 -71.18712 -22.23557 -23.28401 -24.33245
## [13] -75.38090 -76.42934 -127.47778 -78.52623 -79.57467 -130.62312
## [19] -81.67156 -82.72000 -83.76845 -134.81689 -85.86534 -136.91378
## [25] -187.96222 -239.01067 -240.05911 -241.10755 -242.15600 -343.20444
## [31] -344.25289 -445.30133 -496.34977 -497.39822 -448.44666 -449.49511
## [37] -450.54355 -501.59199 -552.64044 -603.68888 -654.73732SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(testing$Harga)
MAPEtestingdes2<-sum(abs(selisihdes2/testing$Harga)*100)/length(testing$Harga)
selisihdesopt<-ramalandesopt$mean-testing$Harga
selisihdesopt## Time Series:
## Start = 66
## End = 106
## Frequency = 1
## [1] -10.73672 -21.47344 -32.21017 -42.94689 -53.68361 -64.42033
## [7] -75.15705 -135.89378 -146.63050 -107.36722 -118.10394 -128.84066
## [13] -189.57739 -200.31411 -261.05083 -221.78755 -232.52427 -293.26100
## [19] -253.99772 -264.73444 -275.47116 -336.20788 -296.94460 -357.68133
## [25] -418.41805 -479.15477 -489.89149 -500.62821 -511.36494 -622.10166
## [31] -632.83838 -743.57510 -804.31182 -815.04855 -775.78527 -786.52199
## [37] -797.25871 -857.99543 -918.73216 -979.46888 -1040.20560SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(testing$Harga)
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing$Harga)*100)/length(testing$Harga)
akurasitestingdes <-
matrix(c(SSEtestingdes1,MSEtestingdes1,MAPEtestingdes1,SSEtestingdes2,MSEtestingdes2,
MAPEtestingdes2,SSEtestingdesopt,MSEtestingdesopt,MAPEtestingdesopt),
nrow=3,ncol=3)
row.names(akurasitestingdes)<- c("SSE", "MSE", "MAPE")
colnames(akurasitestingdes) <- c("des ske1","des ske2","des opt")
akurasitestingdes## des ske1 des ske2 des opt
## SSE 4.723896e+07 3.287069e+06 1.025738e+07
## MSE 1.152170e+06 8.017243e+04 2.501800e+05
## MAPE 6.276898e+00 1.381311e+00 2.674876e+00Hasil akurasi dari data latih DES Opt memiliki hasil
yang lebih baik karena memiliki nilai SSE, MSE, dan MAPE yang lebih
kecil dibandingkan hasil akurasi pada DES skenario 1 dan 2. Namun,
ketiga skenario tersebut dapat dikategorikan peramalan sangat baik
berdasarkan nilai MAPE-nya.
Perbandingan Metode Pemulusan DMA dan DES
perbandingan <-
matrix(c(SSE_test.dma, MSE_test.dma, MAPE_test.dma, SSEtestingdesopt,MSEtestingdesopt,MAPEtestingdesopt),
nrow=3,ncol=2)
row.names(perbandingan)<- c("SSE", "MSE", "MAPE")
colnames(perbandingan) <- c("DMA","DES")
perbandingan## DMA DES
## SSE 6.625879e+05 1.025738e+07
## MSE 1.616068e+04 2.501800e+05
## MAPE 5.943042e-01 2.674876e+00Kedua metode dapat dibandingkan dengan menggunakan ukuran akurasi yang sama. Berdasarkan nilai SSE, MSE, dan MAPE, metode DMA lebih baik karena memiliki ukuran akurasi yang lebih kecil dibandingkan dengan metode DES. Berdasarkan nilai MAPE nya kedua metode tersebut memberikan peramalan dengan akurasi yang sangat baik karena kurang dari 10%
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
summary(cars)## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00Including Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.