library(readxl)
data7 <- read_xlsx("C:/Users/Hafly Akeyla Pari/AppData/Downloads/Minyak Goreng 101-200.xlsx")
data7
## # A tibble: 100 × 2
## periode harga
## <dbl> <dbl>
## 1 101 19283.
## 2 102 19250
## 3 103 19200
## 4 104 19200
## 5 105 19200
## 6 106 19200
## 7 107 19217.
## 8 108 19233.
## 9 109 19250
## 10 110 19200
## # ℹ 90 more rows
Melihat data menggunakan fungsi View(), struktur data
menggunakan fungsi str(), dan dimensi data menggunakan
fungsi dim().
data7$'harga'<-as.numeric(data7$harga)
View(data7)
str(data7)
## tibble [100 × 2] (S3: tbl_df/tbl/data.frame)
## $ periode: num [1:100] 101 102 103 104 105 106 107 108 109 110 ...
## $ harga : num [1:100] 19283 19250 19200 19200 19200 ...
Mengubah data agar terbaca sebagai data deret waktu dengan fungsi
ts() .
data7.ts <- ts(data7$`harga`)
data7.ts
## Time Series:
## Start = 1
## End = 100
## Frequency = 1
## [1] 19283.33 19250.00 19200.00 19200.00 19200.00 19200.00 19216.67 19233.33
## [9] 19250.00 19200.00 19200.00 19200.00 19200.00 19200.00 19200.00 19200.00
## [17] 19200.00 19250.00 19200.00 19200.00 19183.33 19166.67 19150.00 19200.00
## [25] 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00
## [33] 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00
## [41] 19150.00 19133.33 19116.67 19100.00 19100.00 19100.00 19200.00 19100.00
## [49] 19100.00 19100.00 19100.00 19100.00 19100.00 19100.00 19100.00 19100.00
## [57] 19100.00 19100.00 19100.00 19050.00 19050.00 19050.00 19033.33 19016.67
## [65] 19000.00 19000.00 18950.00 19000.00 19000.00 19000.00 19000.00 19000.00
## [73] 19000.00 19000.00 19000.00 18950.00 18966.67 18983.33 19000.00 19000.00
## [81] 19000.00 19000.00 19000.00 18983.33 18966.67 18950.00 18950.00 18900.00
## [89] 19000.00 18800.00 18833.33 18866.67 18900.00 18900.00 18900.00 18900.00
## [97] 18900.00 18883.33 18866.67 18850.00
Menampilkan ringkasan data
summary(data7.ts)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18800 19000 19100 19079 19150 19283
Membuat plot data deret waktu
ts.plot(data7.ts, xlab="periode ", ylab="Harga minyak goreng",
main = "Time Series Plot")
points (data7.ts)
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
#membagi data latih dan data uji
training_ma7 <- data7[1:80,]
testing_ma7 <- data7[81:100,]
train_ma7.ts <- ts(training_ma7$`harga`)
test_ma7.ts <- ts(testing_ma7$`harga`)
Eksplorasi data dilakukan pada keseluruhan data, data latih serta data uji menggunakan plot data deret waktu.
#eksplorasi keseluruhan data
plot(data7.ts, col="red",main="Plot semua data")
points(data7.ts)
#eksplorasi data latih
plot(train_ma7.ts, col="blue",main="Plot data latih")
points(train_ma7.ts)
#eksplorasi data uji
plot(test_ma7.ts, col="blue",main="Plot data uji")
points(test_ma7.ts)
library(ggplot2)
ggplot() +
geom_line(data = training_ma7, aes(x = periode, y = `harga`, col = "Data Latih")) + # Menggunakan backticks untuk nama kolom dengan spasi
geom_line(data = testing_ma7, aes(x = periode, y = `harga`, col = "Data Uji")) +
labs(x = "Periode", y = "Minyak Goreng", color = "Legend") +
scale_colour_manual(name = "Keterangan:", breaks = c("Data Latih", "Data Uji"),
values = c("blue", "red")) +
theme_bw() +
theme(legend.position = "bottom",
plot.caption = element_text(hjust = 0.5, size = 12))
Single Moving Average (SMA) Ide dasar dari Single Moving Average (SMA) adalah data suatu periode dipengaruhi oleh data periode sebelumnya. Metode pemulusan ini cocok digunakan untuk pola data stasioner atau konstan. Prinsip dasar metode pemulusan ini adalah data pemulusan pada periode ke-t merupakan rata rata dari m buah data pada periode ke-t hingga periode ke (t-m+1). Data pemulusan pada periode ke-t selanjutnya digunakan sebagai nilai peramalan pada periode ke t+1
Pemulusan menggunakan metode SMA dilakukan dengan fungsi SMA(). Dalam hal ini akan dilakukan pemulusan dengan parameter m=4.
library("forecast")
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library("graphics")
library("TTR")
library("TSA")
## Registered S3 methods overwritten by 'TSA':
## method from
## fitted.Arima forecast
## plot.Arima forecast
##
## Attaching package: 'TSA'
## The following objects are masked from 'package:stats':
##
## acf, arima
## The following object is masked from 'package:utils':
##
## tar
data7.sma<-SMA(train_ma7.ts, n=3)
data7.sma
## Time Series:
## Start = 1
## End = 80
## Frequency = 1
## [1] NA NA 19244.44 19216.67 19200.00 19200.00 19205.56 19216.67
## [9] 19233.33 19227.78 19216.67 19200.00 19200.00 19200.00 19200.00 19200.00
## [17] 19200.00 19216.67 19216.67 19216.67 19194.44 19183.33 19166.67 19172.22
## [25] 19166.67 19166.67 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00
## [33] 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00
## [41] 19150.00 19144.44 19133.33 19116.67 19105.56 19100.00 19133.33 19133.33
## [49] 19133.33 19100.00 19100.00 19100.00 19100.00 19100.00 19100.00 19100.00
## [57] 19100.00 19100.00 19100.00 19083.33 19066.67 19050.00 19044.44 19033.33
## [65] 19016.67 19005.56 18983.33 18983.33 18983.33 19000.00 19000.00 19000.00
## [73] 19000.00 19000.00 19000.00 18983.33 18972.22 18966.67 18983.33 18994.44
Data pemulusan pada periode ke-t selanjutnya digunakan sebagai nilai peramalan pada periode ke t+1 sehingga hasil peramalan 1 periode kedepan adalah sebagai berikut.
data7.ramal<-c(NA,data7.sma)
data7.ramal #forecast 1 periode ke depan
## [1] NA NA NA 19244.44 19216.67 19200.00 19200.00 19205.56
## [9] 19216.67 19233.33 19227.78 19216.67 19200.00 19200.00 19200.00 19200.00
## [17] 19200.00 19200.00 19216.67 19216.67 19216.67 19194.44 19183.33 19166.67
## [25] 19172.22 19166.67 19166.67 19150.00 19150.00 19150.00 19150.00 19150.00
## [33] 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00 19150.00
## [41] 19150.00 19150.00 19144.44 19133.33 19116.67 19105.56 19100.00 19133.33
## [49] 19133.33 19133.33 19100.00 19100.00 19100.00 19100.00 19100.00 19100.00
## [57] 19100.00 19100.00 19100.00 19100.00 19083.33 19066.67 19050.00 19044.44
## [65] 19033.33 19016.67 19005.56 18983.33 18983.33 18983.33 19000.00 19000.00
## [73] 19000.00 19000.00 19000.00 19000.00 18983.33 18972.22 18966.67 18983.33
## [81] 18994.44
Selanjutnya akan dilakukan peramalan sejumlah data uji yaitu 100 periode. Pada metode SMA, hasil peramalan 100 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 100 periode kedepan.
data.gab7<-cbind(aktual=c(train_ma7.ts,rep(NA,24)),pemulusan=c(data7.sma,rep(NA,24)),ramalan=c(data7.ramal,rep(data7.ramal[length(data7.ramal)],23)))
options(max.print = 5000) # Menampilkan hingga 5000 baris di konsol
print(data.gab7) #forecast 24 periode ke depan
## aktual pemulusan ramalan
## [1,] 19283.33 NA NA
## [2,] 19250.00 NA NA
## [3,] 19200.00 19244.44 NA
## [4,] 19200.00 19216.67 19244.44
## [5,] 19200.00 19200.00 19216.67
## [6,] 19200.00 19200.00 19200.00
## [7,] 19216.67 19205.56 19200.00
## [8,] 19233.33 19216.67 19205.56
## [9,] 19250.00 19233.33 19216.67
## [10,] 19200.00 19227.78 19233.33
## [11,] 19200.00 19216.67 19227.78
## [12,] 19200.00 19200.00 19216.67
## [13,] 19200.00 19200.00 19200.00
## [14,] 19200.00 19200.00 19200.00
## [15,] 19200.00 19200.00 19200.00
## [16,] 19200.00 19200.00 19200.00
## [17,] 19200.00 19200.00 19200.00
## [18,] 19250.00 19216.67 19200.00
## [19,] 19200.00 19216.67 19216.67
## [20,] 19200.00 19216.67 19216.67
## [21,] 19183.33 19194.44 19216.67
## [22,] 19166.67 19183.33 19194.44
## [23,] 19150.00 19166.67 19183.33
## [24,] 19200.00 19172.22 19166.67
## [25,] 19150.00 19166.67 19172.22
## [26,] 19150.00 19166.67 19166.67
## [27,] 19150.00 19150.00 19166.67
## [28,] 19150.00 19150.00 19150.00
## [29,] 19150.00 19150.00 19150.00
## [30,] 19150.00 19150.00 19150.00
## [31,] 19150.00 19150.00 19150.00
## [32,] 19150.00 19150.00 19150.00
## [33,] 19150.00 19150.00 19150.00
## [34,] 19150.00 19150.00 19150.00
## [35,] 19150.00 19150.00 19150.00
## [36,] 19150.00 19150.00 19150.00
## [37,] 19150.00 19150.00 19150.00
## [38,] 19150.00 19150.00 19150.00
## [39,] 19150.00 19150.00 19150.00
## [40,] 19150.00 19150.00 19150.00
## [41,] 19150.00 19150.00 19150.00
## [42,] 19133.33 19144.44 19150.00
## [43,] 19116.67 19133.33 19144.44
## [44,] 19100.00 19116.67 19133.33
## [45,] 19100.00 19105.56 19116.67
## [46,] 19100.00 19100.00 19105.56
## [47,] 19200.00 19133.33 19100.00
## [48,] 19100.00 19133.33 19133.33
## [49,] 19100.00 19133.33 19133.33
## [50,] 19100.00 19100.00 19133.33
## [51,] 19100.00 19100.00 19100.00
## [52,] 19100.00 19100.00 19100.00
## [53,] 19100.00 19100.00 19100.00
## [54,] 19100.00 19100.00 19100.00
## [55,] 19100.00 19100.00 19100.00
## [56,] 19100.00 19100.00 19100.00
## [57,] 19100.00 19100.00 19100.00
## [58,] 19100.00 19100.00 19100.00
## [59,] 19100.00 19100.00 19100.00
## [60,] 19050.00 19083.33 19100.00
## [61,] 19050.00 19066.67 19083.33
## [62,] 19050.00 19050.00 19066.67
## [63,] 19033.33 19044.44 19050.00
## [64,] 19016.67 19033.33 19044.44
## [65,] 19000.00 19016.67 19033.33
## [66,] 19000.00 19005.56 19016.67
## [67,] 18950.00 18983.33 19005.56
## [68,] 19000.00 18983.33 18983.33
## [69,] 19000.00 18983.33 18983.33
## [70,] 19000.00 19000.00 18983.33
## [71,] 19000.00 19000.00 19000.00
## [72,] 19000.00 19000.00 19000.00
## [73,] 19000.00 19000.00 19000.00
## [74,] 19000.00 19000.00 19000.00
## [75,] 19000.00 19000.00 19000.00
## [76,] 18950.00 18983.33 19000.00
## [77,] 18966.67 18972.22 18983.33
## [78,] 18983.33 18966.67 18972.22
## [79,] 19000.00 18983.33 18966.67
## [80,] 19000.00 18994.44 18983.33
## [81,] NA NA 18994.44
## [82,] NA NA 18994.44
## [83,] NA NA 18994.44
## [84,] NA NA 18994.44
## [85,] NA NA 18994.44
## [86,] NA NA 18994.44
## [87,] NA NA 18994.44
## [88,] NA NA 18994.44
## [89,] NA NA 18994.44
## [90,] NA NA 18994.44
## [91,] NA NA 18994.44
## [92,] NA NA 18994.44
## [93,] NA NA 18994.44
## [94,] NA NA 18994.44
## [95,] NA NA 18994.44
## [96,] NA NA 18994.44
## [97,] NA NA 18994.44
## [98,] NA NA 18994.44
## [99,] NA NA 18994.44
## [100,] NA NA 18994.44
## [101,] NA NA 18994.44
## [102,] NA NA 18994.44
## [103,] NA NA 18994.44
## [104,] NA NA 18994.44
Adapun plot data deret waktu dari hasil peramalan yang dilakukan adalah sebagai berikut.
ts.plot(data7.ts, xlab="period ", ylab="Minyak Goreng", main= "SMA N=3 Data Minyak Goreng")
points(data7.ts)
lines(data.gab7[,2],col="green",lwd=2)
lines(data.gab7[,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_train7.sma = train_ma7.ts-data7.ramal[1:length(train_ma7.ts)]
error_train7.sma
## Time Series:
## Start = 1
## End = 80
## Frequency = 1
## [1] NA NA NA -44.444444 -16.666667 0.000000
## [7] 16.666667 27.777778 33.333333 -33.333333 -27.777778 -16.666667
## [13] 0.000000 0.000000 0.000000 0.000000 0.000000 50.000000
## [19] -16.666667 -16.666667 -33.333333 -27.777778 -33.333333 33.333333
## [25] -22.222222 -16.666667 -16.666667 0.000000 0.000000 0.000000
## [31] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
## [37] 0.000000 0.000000 0.000000 0.000000 0.000000 -16.666667
## [43] -27.777778 -33.333333 -16.666667 -5.555556 100.000000 -33.333333
## [49] -33.333333 -33.333333 0.000000 0.000000 0.000000 0.000000
## [55] 0.000000 0.000000 0.000000 0.000000 0.000000 -50.000000
## [61] -33.333333 -16.666667 -16.666667 -27.777778 -33.333333 -16.666667
## [67] -55.555556 16.666667 16.666667 16.666667 0.000000 0.000000
## [73] 0.000000 0.000000 0.000000 -50.000000 -16.666667 11.111111
## [79] 33.333333 16.666667
SSE_train7.sma = sum(error_train7.sma[5:length(train_ma7.ts)]^2)
SSE_train7.sma
## [1] 43148.15
MSE_train7.sma = mean(error_train7.sma[5:length(train_ma7.ts)]^2)
MSE_train7.sma
## [1] 567.7388
MAPE_train7.sma = mean(abs((error_train7.sma[5:length(train_ma7.ts)]/train_ma7.ts[5:length(train_ma7.ts)])*100))
MAPE_train7.sma
## [1] 0.08033135
akurasi_train7.sma <- matrix(c(SSE_train7.sma, MSE_train7.sma, MAPE_train7.sma))
row.names(akurasi_train7.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train7.sma) <- c("Akurasi m = 3")
akurasi_train7.sma
## Akurasi m = 3
## SSE 4.314815e+04
## MSE 5.677388e+02
## MAPE 8.033135e-02
Dalam hal ini nilai MAPE data latih pada metode pemulusan SMA lebih dari 2%, nilai ini dapat dikategorikan sebagai nilai akurasi yang cukup rendah. Selanjutnya dilakukan perhitungan nilai MAPE data uji pada metode pemulusan SMA.
error_test7.sma = test_ma7.ts-data.gab7[81:100,3]
SSE_test7.sma = sum(error_test7.sma^2)
MSE_test7.sma = mean(error_test7.sma^2)
MAPE_test7.sma = mean(abs((error_test7.sma/test_ma7.ts*100)))
akurasi_test7.sma <- matrix(c(SSE_test7.sma, MSE_test7.sma, MAPE_test7.sma))
row.names(akurasi_test7.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test7.sma) <- c("Akurasi m = 3")
akurasi_test7.sma
## Akurasi m = 3
## SSE 1.881173e+05
## MSE 9.405864e+03
## MAPE 4.194108e-01
Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE yang lebih dari antara 20%-50% sehingga nilai akurasi ini dapat dikategorikan sebagai cukup.
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.
dma7 <- SMA(data7.sma, n = 3)
At7 <- 2*data7.sma - dma7
Bt7 <- 2/(3-1)*(data7.sma - dma7)
data7.dma<- At7+Bt7
data.ramal22<- c(NA, data7.dma)
t = 1:24
f = c()
for (i in t) {
f[i] = At7[length(At7)] + Bt7[length(Bt7)]*(i)
}
data.gab22 <- cbind(aktual = c(train_ma7.ts,rep(NA,24)), pemulusan1 = c(data7.sma,rep(NA,24)),pemulusan2 = c(data7.dma, rep(NA,24)),At7 = c(At7, rep(NA,24)), Bt7 = c(Bt7,rep(NA,24)),ramalan = c(data.ramal22, f[-1]))
data.gab22
## aktual pemulusan1 pemulusan2 At7 Bt7 ramalan
## [1,] 19283.33 NA NA NA NA NA
## [2,] 19250.00 NA NA NA NA NA
## [3,] 19200.00 19244.44 NA NA NA NA
## [4,] 19200.00 19216.67 NA NA NA NA
## [5,] 19200.00 19200.00 19159.26 19179.63 -2.037037e+01 NA
## [6,] 19200.00 19200.00 19188.89 19194.44 -5.555556e+00 19159.26
## [7,] 19216.67 19205.56 19212.96 19209.26 3.703704e+00 19188.89
## [8,] 19233.33 19216.67 19235.19 19225.93 9.259259e+00 19212.96
## [9,] 19250.00 19233.33 19262.96 19248.15 1.481481e+01 19235.19
## [10,] 19200.00 19227.78 19231.48 19229.63 1.851852e+00 19262.96
## [11,] 19200.00 19216.67 19198.15 19207.41 -9.259259e+00 19231.48
## [12,] 19200.00 19200.00 19170.37 19185.19 -1.481481e+01 19198.15
## [13,] 19200.00 19200.00 19188.89 19194.44 -5.555556e+00 19170.37
## [14,] 19200.00 19200.00 19200.00 19200.00 0.000000e+00 19188.89
## [15,] 19200.00 19200.00 19200.00 19200.00 0.000000e+00 19200.00
## [16,] 19200.00 19200.00 19200.00 19200.00 0.000000e+00 19200.00
## [17,] 19200.00 19200.00 19200.00 19200.00 0.000000e+00 19200.00
## [18,] 19250.00 19216.67 19238.89 19227.78 1.111111e+01 19200.00
## [19,] 19200.00 19216.67 19227.78 19222.22 5.555556e+00 19238.89
## [20,] 19200.00 19216.67 19216.67 19216.67 -3.637979e-12 19227.78
## [21,] 19183.33 19194.44 19164.81 19179.63 -1.481481e+01 19216.67
## [22,] 19166.67 19183.33 19153.70 19168.52 -1.481481e+01 19164.81
## [23,] 19150.00 19166.67 19137.04 19151.85 -1.481481e+01 19153.70
## [24,] 19200.00 19172.22 19168.52 19170.37 -1.851852e+00 19137.04
## [25,] 19150.00 19166.67 19162.96 19164.81 -1.851852e+00 19168.52
## [26,] 19150.00 19166.67 19162.96 19164.81 -1.851852e+00 19162.96
## [27,] 19150.00 19150.00 19127.78 19138.89 -1.111111e+01 19162.96
## [28,] 19150.00 19150.00 19138.89 19144.44 -5.555556e+00 19127.78
## [29,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19138.89
## [30,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [31,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [32,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [33,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [34,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [35,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [36,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [37,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [38,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [39,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [40,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [41,] 19150.00 19150.00 19150.00 19150.00 0.000000e+00 19150.00
## [42,] 19133.33 19144.44 19137.04 19140.74 -3.703704e+00 19150.00
## [43,] 19116.67 19133.33 19114.81 19124.07 -9.259259e+00 19137.04
## [44,] 19100.00 19116.67 19087.04 19101.85 -1.481481e+01 19114.81
## [45,] 19100.00 19105.56 19079.63 19092.59 -1.296296e+01 19087.04
## [46,] 19100.00 19100.00 19085.19 19092.59 -7.407407e+00 19079.63
## [47,] 19200.00 19133.33 19174.07 19153.70 2.037037e+01 19085.19
## [48,] 19100.00 19133.33 19155.56 19144.44 1.111111e+01 19174.07
## [49,] 19100.00 19133.33 19133.33 19133.33 3.637979e-12 19155.56
## [50,] 19100.00 19100.00 19055.56 19077.78 -2.222222e+01 19133.33
## [51,] 19100.00 19100.00 19077.78 19088.89 -1.111111e+01 19055.56
## [52,] 19100.00 19100.00 19100.00 19100.00 0.000000e+00 19077.78
## [53,] 19100.00 19100.00 19100.00 19100.00 0.000000e+00 19100.00
## [54,] 19100.00 19100.00 19100.00 19100.00 0.000000e+00 19100.00
## [55,] 19100.00 19100.00 19100.00 19100.00 0.000000e+00 19100.00
## [56,] 19100.00 19100.00 19100.00 19100.00 0.000000e+00 19100.00
## [57,] 19100.00 19100.00 19100.00 19100.00 0.000000e+00 19100.00
## [58,] 19100.00 19100.00 19100.00 19100.00 0.000000e+00 19100.00
## [59,] 19100.00 19100.00 19100.00 19100.00 0.000000e+00 19100.00
## [60,] 19050.00 19083.33 19061.11 19072.22 -1.111111e+01 19100.00
## [61,] 19050.00 19066.67 19033.33 19050.00 -1.666667e+01 19061.11
## [62,] 19050.00 19050.00 19016.67 19033.33 -1.666667e+01 19033.33
## [63,] 19033.33 19044.44 19025.93 19035.19 -9.259259e+00 19016.67
## [64,] 19016.67 19033.33 19014.81 19024.07 -9.259259e+00 19025.93
## [65,] 19000.00 19016.67 18987.04 19001.85 -1.481481e+01 19014.81
## [66,] 19000.00 19005.56 18979.63 18992.59 -1.296296e+01 18987.04
## [67,] 18950.00 18983.33 18946.30 18964.81 -1.851852e+01 18979.63
## [68,] 19000.00 18983.33 18968.52 18975.93 -7.407407e+00 18946.30
## [69,] 19000.00 18983.33 18983.33 18983.33 3.637979e-12 18968.52
## [70,] 19000.00 19000.00 19022.22 19011.11 1.111111e+01 18983.33
## [71,] 19000.00 19000.00 19011.11 19005.56 5.555556e+00 19022.22
## [72,] 19000.00 19000.00 19000.00 19000.00 0.000000e+00 19011.11
## [73,] 19000.00 19000.00 19000.00 19000.00 0.000000e+00 19000.00
## [74,] 19000.00 19000.00 19000.00 19000.00 0.000000e+00 19000.00
## [75,] 19000.00 19000.00 19000.00 19000.00 0.000000e+00 19000.00
## [76,] 18950.00 18983.33 18961.11 18972.22 -1.111111e+01 19000.00
## [77,] 18966.67 18972.22 18946.30 18959.26 -1.296296e+01 18961.11
## [78,] 18983.33 18966.67 18951.85 18959.26 -7.407407e+00 18946.30
## [79,] 19000.00 18983.33 19001.85 18992.59 9.259259e+00 18951.85
## [80,] 19000.00 18994.44 19020.37 19007.41 1.296296e+01 19001.85
## [81,] NA NA NA NA NA 19020.37
## [82,] NA NA NA NA NA 19033.33
## [83,] NA NA NA NA NA 19046.30
## [84,] NA NA NA NA NA 19059.26
## [85,] NA NA NA NA NA 19072.22
## [86,] NA NA NA NA NA 19085.19
## [87,] NA NA NA NA NA 19098.15
## [88,] NA NA NA NA NA 19111.11
## [89,] NA NA NA NA NA 19124.07
## [90,] NA NA NA NA NA 19137.04
## [91,] NA NA NA NA NA 19150.00
## [92,] NA NA NA NA NA 19162.96
## [93,] NA NA NA NA NA 19175.93
## [94,] NA NA NA NA NA 19188.89
## [95,] NA NA NA NA NA 19201.85
## [96,] NA NA NA NA NA 19214.81
## [97,] NA NA NA NA NA 19227.78
## [98,] NA NA NA NA NA 19240.74
## [99,] NA NA NA NA NA 19253.70
## [100,] NA NA NA NA NA 19266.67
## [101,] NA NA NA NA NA 19279.63
## [102,] NA NA NA NA NA 19292.59
## [103,] NA NA NA NA NA 19305.56
## [104,] NA NA NA NA NA 19318.52
Hasil pemulusan menggunakan metode DMA divisualisasikan sebagai berikut
ts.plot(data7.ts, xlab="period ", ylab="Minyak Goreng", main= "DMA N=3 Data Minyak Goreng")
points(data7.ts)
lines(data.gab22[,3],col="green",lwd=2)
lines(data.gab22[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.8)
Selanjutnya perhitungan akurasi dilakukan baik pada data latih maupun
data uji. Perhitungan akurasi dilakukan dengan ukuran akurasi SSE, MSE
dan MAPE.
#Menghitung nilai keakuratan data latih
error_train7.dma = train_ma7.ts-data.ramal22[1:length(train_ma7.ts)]
SSE_train7.dma = sum(error_train7.dma[6:length(train_ma7.ts)]^2)
MSE_train7.dma = mean(error_train7.dma[6:length(train_ma7.ts)]^2)
MAPE_train7.dma = mean(abs((error_train7.dma[6:length(train_ma7.ts)]/train_ma7.ts[6:length(train_ma7.ts)])*100))
akurasi_train7.dma <- matrix(c(SSE_train7.dma, MSE_train7.dma, MAPE_train7.dma))
row.names(akurasi_train7.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train7.dma) <- c("Akurasi m = 3")
akurasi_train7.dma
## Akurasi m = 3
## SSE 6.255487e+04
## MSE 8.340649e+02
## MAPE 9.804201e-02
Perhitungan akurasi pada data latih menggunakan nilai MAPE menghasilkan nilai MAPE yang kurang dari 10% sehingga dikategorikan sangat baik. Sehingga untuk saat ini, data latih lebih baik untuk metode DMA dibandingkan SMA. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.
#Menghitung nilai keakuratan data uji
error_test7.dma = test_ma7.ts-data.gab22[81:100,6]
SSE_test7.dma = sum(error_test7.dma^2)
MSE_test7.dma = mean(error_test7.dma^2)
MAPE_test7.dma = mean(abs((error_test7.dma/test_ma7.ts*100)))
akurasi_test7.dma <- matrix(c(SSE_test7.dma, MSE_test7.dma, MAPE_test7.dma))
row.names(akurasi_test7.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test7.dma) <- c("Akurasi m = 3")
akurasi_test7.dma
## Akurasi m = 3
## SSE 1.330826e+06
## MSE 6.654132e+04
## MAPE 1.196635e+00
Perhitungan akurasi menggunakan data uji menghasilkan nilai MAPE yang lebih dari 10% sehingga nilai akurasi ini dapat dikategorikan sebagai baik.
Pada data latih, metode SMA lebih baik dibandingkan dengan metode DMA, sedangkan pada data uji, metode DMA lebih baik dibandingkan SMA
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. Ada dua macam model, yaitu model tunggal dan ganda.
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
#membagi training dan testing
training7<-data7[1:80,]
testing7<-data7[81:100,]
train7.ts <- ts(training7$`harga`)
test7.ts <- ts(testing7$`harga`)
Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.
plot(data7.ts, col="black",main="Plot semua data")
points(data7.ts)
plot(train7.ts, col="red",main="Plot data latih")
points(train7.ts)
plot(test7.ts, col="blue",main="Plot data uji")
points(test7.ts)
### SES
Single Exponential Smoothing merupakan metode pemulusan yang tepat digunakan untuk data dengan pola stasioner atau konstan.
Nilai pemulusan pada periode ke-t didapat dari persamaan:
\[ \tilde{y}_T=\lambda y_t+(1-\lambda)\tilde{y}_{T-1} \]
Nilai parameter \(\lambda\) adalah nilai antara 0 dan 1.
Nilai pemulusan periode ke-t bertindak sebagai nilai ramalan pada periode ke-\((T+\tau)\).
\[ \tilde{y}_{T+\tau}(T)=\tilde{y}_T \]
Pemulusan dengan metode SES dapat dilakukan dengan dua fungsi dari
packages berbeda, yaitu (1) fungsi ses() dari
packages forecast dan (2) fungsi
HoltWinters dari packages stats .
#Cara 1 (fungsi ses)
ses1.1 <- ses(train7.ts, h = 20, alpha = 0.2)
plot(ses1.1)
ses1.1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 18991.44 18954.72 19028.15 18935.28 19047.59
## 82 18991.44 18953.99 19028.88 18934.17 19048.70
## 83 18991.44 18953.28 19029.59 18933.08 19049.79
## 84 18991.44 18952.58 19030.29 18932.01 19050.86
## 85 18991.44 18951.89 19030.98 18930.96 19051.91
## 86 18991.44 18951.22 19031.66 18929.93 19052.95
## 87 18991.44 18950.55 19032.32 18928.91 19053.97
## 88 18991.44 18949.90 19032.98 18927.91 19054.97
## 89 18991.44 18949.25 19033.62 18926.92 19055.95
## 90 18991.44 18948.62 19034.25 18925.95 19056.92
## 91 18991.44 18947.99 19034.88 18925.00 19057.88
## 92 18991.44 18947.38 19035.50 18924.05 19058.82
## 93 18991.44 18946.77 19036.10 18923.12 19059.75
## 94 18991.44 18946.17 19036.70 18922.21 19060.67
## 95 18991.44 18945.58 19037.29 18921.30 19061.57
## 96 18991.44 18944.99 19037.88 18920.41 19062.46
## 97 18991.44 18944.42 19038.46 18919.53 19063.35
## 98 18991.44 18943.85 19039.03 18918.66 19064.22
## 99 18991.44 18943.28 19039.59 18917.79 19065.08
## 100 18991.44 18942.73 19040.15 18916.94 19065.93
ses2.2<- ses(train7.ts, h = 20, alpha = 0.7)
plot(ses2.2)
ses2.2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 18998.04 18967.29 19028.78 18951.02 19045.05
## 82 18998.04 18960.51 19035.56 18940.65 19055.43
## 83 18998.04 18954.78 19041.29 18931.88 19064.19
## 84 18998.04 18949.72 19046.35 18924.14 19071.93
## 85 18998.04 18945.15 19050.93 18917.15 19078.93
## 86 18998.04 18940.94 19055.14 18910.71 19085.36
## 87 18998.04 18937.02 19059.06 18904.71 19091.36
## 88 18998.04 18933.33 19062.74 18899.08 19096.99
## 89 18998.04 18929.85 19066.23 18893.75 19102.32
## 90 18998.04 18926.53 19069.54 18888.68 19107.39
## 91 18998.04 18923.36 19072.71 18883.83 19112.24
## 92 18998.04 18920.33 19075.75 18879.19 19116.89
## 93 18998.04 18917.40 19078.67 18874.71 19121.36
## 94 18998.04 18914.58 19081.49 18870.40 19125.67
## 95 18998.04 18911.85 19084.22 18866.22 19129.85
## 96 18998.04 18909.20 19086.87 18862.18 19133.90
## 97 18998.04 18906.63 19089.44 18858.25 19137.83
## 98 18998.04 18904.13 19091.94 18854.43 19141.65
## 99 18998.04 18901.70 19094.37 18850.70 19145.37
## 100 18998.04 18899.33 19096.75 18847.07 19149.00
Untuk mendapatkan gambar hasil pemulusan pada data latih dengan
fungsi ses() , perlu digunakan fungsi
autoplot() dan autolayer() dari library
packages ggplot2 .
autoplot(ses1.1) +
autolayer(fitted(ses1.1), series="Fitted") +
ylab("Minyak Goreng") + xlab("Periode")
Pada fungsi
ses() , terdapat beberapa argumen yang umum
digunakan, yaitu nilia y , gamma ,
beta , alpha , dan h .
Nilai y adalah nilai data deret waktu,
gamma adalah parameter pemulusan untuk komponen musiman,
beta adalah parameter pemulusan untuk tren, dan
alpha adalah parameter pemulusan untuk stasioner, serta
h adalah banyaknya periode yang akan diramalkan.
Kasus di atas merupakan contoh inisialisasi nilai parameter \(\lambda\) dengan nilai alpha
0,2 dan 0,7 dan banyak periode data yang akan diramalkan adalah sebanyak
10 periode. Selanjutnya akan digunakan fungsi HoltWinters()
dengan nilai inisialisasi parameter dan panjang periode peramalan yang
sama dengan fungsi ses() .
ses11<- HoltWinters(train7.ts, gamma = FALSE, beta = FALSE, alpha = 0.2)
plot(ses11)
#ramalan
ramalan11<- forecast(ses11, h=20)
ramalan11
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 18991.44 18960.51 19022.37 18944.13 19038.74
## 82 18991.44 18959.89 19022.98 18943.20 19039.68
## 83 18991.44 18959.29 19023.58 18942.28 19040.60
## 84 18991.44 18958.70 19024.17 18941.38 19041.50
## 85 18991.44 18958.12 19024.75 18940.49 19042.38
## 86 18991.44 18957.56 19025.32 18939.62 19043.25
## 87 18991.44 18957.00 19025.88 18938.76 19044.11
## 88 18991.44 18956.44 19026.43 18937.92 19044.95
## 89 18991.44 18955.90 19026.97 18937.09 19045.78
## 90 18991.44 18955.37 19027.51 18936.27 19046.60
## 91 18991.44 18954.84 19028.03 18935.47 19047.41
## 92 18991.44 18954.32 19028.55 18934.67 19048.20
## 93 18991.44 18953.81 19029.06 18933.89 19048.98
## 94 18991.44 18953.30 19029.57 18933.12 19049.76
## 95 18991.44 18952.81 19030.07 18932.36 19050.52
## 96 18991.44 18952.31 19030.56 18931.60 19051.27
## 97 18991.44 18951.83 19031.05 18930.86 19052.01
## 98 18991.44 18951.35 19031.53 18930.13 19052.75
## 99 18991.44 18950.87 19032.00 18929.40 19053.47
## 100 18991.44 18950.40 19032.47 18928.68 19054.19
ses22<- HoltWinters(train7.ts, gamma = FALSE, beta = FALSE, alpha = 0.7)
plot(ses22)
#ramalan
ramalan22<- forecast(ses22, h=20)
ramalan22
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 18998.04 18967.94 19028.13 18952.01 19044.06
## 82 18998.04 18961.30 19034.77 18941.86 19054.22
## 83 18998.04 18955.69 19040.38 18933.27 19062.80
## 84 18998.04 18950.74 19045.33 18925.70 19070.37
## 85 18998.04 18946.26 19049.81 18918.85 19077.22
## 86 18998.04 18942.14 19053.93 18912.55 19083.52
## 87 18998.04 18938.30 19057.77 18906.68 19089.39
## 88 18998.04 18934.70 19061.38 18901.16 19094.91
## 89 18998.04 18931.28 19064.79 18895.95 19100.13
## 90 18998.04 18928.04 19068.03 18890.98 19105.09
## 91 18998.04 18924.94 19071.14 18886.24 19109.83
## 92 18998.04 18921.96 19074.11 18881.69 19114.38
## 93 18998.04 18919.10 19076.97 18877.31 19118.76
## 94 18998.04 18916.34 19079.74 18873.09 19122.98
## 95 18998.04 18913.67 19082.41 18869.00 19127.07
## 96 18998.04 18911.08 19085.00 18865.04 19131.03
## 97 18998.04 18908.56 19087.51 18861.19 19134.88
## 98 18998.04 18906.11 19089.96 18857.45 19138.62
## 99 18998.04 18903.73 19092.34 18853.81 19142.26
## 100 18998.04 18901.41 19094.67 18850.25 19145.82
Fungsi HoltWinters memiliki argumen yang sama dengan
fungsi ses() . Argumen-argumen kedua fungsi dapat dilihat
lebih lanjut dengan ?ses() atau ?HoltWinters
.
Nilai parameter \(\alpha\) dari
kedua fungsi dapat dioptimalkan menyesuaikan dari error-nya
paling minimumnya. Caranya adalah dengan membuat parameter \(\alpha =\) NULL .
#SES
ses1.opt <- ses(train7.ts, h = 20, alpha = NULL)
plot(ses1.opt)
ses1.opt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 18996.66 18966.01 19027.31 18949.79 19043.54
## 82 18996.66 18960.66 19032.67 18941.60 19051.72
## 83 18996.66 18956.00 19037.32 18934.48 19058.84
## 84 18996.66 18951.83 19041.50 18928.09 19065.23
## 85 18996.66 18948.01 19045.31 18922.25 19071.07
## 86 18996.66 18944.47 19048.85 18916.84 19076.48
## 87 18996.66 18941.16 19052.17 18911.77 19081.55
## 88 18996.66 18938.03 19055.29 18906.99 19086.33
## 89 18996.66 18935.06 19058.26 18902.45 19090.87
## 90 18996.66 18932.23 19061.09 18898.12 19095.20
## 91 18996.66 18929.52 19063.81 18893.97 19099.35
## 92 18996.66 18926.91 19066.41 18889.98 19103.34
## 93 18996.66 18924.40 19068.93 18886.14 19107.18
## 94 18996.66 18921.97 19071.36 18882.43 19110.90
## 95 18996.66 18919.61 19073.71 18878.83 19114.49
## 96 18996.66 18917.33 19075.99 18875.34 19117.98
## 97 18996.66 18915.11 19078.21 18871.94 19121.38
## 98 18996.66 18912.95 19080.37 18868.64 19124.68
## 99 18996.66 18910.85 19082.47 18865.42 19127.90
## 100 18996.66 18908.79 19084.53 18862.28 19131.04
#Lamda Optimum Holt Winter
sesopt1<- HoltWinters(train7.ts, gamma = FALSE, beta = FALSE,alpha = NULL)
sesopt1
## Holt-Winters exponential smoothing without trend and without seasonal component.
##
## Call:
## HoltWinters(x = train7.ts, alpha = NULL, beta = FALSE, gamma = FALSE)
##
## Smoothing parameters:
## alpha: 0.6540969
## beta : FALSE
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 18997.33
plot(sesopt1)
#ramalan
ramalanopt1<- forecast(sesopt1, h=20)
ramalanopt1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 18997.33 18967.38 19027.27 18951.52 19043.13
## 82 18997.33 18961.54 19033.11 18942.59 19052.06
## 83 18997.33 18956.53 19038.12 18934.93 19059.72
## 84 18997.33 18952.07 19042.58 18928.11 19066.54
## 85 18997.33 18948.01 19046.64 18921.91 19072.74
## 86 18997.33 18944.26 19050.39 18916.17 19078.48
## 87 18997.33 18940.76 19053.89 18910.82 19083.83
## 88 18997.33 18937.47 19057.18 18905.78 19088.87
## 89 18997.33 18934.34 19060.31 18901.00 19093.65
## 90 18997.33 18931.37 19063.28 18896.45 19098.20
## 91 18997.33 18928.52 19066.13 18892.09 19102.56
## 92 18997.33 18925.78 19068.87 18887.91 19106.74
## 93 18997.33 18923.15 19071.50 18883.89 19110.76
## 94 18997.33 18920.61 19074.04 18880.00 19114.65
## 95 18997.33 18918.15 19076.50 18876.23 19118.42
## 96 18997.33 18915.76 19078.89 18872.58 19122.07
## 97 18997.33 18913.44 19081.21 18869.03 19125.62
## 98 18997.33 18911.18 19083.47 18865.58 19129.07
## 99 18997.33 18908.98 19085.67 18862.22 19132.43
## 100 18997.33 18906.84 19087.81 18858.94 19135.71
Setelah dilakukan peramalan, akan dilakukan perhitungan keakuratan hasil peramalan. Perhitungan akurasi ini dilakukan baik pada data latih dan data uji.
Perhitungan akurasi data dapat dilakukan dengan cara langsung maupun manual. Secara langsung, nilai akurasi dapat diambil dari objek yang tersimpan pada hasil SES, yaitu sum of squared errors (SSE). Nilai akurasi lain dapat dihitung pula dari nilai SSE tersebut.
#Keakuratan Metode
#Pada data training
SSE11<-ses11$SSE
MSE11<-ses11$SSE/length(train7.ts)
RMSE11<-sqrt(MSE11)
akurasi11 <- matrix(c(SSE11,MSE11,RMSE11))
row.names(akurasi11)<- c("SSE", "MSE", "RMSE")
colnames(akurasi11) <- c("Akurasi lamda=0.2")
akurasi11
## Akurasi lamda=0.2
## SSE 72395.98752
## MSE 904.94984
## RMSE 30.08238
SSE22<-ses22$SSE
MSE22<-ses22$SSE/length(train7.ts)
RMSE22<-sqrt(MSE22)
akurasi22 <- matrix(c(SSE22,MSE22,RMSE22))
row.names(akurasi22)<- c("SSE", "MSE", "RMSE")
colnames(akurasi22) <- c("Akurasi lamda=0.7")
akurasi22
## Akurasi lamda=0.7
## SSE 45114.49502
## MSE 563.93119
## RMSE 23.74724
#Cara Manual
fitted11<-ramalan11$fitted
sisaan11<-ramalan11$residuals
head(sisaan11)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA -33.33333 -76.66667 -61.33333 -49.06667 -39.25333
resid11<-training7$`harga`-ramalan11$fitted
head(resid11)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA -33.33333 -76.66667 -61.33333 -49.06667 -39.25333
#Cara Manual
SSE1.1=sum(sisaan11[2:length(train7.ts)]^2)
SSE1.1
## [1] 72395.99
MSE1.1 = SSE1.1/length(train7.ts)
MSE1.1
## [1] 904.9498
MAPE1.1 = sum(abs(sisaan11[2:length(train7.ts)]/train7.ts[2:length(train7.ts)])*
100)/length(train7.ts)
MAPE1.1
## [1] 0.1197178
akurasi1.1 <- matrix(c(SSE1.1,MSE1.1,MAPE1.1))
row.names(akurasi1.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasi1.1) <- c("Akurasi lamda=0.2")
akurasi1.1
## Akurasi lamda=0.2
## SSE 7.239599e+04
## MSE 9.049498e+02
## MAPE 1.197178e-01
fitted22<-ramalan22$fitted
sisaan22<-ramalan22$residuals
head(sisaan22)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA -33.33333 -60.00000 -18.00000 -5.40000 -1.62000
resid22<-training7$`harga`-ramalan22$fitted
head(resid22)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA -33.33333 -60.00000 -18.00000 -5.40000 -1.62000
SSE2.2=sum(sisaan22[2:length(train7.ts)]^2)
SSE2.2
## [1] 45114.5
MSE2.2 = SSE2.2/length(train7.ts)
MSE2.2
## [1] 563.9312
MAPE2.2 = sum(abs(sisaan22[2:length(train7.ts)]/train7.ts[2:length(train7.ts)])*
100)/length(train7.ts)
MAPE2.2
## [1] 0.07232211
akurasi2.2 <- matrix(c(SSE2.2,MSE2.2,MAPE2.2))
row.names(akurasi2.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasi2.2) <- c("Akurasi lamda=0.7")
akurasi2.2
## Akurasi lamda=0.7
## SSE 4.511450e+04
## MSE 5.639312e+02
## MAPE 7.232211e-02
Berdasarkan nilai SSE, MSE, RMSE, dan MAPE di antara kedua parameter, nilai parameter \(\lambda=0,2\) menghasilkan akurasi yang lebih baik dibanding \(\lambda=0,7\) . Hal ini dilihat dari nilai masing-masing ukuran akurasi yang lebih kecil. Berdasarkan nilai MAPE-nya, hasil ini dapat dikategorikan sebagai peramalan sangat baik.
Akurasi data uji dapat dihitung dengan cara yang hampir sama dengan perhitungan akurasi data latih.
selisih11<-ramalan11$mean-testing7$`harga`
SSEtesting11<-sum(selisih11^2)
MSEtesting11<-SSEtesting11/length(testing7)
selisih22<-ramalan22$mean-testing7$`harga`
SSEtesting22<-sum(selisih22^2)
MSEtesting22<-SSEtesting22/length(testing7)
selisihopt1<-ramalanopt1$mean-testing7$`harga`
SSEtestingopt1<-sum(selisihopt1^2)
MSEtestingopt1<-SSEtestingopt1/length(testing7)
akurasitesting11 <- matrix(c(SSEtesting11,SSEtesting22,SSEtestingopt1))
row.names(akurasitesting11)<- c("SSE1", "SSE2", "SSEopt")
akurasitesting11
## [,1]
## SSE1 179041.3
## SSE2 199430.9
## SSEopt 197149.1
akurasitesting22 <- matrix(c(MSEtesting11,MSEtesting22,MSEtestingopt1))
row.names(akurasitesting22)<- c("MSE1", "MSE2", "MSEopt")
akurasitesting22
## [,1]
## MSE1 89520.66
## MSE2 99715.44
## MSEopt 98574.53
Selain dengan cara di atas, perhitungan nilai akurasi dapat
menggunakan fungsi accuracy() dari package
forecast . Penggunaannya yaitu dengan menuliskan
accuracy(hasil ramalan, kondisi aktual) . Contohnya adalah
sebagai berikut.
#cara lain
accuracy(ramalanopt1,testing7$`harga`)
## ME RMSE MAE MPE MAPE MASE
## Training set -5.534896 23.8712 14.33419 -0.02902274 0.0749538 1.151594
## Test set -79.825033 99.2847 80.89502 -0.42294213 0.4285736 6.499024
## ACF1
## Training set -0.05019725
## Test set NA
Metode pemulusan Double Exponential Smoothing (DES) digunakan untuk data yang memiliki pola tren. Metode DES adalah metode semacam SES, hanya saja dilakukan dua kali, yaitu pertama untuk tahapan ‘level’ dan kedua untuk tahapan ‘tren’. Pemulusan menggunakan metode ini akan menghasilkan peramalan tidak konstan untuk periode berikutnya.
Pemulusan dengan metode DES kali ini akan menggunakan fungsi
HoltWinters() . Jika sebelumnya nilai argumen
beta dibuat FALSE , kali ini argumen tersebut
akan diinisialisasi bersamaan dengan nilai alpha .
#Lamda=0.2 dan gamma=0.2
des1.1<- HoltWinters(train7.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)
plot(des1.1)
#ramalan
ramalandes11<- forecast(des1.1, h=20)
ramalandes11
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 18976.14 18927.20 19025.08 18901.29 19050.99
## 82 18976.15 18925.82 19026.49 18899.18 19053.13
## 83 18976.16 18924.00 19028.33 18896.39 19055.94
## 84 18976.18 18921.71 19030.64 18892.88 19059.47
## 85 18976.19 18918.94 19033.43 18888.64 19063.73
## 86 18976.20 18915.70 19036.69 18883.67 19068.72
## 87 18976.21 18911.99 19040.42 18878.00 19074.42
## 88 18976.22 18907.84 19044.60 18871.64 19080.79
## 89 18976.23 18903.27 19049.19 18864.65 19087.81
## 90 18976.24 18898.30 19054.18 18857.04 19095.44
## 91 18976.25 18892.96 19059.54 18848.88 19103.63
## 92 18976.26 18887.28 19065.24 18840.18 19112.35
## 93 18976.27 18881.27 19071.27 18830.98 19121.56
## 94 18976.28 18874.96 19077.61 18821.32 19131.25
## 95 18976.29 18868.36 19084.23 18811.22 19141.37
## 96 18976.30 18861.49 19091.12 18800.70 19151.90
## 97 18976.32 18854.36 19098.27 18789.80 19162.83
## 98 18976.33 18846.99 19105.66 18778.52 19174.13
## 99 18976.34 18839.39 19113.29 18766.89 19185.79
## 100 18976.35 18831.56 19121.13 18754.92 19197.78
#Lamda=0.6 dan gamma=0.3
des2.2<- HoltWinters(train7.ts, gamma = FALSE, beta = 0.3, alpha = 0.6)
plot(des2.2)
#ramalan
ramalandes22<- forecast(des2.2, h=20)
ramalandes22
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 19000.31 18966.73 19033.90 18948.95 19051.68
## 82 19004.48 18961.89 19047.08 18939.34 19069.63
## 83 19008.65 18955.23 19062.08 18926.95 19090.36
## 84 19012.82 18947.10 19078.55 18912.30 19113.34
## 85 19016.99 18937.71 19096.28 18895.74 19138.25
## 86 19021.17 18927.23 19115.10 18877.50 19164.83
## 87 19025.34 18915.76 19134.92 18857.75 19192.92
## 88 19029.51 18903.37 19155.64 18836.60 19222.41
## 89 19033.68 18890.13 19177.22 18814.15 19253.21
## 90 19037.85 18876.09 19199.60 18790.47 19285.23
## 91 19042.02 18861.29 19222.74 18765.62 19318.42
## 92 19046.19 18845.76 19246.62 18739.66 19352.71
## 93 19050.36 18829.53 19271.19 18712.64 19388.08
## 94 19054.53 18812.63 19296.43 18684.58 19424.48
## 95 19058.70 18795.08 19322.32 18655.53 19461.87
## 96 19062.87 18776.90 19348.84 18625.51 19500.23
## 97 19067.04 18758.11 19375.98 18594.57 19539.52
## 98 19071.21 18738.72 19403.71 18562.71 19579.72
## 99 19075.38 18718.75 19432.02 18529.96 19620.80
## 100 19079.55 18698.22 19460.89 18496.35 19662.76
#Visually evaluate the prediction
plot(data7.ts)
lines(des1.1$fitted[,1], lty=2, col="blue")
lines(ramalandes11$mean, col="red")
Untuk mendapatkan nilai parameter optimum dari DES, argumen alpha dan
beta dapat dibuat NULL seperti berikut.
#Lamda dan gamma optimum
des1.opt<- HoltWinters(train7.ts, gamma = FALSE)
des1.opt
## Holt-Winters exponential smoothing with trend and without seasonal component.
##
## Call:
## HoltWinters(x = train7.ts, gamma = FALSE)
##
## Smoothing parameters:
## alpha: 0.7002168
## beta : 0.1873243
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 18997.845156
## b 1.829717
plot(des1.opt)
#ramalan
ramalandesopt1<- forecast(des1.opt, h=20)
ramalandesopt1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 81 18999.67 18966.54 19032.81 18949.00 19050.35
## 82 19001.50 18958.41 19044.59 18935.60 19067.41
## 83 19003.33 18949.72 19056.94 18921.35 19085.32
## 84 19005.16 18940.45 19069.87 18906.20 19104.13
## 85 19006.99 18930.61 19083.38 18890.17 19123.81
## 86 19008.82 18920.20 19097.44 18873.29 19144.36
## 87 19010.65 18909.25 19112.05 18855.58 19165.73
## 88 19012.48 18897.78 19127.19 18837.06 19187.91
## 89 19014.31 18885.79 19142.84 18817.75 19210.87
## 90 19016.14 18873.31 19158.98 18797.70 19234.59
## 91 19017.97 18860.35 19175.60 18776.91 19259.04
## 92 19019.80 18846.92 19192.68 18755.40 19284.20
## 93 19021.63 18833.04 19210.22 18733.21 19310.06
## 94 19023.46 18818.72 19228.20 18710.34 19336.59
## 95 19025.29 18803.97 19246.61 18686.81 19363.77
## 96 19027.12 18788.80 19265.44 18662.64 19391.60
## 97 19028.95 18773.22 19284.68 18637.85 19420.05
## 98 19030.78 18757.24 19304.32 18612.44 19449.12
## 99 19032.61 18740.87 19324.35 18586.43 19478.79
## 100 19034.44 18724.12 19344.76 18559.84 19509.04
Selanjutnya akan dilakukan perhitungan akurasi pada data latih maupun data uji dengan ukuran akurasi SSE, MSE dan MAPE. Akurasi Data Latih
#Akurasi Data Training
ssedes1.train7<-des1.1$SSE
msedes1.train7<-ssedes1.train7/length(train7.ts)
sisaandes11<-ramalandes11$residuals
head(sisaandes11)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA -16.66667 20.66667 49.70667 70.95040
mapedes1.train1 <- sum(abs(sisaandes11[3:length(train7.ts)]/train7.ts[3:length(train7.ts)])
*100)/length(train7.ts)
akurasides1.1 <- matrix(c(ssedes1.train7,msedes1.train7,mapedes1.train1))
row.names(akurasides1.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasides1.1) <- c("Akurasi lamda=0.2 dan gamma=0.2")
akurasides1.1
## Akurasi lamda=0.2 dan gamma=0.2
## SSE 1.212052e+05
## MSE 1.515064e+03
## MAPE 1.489909e-01
ssedes2.train2<-des2.2$SSE
msedes2.train2<-ssedes2.train2/length(train7.ts)
sisaandes22<-ramalandes22$residuals
head(sisaandes22)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA -16.66667 29.66667 42.86000 40.42253
mapedes2.train2 <- sum(abs(sisaandes22[3:length(train7.ts)]/train7.ts[3:length(train7.ts)])
*100)/length(train7.ts)
akurasides2.2 <- matrix(c(ssedes2.train2,msedes2.train2,mapedes2.train2))
row.names(akurasides2.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasides2.2) <- c("Akurasi lamda=0.6 dan gamma=0.3")
akurasides2.2
## Akurasi lamda=0.6 dan gamma=0.3
## SSE 5.344394e+04
## MSE 6.680492e+02
## MAPE 8.525539e-02
Hasil akurasi dari data latih didapatkan skenario 2 dengan lamda=0.6 dan gamma=0.3 memiliki hasil yang lebih baik. Namun untuk kedua skenario dapat dikategorikan peramalan sangat baik berdasarkan nilai MAPE-nya.
Akurasi Data Uji
#Akurasi Data Testing
selisihdes11<-ramalandes11$mean-testing7$`harga`
selisihdes11
## Time Series:
## Start = 81
## End = 100
## Frequency = 1
## [1] -23.856543 -23.845786 -23.835028 -7.157604 9.519820 26.197244
## [7] 26.208002 76.218759 -23.770484 176.240274 142.917698 109.595122
## [13] 76.272546 76.283304 76.294061 76.304818 76.315576 92.993000
## [19] 109.670424 126.347848
SSEtestingdes11<-sum(selisihdes11^2)
MSEtestingdes11<-SSEtestingdes11/length(testing7$`harga`)
MAPEtestingdes11<-sum(abs(selisihdes11/testing7$`harga`)*100)/length(testing7$`harga`)
selisihdes22<-ramalandes22$mean-testing7$`harga`
selisihdes22
## Time Series:
## Start = 81
## End = 100
## Frequency = 1
## [1] 0.3124743 4.4830736 8.6536729 29.4909389 50.3282048 71.1654708
## [7] 75.3360701 129.5066694 33.6772686 237.8478679 208.6851339 179.5223998
## [13] 150.3596658 154.5302651 158.7008644 162.8714637 167.0420630 187.8793289
## [19] 208.7165949 229.5538608
SSEtestingdes22<-sum(selisihdes22^2)
MSEtestingdes22<-SSEtestingdes22/length(testing7$`harga`)
MAPEtestingdes22<-sum(abs(selisihdes22/testing7$`harga`)*100)/length(testing7$`harga`)
selisihdesopt1<-ramalandesopt1$mean-testing7$`harga`
selisihdesopt1
## Time Series:
## Start = 81
## End = 100
## Frequency = 1
## [1] -0.3251268 1.5045903 3.3343074 21.8306911 40.3270748 58.8234586
## [7] 60.6531756 112.4828927 14.3126097 216.1423268 184.6387105 153.1350942
## [13] 121.6314780 123.4611950 125.2909121 127.1206292 128.9503462 147.4467299
## [19] 165.9431137 184.4394974
SSEtestingdesopt1<-sum(selisihdesopt1^2)
MSEtestingdesopt1<-SSEtestingdesopt1/length(testing7$`harga`)
MAPEtestingdesopt1<-sum(abs(selisihdesopt1/testing7$`harga`)*100)/length(testing7$`harga`)
akurasitestingdes1 <-
matrix(c(SSEtestingdes11,MSEtestingdes11,MAPEtestingdes11,SSEtestingdes22,MSEtestingdes22,
MAPEtestingdes22,SSEtestingdesopt1,MSEtestingdesopt1,MAPEtestingdesopt1),
nrow=3,ncol=3)
row.names(akurasitestingdes1)<- c("SSE", "MSE", "MAPE")
colnames(akurasitestingdes1) <- c("des ske1","des ske2","des opt")
akurasitestingdes1
## des ske1 des ske2 des opt
## SSE 1.388354e+05 4.221533e+05 2.881900e+05
## MSE 6.941770e+03 2.110766e+04 1.440950e+04
## MAPE 3.654463e-01 6.484621e-01 5.275463e-01
Perbandingan SES dan DES
MSEfull1 <-
matrix(c(MSEtesting11,MSEtesting22,MSEtestingopt1,MSEtestingdes11,MSEtestingdes22,
MSEtestingdesopt1),nrow=3,ncol=2)
row.names(MSEfull1)<- c("ske 1", "ske 2", "ske opt")
colnames(MSEfull1) <- c("ses","des")
MSEfull1
## ses des
## ske 1 89520.66 6941.77
## ske 2 99715.44 21107.66
## ske opt 98574.53 14409.50
Kedua metode dapat dibandingkan dengan menggunakan ukuran akurasi yang sama. Contoh di atas adalah perbandingan kedua metode dengan ukuran akurasi MSE. Hasilnya didapatkan metode DES lebih baik dibandingkan metode SES dilihat dari MSE yang lebih kecil nilainya.
Pertama impor kembali data baru untuk latihan data musiman.
#membagi data menjadi training dan testing
training11<-data7[1:80,1]
testing11<-data7[81:100,1]
training11.ts<-ts(training11, frequency = 13)
testing11.ts<-ts(testing11, frequency = 13)
#Membuat plot time series
plot(data7.ts, col="red",main="Plot semua data")
points(data7.ts)
plot(training11.ts, col="blue",main="Plot data latih")
points(training11.ts)
plot(testing11.ts, col="green",main="Plot data uji")
points(testing11.ts)
Pemulusan data musiman dengan metode Winter dilakukan menggunakan
fungsi HoltWinters() dengan memasukkan argumen tambahan,
yaitu gamma() dan seasonal() . Arguman
seasonal() diinisialisasi menyesuaikan jenis musiman,
aditif atau multiplikatif.
Perhitungan dengan model aditif dilakukan jika plot data asli menunjukkan fluktuasi musiman yang relatif stabil (konstan).
#Pemulusan dengan winter aditif
winter11 <- HoltWinters(training11.ts,alpha=0.2,beta=0.1,gamma=0.1,seasonal = "additive")
winter11$fitted
## Time Series:
## Start = c(2, 1)
## End = c(7, 2)
## Frequency = 13
## xhat level trend season
## 2.000000 107.0000 106.0000 1.0000000 6.558856e-15
## 2.076923 109.5400 108.4000 1.1400000 6.558856e-15
## 2.153846 111.8812 110.6320 1.2492000 -7.651999e-15
## 2.230769 114.0365 112.7050 1.3315760 6.558856e-15
## 2.307692 116.0201 114.6292 1.3908453 -7.651999e-15
## 2.384615 117.8465 116.4161 1.4304438 -7.651999e-15
## 2.461538 119.5307 118.0772 1.4535137 6.558856e-15
## 2.538462 121.0875 119.6246 1.4628994 6.558856e-15
## 2.615385 122.5311 121.0700 1.4611500 -7.651999e-15
## 2.692308 123.8754 122.4249 1.4505274 -7.651999e-15
## 2.769231 125.1334 123.7003 1.4330188 -7.651999e-15
## 2.846154 126.3170 124.9067 1.4103516 6.558856e-15
## 2.923077 127.4376 126.0536 1.3840107 6.558856e-15
## 3.000000 129.0654 127.1501 1.3552579 5.600000e-01
## 3.076923 129.8430 128.0923 1.3139504 4.368000e-01
## 3.153846 130.6442 129.0376 1.2770894 3.295040e-01
## 3.230769 131.4672 129.9859 1.2442048 2.370771e-01
## 3.307692 132.3099 130.9367 1.2148615 1.583941e-01
## 3.384615 133.1705 131.8895 1.1886633 9.227976e-02
## 3.461538 134.0469 132.8441 1.1652538 3.754271e-02
## 3.538462 134.9373 133.8000 1.1443158 -6.997789e-03
## 3.615385 135.8399 134.7568 1.1255699 -4.249023e-02
## 3.692308 136.7532 135.7144 1.1087717 -7.003438e-02
## 3.769231 137.6756 136.6726 1.0937085 -9.066901e-02
## 3.846154 138.6060 137.6311 1.0801965 -1.053633e-01
## 3.923077 139.5432 138.5901 1.0680769 -1.150115e-01
## 4.000000 141.0016 139.5496 1.0572126 3.947702e-01
## 4.076923 141.7330 140.4065 1.0371813 2.893561e-01
## 4.153846 142.5175 141.2971 1.0225209 1.979654e-01
## 4.230769 143.3479 142.2161 1.0121700 1.197040e-01
## 4.307692 144.2175 143.1587 1.0052111 5.360131e-02
## 4.384615 145.1199 144.1204 1.0008618 -1.358374e-03
## 4.461538 146.0495 145.0973 0.9984643 -4.620913e-02
## 4.538462 147.0013 146.0858 0.9974740 -8.198129e-02
## 4.615385 147.9708 147.0830 0.9974478 -1.096832e-01
## 4.692308 148.9541 148.0863 0.9980319 -1.302870e-01
## 4.769231 149.9478 149.0935 0.9989506 -1.447170e-01
## 4.846154 150.9491 150.1029 0.9999952 -1.538419e-01
## 4.923077 151.9557 151.1131 1.0010134 -1.584687e-01
## 5.000000 153.4395 152.1230 1.0019003 3.146449e-01
## 5.076923 154.2608 153.0370 0.9931095 2.307145e-01
## 5.153846 155.1224 153.9779 0.9878933 1.565617e-01
## 5.230769 156.0187 154.9413 0.9854455 9.186837e-02
## 5.307692 156.9443 155.9231 0.9850722 3.620413e-02
## 5.384615 157.8945 156.9193 0.9861854 -1.094828e-02
## 5.461538 158.8647 157.9266 0.9882954 -5.017014e-02
## 5.538462 159.8508 158.9419 0.9910018 -8.208624e-02
## 5.615385 160.8494 159.9627 0.9939853 -1.073469e-01
## 5.692308 161.8572 160.9869 0.9969976 -1.266121e-01
## 5.769231 162.8717 162.0124 0.9998527 -1.405388e-01
## 5.846154 163.8906 163.0379 1.0024184 -1.497689e-01
## 5.923077 164.9119 164.0622 1.0046071 -1.549212e-01
## 6.000000 166.3703 165.0844 1.0063690 2.794817e-01
## 6.076923 167.2256 166.0168 0.9989630 2.098497e-01
## 6.153846 168.1118 166.9706 0.9944517 1.467706e-01
## 6.230769 169.0253 167.9427 0.9922151 9.037531e-02
## 6.307692 169.9622 168.9298 0.9917095 4.065705e-02
## 6.384615 170.9191 169.9291 0.9924652 -2.508594e-03
## 6.461538 171.8925 170.9378 0.9940837 -3.934427e-02
## 6.538462 172.8794 171.9533 0.9962336 -7.015240e-02
## 6.615385 173.8770 172.9737 0.9986450 -9.529776e-02
## 6.692308 174.8828 173.9969 1.0011041 -1.151914e-01
## 6.769231 175.8946 175.0215 1.0034472 -1.302763e-01
## 6.846154 176.9105 176.0460 1.0055544 -1.410140e-01
## 6.923077 177.9289 177.0694 1.0073439 -1.478737e-01
## 7.000000 179.3496 178.0910 1.0087657 2.498580e-01
## 7.076923 180.2234 179.0298 1.0017733 1.918042e-01
xhat11 <- winter11$fitted[,2]
winter11.opt<- HoltWinters(training11.ts, alpha= NULL, beta = NULL, gamma = NULL, seasonal = "additive")
winter11.opt
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## HoltWinters(x = training11.ts, alpha = NULL, beta = NULL, gamma = NULL, seasonal = "additive")
##
## Smoothing parameters:
## alpha: 1
## beta : 0
## gamma: 0
##
## Coefficients:
## [,1]
## a 1.800000e+02
## b 1.000000e+00
## s1 -7.651999e-15
## s2 6.558856e-15
## s3 -7.651999e-15
## s4 -7.651999e-15
## s5 6.558856e-15
## s6 6.558856e-15
## s7 -7.651999e-15
## s8 -7.651999e-15
## s9 -7.651999e-15
## s10 6.558856e-15
## s11 6.558856e-15
## s12 6.558856e-15
## s13 6.558856e-15
winter11.opt$fitted
## Time Series:
## Start = c(2, 1)
## End = c(7, 2)
## Frequency = 13
## xhat level trend season
## 2.000000 107 106 1 6.558856e-15
## 2.076923 115 114 1 6.558856e-15
## 2.153846 116 115 1 -7.651999e-15
## 2.230769 117 116 1 6.558856e-15
## 2.307692 118 117 1 -7.651999e-15
## 2.384615 119 118 1 -7.651999e-15
## 2.461538 120 119 1 6.558856e-15
## 2.538462 121 120 1 6.558856e-15
## 2.615385 122 121 1 -7.651999e-15
## 2.692308 123 122 1 -7.651999e-15
## 2.769231 124 123 1 -7.651999e-15
## 2.846154 125 124 1 6.558856e-15
## 2.923077 126 125 1 6.558856e-15
## 3.000000 127 126 1 6.558856e-15
## 3.076923 128 127 1 6.558856e-15
## 3.153846 129 128 1 -7.651999e-15
## 3.230769 130 129 1 6.558856e-15
## 3.307692 131 130 1 -7.651999e-15
## 3.384615 132 131 1 -7.651999e-15
## 3.461538 133 132 1 6.558856e-15
## 3.538462 134 133 1 6.558856e-15
## 3.615385 135 134 1 -7.651999e-15
## 3.692308 136 135 1 -7.651999e-15
## 3.769231 137 136 1 -7.651999e-15
## 3.846154 138 137 1 6.558856e-15
## 3.923077 139 138 1 6.558856e-15
## 4.000000 140 139 1 6.558856e-15
## 4.076923 141 140 1 6.558856e-15
## 4.153846 142 141 1 -7.651999e-15
## 4.230769 143 142 1 6.558856e-15
## 4.307692 144 143 1 -7.651999e-15
## 4.384615 145 144 1 -7.651999e-15
## 4.461538 146 145 1 6.558856e-15
## 4.538462 147 146 1 6.558856e-15
## 4.615385 148 147 1 -7.651999e-15
## 4.692308 149 148 1 -7.651999e-15
## 4.769231 150 149 1 -7.651999e-15
## 4.846154 151 150 1 6.558856e-15
## 4.923077 152 151 1 6.558856e-15
## 5.000000 153 152 1 6.558856e-15
## 5.076923 154 153 1 6.558856e-15
## 5.153846 155 154 1 -7.651999e-15
## 5.230769 156 155 1 6.558856e-15
## 5.307692 157 156 1 -7.651999e-15
## 5.384615 158 157 1 -7.651999e-15
## 5.461538 159 158 1 6.558856e-15
## 5.538462 160 159 1 6.558856e-15
## 5.615385 161 160 1 -7.651999e-15
## 5.692308 162 161 1 -7.651999e-15
## 5.769231 163 162 1 -7.651999e-15
## 5.846154 164 163 1 6.558856e-15
## 5.923077 165 164 1 6.558856e-15
## 6.000000 166 165 1 6.558856e-15
## 6.076923 167 166 1 6.558856e-15
## 6.153846 168 167 1 -7.651999e-15
## 6.230769 169 168 1 6.558856e-15
## 6.307692 170 169 1 -7.651999e-15
## 6.384615 171 170 1 -7.651999e-15
## 6.461538 172 171 1 6.558856e-15
## 6.538462 173 172 1 6.558856e-15
## 6.615385 174 173 1 -7.651999e-15
## 6.692308 175 174 1 -7.651999e-15
## 6.769231 176 175 1 -7.651999e-15
## 6.846154 177 176 1 6.558856e-15
## 6.923077 178 177 1 6.558856e-15
## 7.000000 179 178 1 6.558856e-15
## 7.076923 180 179 1 6.558856e-15
xhat11.opt <- winter11.opt$fitted[,2]
#Forecast
forecast11 <- predict(winter11, n.ahead = 20)
forecast11.opt <- predict(winter11.opt, n.ahead = 20)
#Plot time series
plot(training11.ts,main="Winter 0.2;0.1;0.1",type="l",col="black",
xlim=c(1,25),pch=12)
lines(xhat11,type="l",col="red")
lines(xhat11.opt,type="l",col="blue")
lines(forecast11,type="l",col="red")
lines(forecast11.opt,type="l",col="blue")
legend("topleft",c("Actual Data",expression(paste(winter11)),
expression(paste(winter11.opt))),cex=0.5,
col=c("black","red","blue"),lty=1)
#Akurasi data training
SSE11<-winter11$SSE
MSE11<-winter11$SSE/length(training11.ts)
RMSE11<-sqrt(MSE11)
akurasi11 <- matrix(c(SSE11,MSE11,RMSE11))
row.names(akurasi11)<- c("SSE", "MSE", "RMSE")
colnames(akurasi11) <- c("Akurasi")
akurasi11
## Akurasi
## SSE 139.016364
## MSE 1.737705
## RMSE 1.318220
SSE11.opt<-winter11.opt$SSE
MSE11.opt<-winter11.opt$SSE/length(training11.ts)
RMSE11.opt<-sqrt(MSE11.opt)
akurasi11.opt <- matrix(c(SSE11.opt,MSE11.opt,RMSE11.opt))
row.names(akurasi11.opt)<- c("SSE1.opt", "MSE1.opt", "RMSE1.opt")
colnames(akurasi11.opt) <- c("Akurasi")
akurasi11.opt
## Akurasi
## SSE1.opt 49.0000000
## MSE1.opt 0.6125000
## RMSE1.opt 0.7826238
akurasi11.train = data.frame(Model_Winter = c("Winter 1","Winter1 optimal"),
Nilai_SSE=c(SSE11,SSE11.opt),
Nilai_MSE=c(MSE11,MSE11.opt),Nilai_RMSE=c(RMSE11,RMSE11.opt))
akurasi11.train
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1 Winter 1 139.0164 1.737705 1.3182202
## 2 Winter1 optimal 49.0000 0.612500 0.7826238
#Akurasi Data Testing
forecast11<-data.frame(forecast11)
testing11.ts<-data.frame(testing11.ts)
selisih11<-forecast11-testing11.ts
SSEtesting11<-sum(selisih11^2)
MSEtesting11<-SSEtesting11/length(testing11.ts)
forecast11.opt<-data.frame(forecast11.opt)
selisih11.opt<-forecast11.opt-testing11.ts
SSEtesting11.opt<-sum(selisih11.opt^2)
MSEtesting11.opt<-SSEtesting11.opt/length(testing11.ts)
Model multiplikatif digunakan cocok digunakan jika plot data asli menunjukkan fluktuasi musiman yang bervariasi.
#Pemulusan dengan winter multiplikatif
winter22 <- HoltWinters(training11.ts,alpha=0.2,beta=0.1,gamma=0.3,seasonal = "multiplicative")
winter22$fitted
## Time Series:
## Start = c(2, 1)
## End = c(7, 2)
## Frequency = 13
## xhat level trend season
## 2.000000 107.0000 106.0000 1.0000000 1.0000000
## 2.076923 109.5400 108.4000 1.1400000 1.0000000
## 2.153846 111.8812 110.6320 1.2492000 1.0000000
## 2.230769 114.0365 112.7050 1.3315760 1.0000000
## 2.307692 116.0201 114.6292 1.3908453 1.0000000
## 2.384615 117.8465 116.4161 1.4304438 1.0000000
## 2.461538 119.5307 118.0772 1.4535137 1.0000000
## 2.538462 121.0875 119.6246 1.4628994 1.0000000
## 2.615385 122.5311 121.0700 1.4611500 1.0000000
## 2.692308 123.8754 122.4249 1.4505274 1.0000000
## 2.769231 125.1334 123.7003 1.4330188 1.0000000
## 2.846154 126.3170 124.9067 1.4103516 1.0000000
## 2.923077 127.4376 126.0536 1.3840107 1.0000000
## 3.000000 130.4970 127.1501 1.3552579 1.0154982
## 3.076923 130.6322 127.8167 1.2863859 1.0118447
## 3.153846 130.9557 128.5828 1.2343577 1.0087708
## 3.230769 131.4354 129.4294 1.1955835 1.0062046
## 3.307692 132.0435 130.3396 1.1670518 1.0040818
## 3.384615 132.7556 131.2988 1.1462672 1.0023446
## 3.461538 133.5512 132.2943 1.1311898 1.0009415
## 3.538462 134.4123 133.3154 1.1201772 0.9998266
## 3.615385 135.3240 134.3531 1.1119304 0.9989588
## 3.692308 136.2738 135.4002 1.1054438 0.9983015
## 3.769231 137.2512 136.4508 1.0999591 0.9978223
## 3.846154 138.2478 137.5004 1.0949243 0.9974924
## 3.923077 139.2567 138.5456 1.0899565 0.9972864
## 4.000000 141.9254 139.5841 1.0848091 1.0089319
## 4.076923 142.3136 140.2873 1.0466427 1.0069316
## 4.153846 142.8245 141.0730 1.0205520 1.0051443
## 4.230769 143.4427 141.9295 1.0041460 1.0035615
## 4.307692 144.1535 142.8454 0.9953236 1.0021744
## 4.384615 144.9434 143.8101 0.9922603 1.0009737
## 4.461538 145.7997 144.8137 0.9933921 0.9999493
## 4.538462 146.7109 145.8471 0.9973987 0.9990902
## 4.615385 147.6666 146.9024 1.0031855 0.9983845
## 4.692308 148.6574 147.9724 1.0098633 0.9978200
## 4.769231 149.6750 149.0509 1.0167294 0.9973839
## 4.846154 150.7121 150.1328 1.0232460 0.9970632
## 4.923077 151.7625 151.2138 1.0290206 0.9968451
## 5.000000 154.1887 152.2905 1.0337860 1.0056381
## 5.076923 154.8218 153.0878 1.0101455 1.0046969
## 5.153846 155.5092 153.9344 0.9937871 1.0037501
## 5.230769 156.2494 154.8267 0.9836417 1.0028177
## 5.307692 157.0400 155.7606 0.9786677 1.0019182
## 5.384615 157.8776 156.7313 0.9778701 1.0010676
## 5.461538 158.7582 157.7337 0.9803162 1.0002790
## 5.538462 159.6776 158.7623 0.9851501 0.9995624
## 5.615385 160.6307 159.8120 0.9916018 0.9989252
## 5.692308 161.6129 160.8775 0.9989950 0.9983716
## 5.769231 162.6191 161.9540 1.0067497 0.9979034
## 5.846154 163.6447 163.0371 1.0143830 0.9975201
## 5.923077 164.6851 164.1228 1.0215069 0.9972194
## 6.000000 166.8627 165.2074 1.0278233 1.0037745
## 6.076923 167.6447 166.0634 1.0106340 1.0034157
## 6.153846 168.4405 166.9455 0.9977847 1.0029608
## 6.230769 169.2553 167.8554 0.9890001 1.0024334
## 6.307692 170.0927 168.7935 0.9839064 1.0018570
## 6.384615 170.9550 169.7589 0.9820560 1.0012539
## 6.461538 171.8436 170.7499 0.9829539 1.0006444
## 6.538462 172.7583 171.7642 0.9860808 1.0000467
## 6.615385 173.6984 172.7986 0.9909146 0.9994760
## 6.692308 174.6624 173.8498 0.9969491 0.9989452
## 6.769231 175.6479 174.9144 1.0037090 0.9984640
## 6.846154 176.6524 175.9886 1.0107620 0.9980397
## 6.923077 177.6731 177.0690 1.0177274 0.9976769
## 7.000000 179.6295 178.1523 1.0242815 1.0025277
## 7.076923 180.5109 179.0510 1.0117233 1.0024889
xhat22 <- winter22$fitted[,1]
winter22.opt<- HoltWinters(training11.ts, alpha= NULL, beta = NULL, gamma = NULL, seasonal = "multiplicative")
winter22.opt$fitted
## Time Series:
## Start = c(2, 1)
## End = c(7, 2)
## Frequency = 13
## xhat level trend season
## 2.000000 107 106 1 1
## 2.076923 115 114 1 1
## 2.153846 116 115 1 1
## 2.230769 117 116 1 1
## 2.307692 118 117 1 1
## 2.384615 119 118 1 1
## 2.461538 120 119 1 1
## 2.538462 121 120 1 1
## 2.615385 122 121 1 1
## 2.692308 123 122 1 1
## 2.769231 124 123 1 1
## 2.846154 125 124 1 1
## 2.923077 126 125 1 1
## 3.000000 127 126 1 1
## 3.076923 128 127 1 1
## 3.153846 129 128 1 1
## 3.230769 130 129 1 1
## 3.307692 131 130 1 1
## 3.384615 132 131 1 1
## 3.461538 133 132 1 1
## 3.538462 134 133 1 1
## 3.615385 135 134 1 1
## 3.692308 136 135 1 1
## 3.769231 137 136 1 1
## 3.846154 138 137 1 1
## 3.923077 139 138 1 1
## 4.000000 140 139 1 1
## 4.076923 141 140 1 1
## 4.153846 142 141 1 1
## 4.230769 143 142 1 1
## 4.307692 144 143 1 1
## 4.384615 145 144 1 1
## 4.461538 146 145 1 1
## 4.538462 147 146 1 1
## 4.615385 148 147 1 1
## 4.692308 149 148 1 1
## 4.769231 150 149 1 1
## 4.846154 151 150 1 1
## 4.923077 152 151 1 1
## 5.000000 153 152 1 1
## 5.076923 154 153 1 1
## 5.153846 155 154 1 1
## 5.230769 156 155 1 1
## 5.307692 157 156 1 1
## 5.384615 158 157 1 1
## 5.461538 159 158 1 1
## 5.538462 160 159 1 1
## 5.615385 161 160 1 1
## 5.692308 162 161 1 1
## 5.769231 163 162 1 1
## 5.846154 164 163 1 1
## 5.923077 165 164 1 1
## 6.000000 166 165 1 1
## 6.076923 167 166 1 1
## 6.153846 168 167 1 1
## 6.230769 169 168 1 1
## 6.307692 170 169 1 1
## 6.384615 171 170 1 1
## 6.461538 172 171 1 1
## 6.538462 173 172 1 1
## 6.615385 174 173 1 1
## 6.692308 175 174 1 1
## 6.769231 176 175 1 1
## 6.846154 177 176 1 1
## 6.923077 178 177 1 1
## 7.000000 179 178 1 1
## 7.076923 180 179 1 1
xhat22.opt <- winter22.opt$fitted[,1]
#Forecast
forecast22 <- predict(winter22, n.ahead = 20)
forecast22.opt <- predict(winter22.opt, n.ahead = 20)
#Plot time series
plot(training11.ts,main="Winter 0.2;0.1;0.1",type="l",col="black",
xlim=c(1,25),pch=12)
lines(xhat22,type="l",col="red")
lines(xhat22.opt,type="l",col="blue")
lines(forecast22,type="l",col="red")
lines(forecast22.opt,type="l",col="blue")
legend("topleft",c("Actual Data",expression(paste(winter22)),
expression(paste(winter22.opt))),cex=0.5,
col=c("black","red","blue"),lty=1)
#Akurasi data training
SSE22<-winter22$SSE
MSE22<-winter22$SSE/length(training11.ts)
RMSE22<-sqrt(MSE22)
akurasi11 <- matrix(c(SSE22,MSE22,RMSE22))
row.names(akurasi11)<- c("SSE2", "MSE2", "RMSE2")
colnames(akurasi11) <- c("Akurasi lamda=0.2")
akurasi11
## Akurasi lamda=0.2
## SSE2 156.621798
## MSE2 1.957772
## RMSE2 1.399204
SSE22.opt<-winter22.opt$SSE
MSE22.opt<-winter22.opt$SSE/length(training11.ts)
RMSE22.opt<-sqrt(MSE22.opt)
akurasi11.opt <- matrix(c(SSE22.opt,MSE22.opt,RMSE22.opt))
row.names(akurasi11.opt)<- c("SSE2.opt", "MSE2.opt", "RMSE2.opt")
colnames(akurasi11.opt) <- c("Akurasi")
akurasi11.opt
## Akurasi
## SSE2.opt 49.0000000
## MSE2.opt 0.6125000
## RMSE2.opt 0.7826238
akurasi22.train = data.frame(Model_Winter = c("Winter 1","winter2 optimal"),
Nilai_SSE=c(SSE22,SSE22.opt),
Nilai_MSE=c(MSE22,MSE22.opt),Nilai_RMSE=c(RMSE22,RMSE22.opt))
akurasi22.train
## Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1 Winter 1 156.6218 1.957772 1.3992042
## 2 winter2 optimal 49.0000 0.612500 0.7826238
#Akurasi Data Testing
forecast22<-data.frame(forecast22)
testing11.ts<-data.frame(testing11.ts)
selisih22<-forecast22-testing11.ts
SSEtesting22<-sum(selisih22^2)
MSEtesting22<-SSEtesting22/length(testing11.ts)
forecast22.opt<-data.frame(forecast22.opt)
selisih22.opt<-forecast22.opt-testing11.ts
SSEtesting22.opt<-sum(selisih22.opt^2)
MSEtesting22.opt<-SSEtesting22.opt/length(testing11.ts)
Data minyak goreng tersebut lebih baik menggunakan Single Moving Average karena merupakan data stasioner