R02 STA1341

Andika Putri Ratnasari

2022-08-21

Load Package

library(readxl)
library(TTR)
library(forecast)

Single Exponential Smoothing (Stasioner)

Single exponential smoothing sesuai untuk data deret waktu yang stasioner.

1. Import Data

#membuka file 
dataekspo<-read.csv("D:/MATERI KULIAH S2 IPB/ASPRAK/RESPONSI 2/data praktikum eksponensial.csv") 
head(dataekspo)
##   Period   Yt
## 1      1 48.7
## 2      2 45.8
## 3      3 46.4
## 4      4 46.2
## 5      5 44.0
## 6      6 53.8

2. Splitting Data

#membagi training dan testing 
training<-dataekspo[1:40,2] 
testing<-dataekspo[41:50,2] #data time series 
dataekspo.ts<-ts(dataekspo$Yt) 
training.ts<-ts(training) 
testing.ts<-ts(testing,start=41)

3. Eksplorasi Data

#eksplorasi data 

plot(dataekspo.ts, col="red",main="Plot semua data") 
points(dataekspo.ts)

plot(training.ts, col="blue",main="Plot semua data") 
points(training.ts)

4. Penerapan Single Exponential Smoothing (fungsi ses)

Single Eksponensial Smoothing dengan lamda=0.2

#single eksponensial dengan lamda=0.2  

ses.1 <- ses(training.ts, h = 10, alpha = 0.2) 
plot(ses.1)

ses.1
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 41        51.2589 47.18575 55.33206 45.02955 57.48826
## 42        51.2589 47.10508 55.41272 44.90618 57.61162
## 43        51.2589 47.02596 55.49185 44.78517 57.73264
## 44        51.2589 46.94828 55.56953 44.66637 57.85143
## 45        51.2589 46.87198 55.64583 44.54968 57.96812
## 46        51.2589 46.79698 55.72082 44.43499 58.08282
## 47        51.2589 46.72323 55.79458 44.32219 58.19562
## 48        51.2589 46.65065 55.86715 44.21119 58.30661
## 49        51.2589 46.57920 55.93860 44.10192 58.41589
## 50        51.2589 46.50883 56.00898 43.99429 58.52352

Single Eksponensial Smoothing dengan lamda=0.7

#single eksponensial dengan lamda=0.7

ses.2<- ses(training.ts, h = 10, alpha = 0.7) 
plot(ses.2)

ses.2
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 41       51.64682 46.89683 56.39681 44.38234 58.91130
## 42       51.64682 45.84872 57.44492 42.77939 60.51425
## 43       51.64682 44.96299 58.33065 41.42479 61.86885
## 44       51.64682 44.18162 59.11201 40.22979 63.06385
## 45       51.64682 43.47463 59.81901 39.14853 64.14511
## 46       51.64682 42.82411 60.46953 38.15364 65.14000
## 47       51.64682 42.21836 61.07528 37.22723 66.06640
## 48       51.64682 41.64925 61.64439 36.35685 66.93679
## 49       51.64682 41.11083 62.18281 35.53342 67.76022
## 50       51.64682 40.59863 62.69501 34.75006 68.54357

5. Penerapan Single Exponential Smoothing (fungsi Holtwinter)

Single Exponential Smoothing 0,2

ses1<- HoltWinters(training.ts, gamma = FALSE, beta = FALSE, alpha = 0.2) 

plot(ses1)

#ramalan 
ramalan1<- forecast(ses1, h=10) 
ramalan1
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 41       51.25907 47.18474 55.33340 45.02791 57.49023
## 42       51.25907 47.10405 55.41409 44.90451 57.61363
## 43       51.25907 47.02490 55.49324 44.78346 57.73468
## 44       51.25907 46.94720 55.57094 44.66463 57.85351
## 45       51.25907 46.87088 55.64726 44.54791 57.97023
## 46       51.25907 46.79586 55.72228 44.43318 58.08496
## 47       51.25907 46.72208 55.79606 44.32035 58.19779
## 48       51.25907 46.64949 55.86865 44.20932 58.30882
## 49       51.25907 46.57802 55.94012 44.10002 58.41812
## 50       51.25907 46.50762 56.01052 43.99236 58.52579

Single Exponential Smoothing 0,7

ses2<- HoltWinters(training.ts, gamma = FALSE, beta = FALSE, alpha = 0.7) 
plot(ses2)

#ramalan 
ramalan2<- forecast(ses2, h=10) 
ramalan2
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 41       51.64682 46.89554 56.39810 44.38036 58.91328
## 42       51.64682 45.84714 57.44650 42.77697 60.51667
## 43       51.64682 44.96117 58.33247 41.42200 61.87164
## 44       51.64682 44.17959 59.11405 40.22668 63.06696
## 45       51.64682 43.47240 59.82124 39.14513 64.14851
## 46       51.64682 42.82170 60.47194 38.14997 65.14367
## 47       51.64682 42.21579 61.07785 37.22331 66.07033
## 48       51.64682 41.64652 61.64711 36.35269 66.94095
## 49       51.64682 41.10796 62.18568 35.52903 67.76461
## 50       51.64682 40.59562 62.69802 34.74546 68.54818

6. Ukuran Keakuratan Ramalan Data Training

Cara 1

#Keakuratan Metode 
#Pada data training 

SSE1<-ses1$SSE 

MSE1<-ses1$SSE/length(training.ts) 

RMSE1<-sqrt(MSE1) 

akurasi1 <- data.frame(
          "Ukuran Keakuratan" = c("SSE", "MSE", "RMSE"), 
          "Single Exponential Smoothing lambda=0,2" = c(SSE1, MSE1, RMSE1))
akurasi1
##   Ukuran.Keakuratan Single.Exponential.Smoothing.lambda.0.2
## 1               SSE                              388.280675
## 2               MSE                                9.707017
## 3              RMSE                                3.115609
SSE2<-ses2$SSE 
MSE2<-ses2$SSE/length(training.ts)
RMSE2<-sqrt(MSE2) 

akurasi2 <- data.frame(
          "Ukuran Keakuratan" = c("SSE", "MSE", "RMSE"), 
          "Single Exponential Smoothing lambda=0,7" = c(SSE2, MSE2, RMSE2))
akurasi2
##   Ukuran.Keakuratan Single.Exponential.Smoothing.lambda.0.7
## 1               SSE                              522.770369
## 2               MSE                               13.069259
## 3              RMSE                                3.615143

Cara 2 (Manual)

#Cara Manual Ukuran keakuratan ramalan SES lambda 0,2
fitted1<-ramalan1$fitted 
sisaan1<-ramalan1$residuals 
head(sisaan1)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA -2.90000 -1.72000 -1.57600 -3.46080  7.03136
resid1<-training-ramalan1$fitted 
head(resid1)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA -2.90000 -1.72000 -1.57600 -3.46080  7.03136
SSE.1=sum(sisaan1[2:length(training.ts)]^2) 
SSE.1
## [1] 388.2807
MSE.1 = SSE.1/length(training.ts) 
MSE.1
## [1] 9.707017
RMSE.1=sqrt(MSE.1)
RMSE.1
## [1] 3.115609
MAPE.1 = sum(abs(sisaan1[2:length(training.ts)]/training.ts[2:length(training.ts)])*100)/length(training.ts) 
MAPE.1
## [1] 5.249856
akurasi.1 <- data.frame(
          "Ukuran Keakuratan" = c("SSE", "MSE", "RMSE","MAPE"), 
          "Single Exponential Smoothing lambda=0,2" = c(SSE.1, MSE.1, RMSE.1, MAPE.1))
akurasi.1
##   Ukuran.Keakuratan Single.Exponential.Smoothing.lambda.0.2
## 1               SSE                              388.280675
## 2               MSE                                9.707017
## 3              RMSE                                3.115609
## 4              MAPE                                5.249856
#Cara Manual Ukuran keakuratan ramalan SES lambda 0,7
fitted2<-ramalan2$fitted 
sisaan2<-ramalan2$residuals 
head(sisaan2)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA -2.90000 -0.27000 -0.28100 -2.28430  9.11471
resid2<-training-ramalan2$fitted 
head(resid2)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA -2.90000 -0.27000 -0.28100 -2.28430  9.11471
SSE.2=sum(sisaan2[2:length(training.ts)]^2) 
SSE.2
## [1] 522.7704
MSE.2 = SSE.2/length(training.ts) 
MSE.2
## [1] 13.06926
RMSE.2=sqrt(MSE.2)
RMSE.2
## [1] 3.615143
MAPE.2 = sum(abs(sisaan2[2:length(training.ts)]/training.ts[2:length(training.ts)])*100)/length(training.ts) 
MAPE.2
## [1] 5.767118
akurasi.2 <- data.frame(
          "Ukuran Keakuratan" = c("SSE", "MSE", "RMSE","MAPE"), 
          "Single Exponential Smoothing lambda=0,7" = c(SSE.2, MSE.2, RMSE.2, MAPE.2))
akurasi.2
##   Ukuran.Keakuratan Single.Exponential.Smoothing.lambda.0.7
## 1               SSE                              522.770369
## 2               MSE                               13.069259
## 3              RMSE                                3.615143
## 4              MAPE                                5.767118

7. Penerapan Single Exponential Smoothing dengan Lambda Optimum

#Lamda Optimum Holt Winter 

sesopt<- HoltWinters(training.ts, gamma = FALSE, beta = FALSE) 
sesopt
## Holt-Winters exponential smoothing without trend and without seasonal component.
## 
## Call:
## HoltWinters(x = training.ts, beta = FALSE, gamma = FALSE)
## 
## Smoothing parameters:
##  alpha: 0.161055
##  beta : FALSE
##  gamma: FALSE
## 
## Coefficients:
##     [,1]
## a 51.001
plot(sesopt)

#ramalan 
ramalanopt<- forecast(sesopt, h=10) 
ramalanopt
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 41         51.001 46.94040 55.06161 44.79084 57.21117
## 42         51.001 46.88807 55.11394 44.71082 57.29119
## 43         51.001 46.83640 55.16561 44.63179 57.37021
## 44         51.001 46.78537 55.21664 44.55374 57.44827
## 45         51.001 46.73494 55.26707 44.47662 57.52539
## 46         51.001 46.68511 55.31690 44.40041 57.60160
## 47         51.001 46.63584 55.36617 44.32506 57.67695
## 48         51.001 46.58712 55.41489 44.25055 57.75146
## 49         51.001 46.53894 55.46307 44.17686 57.82515
## 50         51.001 46.49126 55.51074 44.10395 57.89806

8.Ukuran Keakuratan Ramalan Data Testing

#Evaluasi Data Testing 
selisih1<-ramalan1$mean-testing.ts 

SSEtesting1<-sum(selisih1^2) 
MSEtesting1<-SSEtesting1/length(testing.ts) 
RMSEtesting1<-sqrt(MSEtesting1)

selisih2<-ramalan2$mean-testing.ts 
SSEtesting2<-sum(selisih2^2) 
MSEtesting2<-SSEtesting2/length(testing.ts) 
RMSEtesting2<-sqrt(MSEtesting2)

selisihopt<-ramalanopt$mean-testing.ts 
SSEtestingopt<-sum(selisihopt^2)
MSEtestingopt<-SSEtestingopt/length(testing.ts)
RMSEtestingopt<-sqrt(MSEtestingopt)

akurasi.3 <- data.frame(
          "Perbandingan Ukuran Keakuratan" = c("SSE", "MSE", "RMSE"), 
          "Single Exponential Smoothing lambda=0,2" = c(SSEtesting1, MSEtesting1, RMSEtesting1), "Single Exponential Smoothing lambda=0,7" = c(SSEtesting2, MSEtesting2, RMSEtesting2),"Single Exponential Smoothing lambda Opt" = c(SSEtestingopt, MSEtestingopt, RMSEtestingopt) )
          
akurasi.3
##   Perbandingan.Ukuran.Keakuratan Single.Exponential.Smoothing.lambda.0.2
## 1                            SSE                               95.287057
## 2                            MSE                                9.528706
## 3                           RMSE                                3.086860
##   Single.Exponential.Smoothing.lambda.0.7
## 1                              108.028057
## 2                               10.802806
## 3                                3.286762
##   Single.Exponential.Smoothing.lambda.Opt
## 1                               88.473923
## 2                                8.847392
## 3                                2.974457

Double Exponential Smoothing (Trend)

Double exponential smoothing sesuai untuk data deret waktu yang tidak stasioner atau mengandung trend.

1. Import Data

#membuka file 
dataekspo<-read.csv("D:/MATERI KULIAH S2 IPB/ASPRAK/RESPONSI 2/data praktikum eksponensial.csv") 
head(dataekspo)
##   Period   Yt
## 1      1 48.7
## 2      2 45.8
## 3      3 46.4
## 4      4 46.2
## 5      5 44.0
## 6      6 53.8

2. Splitting Data

#membagi training dan testing 
training<-dataekspo[1:40,2] 
testing<-dataekspo[41:50,2] #data time series 
dataekspo.ts<-ts(dataekspo$Yt) 
training.ts<-ts(training) 
testing.ts<-ts(testing,start=41)

3. Eksplorasi Data

#eksplorasi data 

plot(dataekspo.ts, col="red",main="Plot semua data") 
points(dataekspo.ts)

plot(training.ts, col="blue",main="Plot semua data") 
points(training.ts)

4. Penerapan Double Exponential Smoothing

Double Exponential Smoothing Lamda/alpha=0.2 dan beta=0.2

#Double Eksponensial Smoothing #Lamda=0.2 dan beta=0.2 

des.1<- HoltWinters(training.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)

plot(des.1)

#ramalan 

ramalandes1<- forecast(des.1, h=10) 
ramalandes1
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 41       52.93449 46.89794 58.97104 43.70238 62.16660
## 42       53.23737 47.02939 59.44534 43.74309 62.73164
## 43       53.54024 47.10629 59.97420 43.70036 63.38013
## 44       53.84312 47.12544 60.56081 43.56931 64.11693
## 45       54.14600 47.08556 61.20645 43.34798 64.94402
## 46       54.44888 46.98696 61.91080 43.03685 65.86090
## 47       54.75176 46.83121 62.67230 42.63833 66.86519
## 48       55.05464 46.62073 63.48854 42.15608 67.95319
## 49       55.35751 46.35839 64.35663 41.59454 69.12048
## 50       55.66039 46.04729 65.27350 40.95842 70.36236

Double Exponential Smoothing Lamda/alpha=0.6 dan beta=0.3

#Lamda=0.6 dan beta=0.3 

des.2<- HoltWinters(training.ts, gamma = FALSE, beta = 0.3, alpha = 0.6) 
plot(des.2)

#ramalan 
ramalandes2<- forecast(des.2, h=10) 
ramalandes2
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 41       51.35923 46.08547 56.63298 43.29371 59.42474
## 42       51.24032 44.55201 57.92864 41.01142 61.46922
## 43       51.12142 42.73300 59.50984 38.29244 63.95040
## 44       51.00252 40.68212 61.32292 35.21883 66.78621
## 45       50.88362 38.43488 63.33236 31.84491 69.92232
## 46       50.76472 36.01516 65.51427 28.20722 73.32221
## 47       50.64581 33.43979 67.85184 24.33147 76.96015
## 48       50.52691 30.72117 70.33265 20.23665 80.81717
## 49       50.40801 27.86889 72.94712 15.93741 84.87861
## 50       50.28911 24.89063 75.68759 11.44548 89.13273

Double Exponential Smoothing Lambda/Alpha dan Beta Optimum

#Lamda dan beta optimum 
des.opt<- HoltWinters(training.ts, gamma = FALSE) 
des.opt
## Holt-Winters exponential smoothing with trend and without seasonal component.
## 
## Call:
## HoltWinters(x = training.ts, gamma = FALSE)
## 
## Smoothing parameters:
##  alpha: 0.4635085
##  beta : 0.2628024
##  gamma: FALSE
## 
## Coefficients:
##          [,1]
## a 51.81211440
## b -0.03605837
plot(des.opt)

#ramalan 

ramalandesopt<- forecast(des.opt, h=10) 
ramalandesopt
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 41       51.77606 46.66859 56.88352 43.96486 59.58725
## 42       51.74000 45.82194 57.65805 42.68912 60.79088
## 43       51.70394 44.77088 58.63700 41.10074 62.30714
## 44       51.66788 43.54431 59.79145 39.24395 64.09181
## 45       51.63182 42.16755 61.09610 37.15746 66.10618
## 46       51.59576 40.66041 62.53112 34.87158 68.31995
## 47       51.55971 39.03793 64.08148 32.40931 70.71011
## 48       51.52365 37.31150 65.73580 29.78804 73.25926
## 49       51.48759 35.48986 67.48532 27.02118 75.95400
## 50       51.45153 33.57990 69.32316 24.11923 78.78383

5. Ukuran Keakuratan Ramalan Data Training

ssedes.train1<-des.1$SSE 
msedes.train1<-ssedes.train1/length(training.ts) 

sisaandes1<-ramalandes1$residuals 
head(sisaandes1)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA       NA  3.50000  5.36000  4.63360 15.86714
mapedes.train1<-sum(abs(sisaandes1[3:length(training.ts)]/training.ts[3:length(training.ts)])*100)/length(training.ts)
ssedes.train2<-des.2$SSE 
msedes.train2<-ssedes.train2/length(training.ts) 

sisaandes2<-ramalandes2$residuals 
head(sisaandes2)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA       NA  3.50000  3.47000  0.83340 11.62875
mapedes.train2<-sum(abs(sisaandes2[3:length(training.ts)]/training.ts[3:length(training.ts)])*100)/length(training.ts)
ssedes.trainopt<-des.opt$SSE 
msedes.trainopt<-ssedes.trainopt/length(training.ts) 

sisaandesopt<-ramalandesopt$residuals 
head(sisaandesopt)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]        NA        NA  3.500000  4.151381  1.995157 12.595329
mapedes.trainopt<-sum(abs(sisaandesopt[3:length(training.ts)]/training.ts[3:length(training.ts)])*100)/length(training.ts)

Perbandingan Ukuran Keakuratan Ramalan Data Training

akurasi.4 <- data.frame(
          "Perbandingan Ukuran Keakuratan" = c("SSE", "MSE", "MAPE"), 
          "Double Exponential Smoothing 1" = c(ssedes.train1, msedes.train1, mapedes.train1), "Double Exponential Smoothing 2" = c(ssedes.train2, msedes.train2, mapedes.train2),"Double Exponential Smoothing Opt" = c(ssedes.trainopt, msedes.trainopt, mapedes.trainopt))
          
akurasi.4
##   Perbandingan.Ukuran.Keakuratan Double.Exponential.Smoothing.1
## 1                            SSE                      989.65686
## 2                            MSE                       24.74142
## 3                           MAPE                        7.75642
##   Double.Exponential.Smoothing.2 Double.Exponential.Smoothing.Opt
## 1                     632.851720                       602.226909
## 2                      15.821293                        15.055673
## 3                       6.232456                         5.925947

6. Ukuran Keakuratan Ramalan Data Testing

#Akurasi Data Testing 
selisihdes1<-ramalandes1$mean-testing.ts 
selisihdes1
## Time Series:
## Start = 41 
## End = 50 
## Frequency = 1 
##  [1] 5.03448806 3.73736622 9.54024438 0.04312254 1.64600071 2.44887887
##  [7] 4.15175703 6.35463519 3.95751335 7.96039151
SSEtestingdes1<-sum(selisihdes1^2) 
MSEtestingdes1<-SSEtestingdes1/length(testing.ts) 
MAPEtestingdes1<-sum(abs(selisihdes1/testing.ts)*100)/length(testing.ts)
#Akurasi Data Testing 
selisihdes2<-ramalandes2$mean-testing.ts 
selisihdes2
## Time Series:
## Start = 41 
## End = 50 
## Frequency = 1 
##  [1]  3.45922576  1.74032361  7.12142147 -2.79748068 -1.61638283 -1.23528497
##  [7]  0.04581288  1.82691074 -0.99199141  2.58910645
SSEtestingdes2<-sum(selisihdes2^2) 
MSEtestingdes2<-SSEtestingdes2/length(testing.ts) 
MAPEtestingdes2<-sum(abs(selisihdes2/testing.ts)*100)/length(testing.ts)
#Akurasi Data Testing 
selisihdesopt<-ramalandesopt$mean-testing.ts 
selisihdesopt
## Time Series:
## Start = 41 
## End = 50 
## Frequency = 1 
##  [1]  3.87605603  2.23999765  7.70393928 -2.13211910 -0.86817747 -0.40423584
##  [7]  0.95970578  2.82364741  0.08758903  3.75153066
SSEtestingdesopt<-sum(selisihdesopt^2) 
MSEtestingdesopt<-SSEtestingdesopt/length(testing.ts) 
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing.ts)*100)/length(testing.ts)

Perbandingan Ukuran Keakuratan Ramalan Data Testing

akurasi.5 <- data.frame(
          "Perbandingan Ukuran Keakuratan" = c("SSE", "MSE", "MAPE"), 
          "Double Exponential Smoothing 1" = c(SSEtestingdes1, MSEtestingdes1, MAPEtestingdes1), "Double Exponential Smoothing 2" = c(SSEtestingdes2, MSEtestingdes2, MAPEtestingdes2),"Double Exponential Smoothing Opt" = c(SSEtestingdesopt, MSEtestingdesopt, MAPEtestingdesopt))
          
akurasi.5
##   Perbandingan.Ukuran.Keakuratan Double.Exponential.Smoothing.1
## 1                            SSE                     275.686644
## 2                            MSE                      27.568664
## 3                           MAPE                       9.330928
##   Double.Exponential.Smoothing.2 Double.Exponential.Smoothing.Opt
## 1                      88.701354                       107.830825
## 2                       8.870135                        10.783082
## 3                       4.877651                         5.225022

Winter’s Method (Additive)

Metode Winter dapat digunakan untuk data yang memiliki pola musiman. Terdapat dua tipe pola musiman dengan trend yaitu additivedan multiplicative.

1.Import Data

#Import data
winter <- read_excel("D:/MATERI KULIAH S2 IPB/ASPRAK/RESPONSI 2/datawinter.xlsx", sheet = 1)
head(winter)
## # A tibble: 6 x 2
##       t   obs
##   <dbl> <dbl>
## 1     1    10
## 2     2    31
## 3     3    43
## 4     4    16
## 5     5    11
## 6     6    33

2. Splitting Data

#membagi data menjadi training dan testing
training<-winter[1:12,2]
testing<-winter[13:16,2]

#Membentuk objek time series
winter.ts<-ts(winter$obs, start=1, frequency = 4)
training.ts<-ts(training, frequency = 4)
testing.ts<-ts(testing, start=13, frequency = 4)

3.Eksplorasi Data

#Membuat plot time series
plot(winter.ts, col="red")
points(winter.ts)

plot(training.ts, col="blue")
points(training.ts)

4. Penerapan Metode Winter Additive

Metode Winter alpha=0,2, beta=0,1, dan gamma=0,1

#Pemulusan dengan winter aditif 
winter1 <- HoltWinters(training.ts,alpha=0.2,beta=0.1,gamma=0.1,seasonal = "additive")
winter1$fitted
##          xhat    level     trend     season
## 2 Q1 10.11250 24.68750 0.4250000 -15.000000
## 2 Q2 32.35775 25.29000 0.4427500   6.625000
## 2 Q3 44.19179 25.86120 0.4555950  17.875000
## 2 Q4 17.45020 26.47844 0.4717591  -9.500000
## 3 Q1 12.39391 26.86016 0.4627552 -14.929000
## 3 Q2 34.81539 27.64413 0.4948770   6.676380
## 3 Q3 46.83415 28.37593 0.5185693  17.939656
## 3 Q4 20.57354 29.52767 0.5818862  -9.536016
xhat1 <- winter1$fitted[,2]

#Forecast
forecast1 <- predict(winter1, n.ahead = 4)

Metode Winter Optimum

winter1.opt<- HoltWinters(training.ts, seasonal = "additive")
winter1.opt
## Holt-Winters exponential smoothing with trend and additive seasonal component.
## 
## Call:
## HoltWinters(x = training.ts, seasonal = "additive")
## 
## Smoothing parameters:
##  alpha: 0.1642529
##  beta : 1
##  gamma: 0.9267375
## 
## Coefficients:
##          [,1]
## a   30.936208
## b    1.160968
## s1 -13.967600
## s2   7.310792
## s3  20.083583
## s4  -9.956393
winter1.opt$fitted
##          xhat    level     trend     season
## 2 Q1 10.11250 24.68750 0.4250000 -15.000000
## 2 Q2 32.45405 25.25827 0.5707745   6.625000
## 2 Q3 44.45417 25.91872 0.6604485  17.875000
## 2 Q4 17.91893 26.66883 0.7501024  -9.500000
## 3 Q1 13.55454 27.26799 0.5991659 -14.312615
## 3 Q2 35.66051 27.94032 0.6723336   7.047849
## 3 Q3 47.69427 28.66842 0.7280963  18.297754
## 3 Q4 20.67033 29.77524 1.1068189 -10.211726
xhat1.opt <- winter1.opt$fitted[,2]

forecast1.opt <- predict(winter1.opt, n.ahead = 4)
#Plot time series
plot(training.ts,type="l",col="black",xlim=c(1,5),pch=12)
lines(xhat1,type="l",col="red")
lines(xhat1.opt,type="l",col="blue")
lines(forecast1,type="l",col="red")
lines(forecast1.opt,type="l",col="blue")
legend("topleft",c("Actual Data",expression(paste(winter1)),
                   expression(paste(winter1.opt))),cex=0.5,
       col=c("black","red","blue"),lty=1)

5. Ukuran Keakuratan Ramalan

Data Training

#Akurasi data training
SSE1<-winter1$SSE
MSE1<-winter1$SSE/length(training.ts)
RMSE1<-sqrt(MSE1)
akurasi1 <- matrix(c(SSE1,MSE1,RMSE1))
row.names(akurasi1)<- c("SSE", "MSE", "RMSE")
colnames(akurasi1) <- c("Akurasi")
akurasi1
##        Akurasi
## SSE  16.243292
## MSE   1.353608
## RMSE  1.163446
SSE1.opt<-winter1.opt$SSE
MSE1.opt<-winter1.opt$SSE/length(training.ts)
RMSE1.opt<-sqrt(MSE1.opt)
akurasi1.opt <- matrix(c(SSE1.opt,MSE1.opt,RMSE1.opt))
row.names(akurasi1.opt)<- c("SSE1.opt", "MSE1.opt", "RMSE1.opt")
colnames(akurasi1.opt) <- c("Akurasi")
akurasi1.opt
##             Akurasi
## SSE1.opt  7.9668284
## MSE1.opt  0.6639024
## RMSE1.opt 0.8148020
akurasi1.train = data.frame(Model_Winter = c("Winter 1","Winter optimal"),
                           Nilai_SSE=c(SSE1,SSE1.opt),
                           Nilai_MSE=c(MSE1,MSE1.opt),Nilai_RMSE=c(RMSE1,RMSE1.opt))

akurasi1.train
##     Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1       Winter 1 16.243292 1.3536076   1.163446
## 2 Winter optimal  7.966828 0.6639024   0.814802

Data Testing

#Akurasi Data Testing
forecast1<-data.frame(forecast1)
testing.ts<-data.frame(testing.ts)
selisih1<-forecast1-testing.ts
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/nrow(testing.ts)
RMSEtesting1<-sqrt(MSEtesting1)


forecast1.opt<-data.frame(forecast1.opt)
selisih1.opt<-forecast1.opt-testing.ts
SSEtesting1.opt<-sum(selisih1.opt^2)
MSEtesting1.opt<-SSEtesting1.opt/nrow(testing.ts)
RMSEtesting1.opt<-sqrt(MSEtesting1.opt)

akurasi1.test = data.frame(Model_Winter = c("Winter 1","Winter optimal"),
                           Nilai_SSE=c(SSEtesting1,SSEtesting1.opt),
                           Nilai_MSE=c(MSEtesting1,MSEtesting1.opt),Nilai_RMSE=c(RMSEtesting1,RMSEtesting1.opt))

akurasi1.test
##     Model_Winter Nilai_SSE  Nilai_MSE Nilai_RMSE
## 1       Winter 1 44.452019 11.1130047  3.3336174
## 2 Winter optimal  1.579753  0.3949382  0.6284411

Winter’s Method (Multiplicative)

1.Import Data

#Import data
winter <- read_excel("D:/MATERI KULIAH S2 IPB/ASPRAK/RESPONSI 2/datawinter.xlsx", sheet = 2)
head(winter)
## # A tibble: 6 x 2
##       t    Xt
##   <dbl> <dbl>
## 1     1   112
## 2     2   118
## 3     3   132
## 4     4   129
## 5     5   121
## 6     6   135

2. Splitting Data

#membagi data menjadi training dan testing
training<-winter[1:48,2]
testing<-winter[49:60,2]

#Membentuk objek time series
winter.ts<-ts(winter$Xt, frequency = 12)
training.ts<-ts(training, frequency = 12)
testing.ts<-ts(testing, start=49, frequency = 12)

3.Eksplorasi Data

#Membuat plot time series
plot(winter.ts, col="red")
points(winter.ts)

plot(training.ts, col="blue")
points(training.ts)

4. Penerapan Metode Winter Multiplicative

Metode Winter alpha=0,2, beta=0,1, dan gamma=0,3

winter2 <- HoltWinters(training.ts,alpha=0.2,beta=0.1,gamma=0.3,seasonal = "multiplicative")
winter2$fitted
##           xhat    level    trend    season
## Jan 2 111.4710 123.8813 1.100524 0.8918980
## Feb 2 112.6303 125.7732 1.179658 0.8871820
## Mar 2 137.1757 127.7125 1.255623 1.0636402
## Apr 2 131.9466 129.6872 1.327533 1.0071123
## May 2 123.1246 131.6211 1.388171 0.9256840
## Jun 2 147.3496 133.4145 1.428691 1.0927478
## Jul 2 161.2818 135.1452 1.458898 1.1806507
## Aug 2 164.8681 138.0810 1.606583 1.1802629
## Sep 2 153.9263 140.5572 1.693545 1.0820775
## Oct 2 136.4026 143.0037 1.768839 0.9421856
## Nov 2 119.6211 144.0502 1.696611 0.8207458
## Dec 2 135.1102 144.3771 1.559635 0.9258132
## Jan 3 133.5891 146.9931 1.665269 0.8986319
## Feb 3 136.8124 151.1979 1.919230 0.8935145
## Mar 3 169.4769 156.0690 2.214414 1.0707176
## Apr 3 164.3064 159.8755 2.373619 1.0126800
## May 3 152.6803 161.9911 2.347818 0.9290577
## Jun 3 187.6477 168.4979 2.763716 1.0956787
## Jul 3 205.7837 169.5006 2.587611 1.1958039
## Aug 3 206.2100 170.9536 2.474153 1.1890256
## Sep 3 190.0894 172.2150 2.352877 1.0889143
## Oct 3 164.5370 173.4494 2.241033 0.9365166
## Nov 3 143.8903 175.1486 2.186853 0.8114018
## Dec 3 168.1716 177.8555 2.238853 0.9337970
## Jan 4 166.6840 179.6293 2.192343 0.9167447
## Feb 4 169.0973 182.7632 2.286503 0.9137941
## Mar 4 205.8251 187.4359 2.525127 1.0835122
## Apr 4 191.9223 187.5937 2.288394 1.0107444
## May 4 181.5515 187.7209 2.072270 0.9565757
## Jun 4 207.9624 190.0960 2.102555 1.0820183
## Jul 4 232.9167 194.0539 2.288090 1.1862804
## Aug 4 233.5427 195.8503 2.238917 1.1789777
## Sep 4 218.1574 199.5239 2.382385 1.0804884
## Oct 4 188.8698 200.2112 2.212881 0.9330402
## Nov 4 167.0343 202.8807 2.258541 0.8142486
## Dec 4 194.3146 206.3589 2.380511 0.9308956
xhat2 <- winter2$fitted[,2]

#Forecast
forecast2 <- predict(winter2, n.ahead = 12)

Metode Winter Optimum

winter2.opt<- HoltWinters(training.ts, seasonal = "multiplicative")
winter2.opt$fitted
##           xhat    level    trend    season
## Jan 2 111.4710 123.8813 1.100524 0.8918980
## Feb 2 112.7512 125.9142 1.174937 0.8871820
## Mar 2 137.4179 127.9520 1.243807 1.0636402
## Apr 2 132.2303 129.9894 1.307144 1.0071123
## May 2 123.3968 131.9445 1.358865 0.9256840
## Jun 2 147.6334 133.7115 1.391436 1.0927478
## Jul 2 161.5279 135.3976 1.414955 1.1806507
## Aug 2 165.2998 138.5035 1.549909 1.1802629
## Sep 2 154.3222 140.9917 1.624804 1.0820775
## Oct 2 136.7170 143.4174 1.688726 0.9421856
## Nov 2 119.6574 144.1766 1.614533 0.8207458
## Dec 2 134.8463 144.1669 1.484896 0.9258132
## Jan 3 133.6417 146.9635 1.589587 0.8996227
## Feb 3 137.1271 151.5281 1.827035 0.8941803
## Mar 3 170.1606 156.7474 2.097782 1.0712355
## Apr 3 164.9048 160.5696 2.235412 1.0128978
## May 3 152.8761 162.3619 2.200044 0.9289886
## Jun 3 188.4309 169.4126 2.587195 1.0955296
## Jul 3 206.1686 169.7563 2.408129 1.1975102
## Aug 3 205.8338 170.7538 2.295546 1.1894512
## Sep 3 189.3840 171.6956 2.187496 1.0891456
## Oct 3 163.4639 172.7182 2.094528 0.9350800
## Nov 3 142.9599 174.4439 2.065085 0.8099298
## Dec 3 167.9456 177.3934 2.135678 0.9354786
## Jan 4 166.6960 179.0390 2.096563 0.9202828
## Feb 4 169.0811 182.2376 2.184520 0.9168156
## Mar 4 205.6977 187.2285 2.408501 1.0846920
## Apr 4 190.8941 186.8786 2.188343 1.0096642
## May 4 181.2306 186.7578 2.004048 0.9601015
## Jun 4 206.2647 189.1961 2.038709 1.0785937
## Jul 4 232.4938 193.7986 2.243330 1.1859390
## Aug 4 233.0449 195.5464 2.203784 1.1784810
## Sep 4 218.1503 199.5408 2.346694 1.0805540
## Oct 4 188.4931 199.8921 2.187435 0.9327670
## Nov 4 166.9638 202.7128 2.237980 0.8146534
## Dec 4 194.6668 206.4075 2.354243 0.9324834
xhat2.opt <- winter2.opt$fitted[,2]

#Forecast
forecast2.opt <- predict(winter2.opt, n.ahead = 12)
#Plot time series
plot(training.ts,col="black",xlim=c(1,6),ylim=c(100,270),pch=12)
lines(xhat2,type="l",col="red")
lines(xhat2.opt,type="l",col="blue")
lines(forecast2,type="l",col="red")
lines(forecast2.opt,type="l",col="blue")
legend("topleft",c("Actual Data",expression(paste(winter2)),
                   expression(paste(winter2.opt))),cex=0.5,
       col=c("black","red","blue"),lty=1)

5. Ukuran Keakuratan Ramalan

Data Training

#Akurasi data training
SSE2<-winter2$SSE
MSE2<-winter2$SSE/length(training.ts)
RMSE2<-sqrt(MSE2)
akurasi1 <- matrix(c(SSE2,MSE2,RMSE2))
row.names(akurasi1)<- c("SSE2", "MSE2", "RMSE2")
colnames(akurasi1) <- c("Akurasi lamda=0.2")

akurasi1
##       Akurasi lamda=0.2
## SSE2        1952.823200
## MSE2          40.683817
## RMSE2          6.378387
SSE2.opt<-winter2.opt$SSE
MSE2.opt<-winter2.opt$SSE/length(training.ts)
RMSE2.opt<-sqrt(MSE2.opt)
akurasi1.opt <- matrix(c(SSE2.opt,MSE2.opt,RMSE2.opt))
row.names(akurasi1.opt)<- c("SSE2.opt", "MSE2.opt", "RMSE2.opt")
colnames(akurasi1.opt) <- c("Akurasi")
akurasi1.opt
##               Akurasi
## SSE2.opt  1944.259928
## MSE2.opt    40.505415
## RMSE2.opt    6.364386
akurasi2.train = data.frame(Model_Winter = c("Winter 1","winter2 optimal"),
                           Nilai_SSE=c(SSE2,SSE2.opt),
                           Nilai_MSE=c(MSE2,MSE2.opt),Nilai_RMSE=c(RMSE2,RMSE2.opt))
akurasi2.train
##      Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1        Winter 1  1952.823  40.68382   6.378387
## 2 winter2 optimal  1944.260  40.50542   6.364386

Data Testing

#Akurasi Data Testing
forecast2<-data.frame(forecast2)
testing.ts<-data.frame(testing.ts)
selisih2<-forecast2-testing.ts
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/nrow(testing.ts)
RMSEtesting2<-sqrt(MSEtesting2)

forecast2.opt<-data.frame(forecast2.opt)
selisih2.opt<-forecast2.opt-testing.ts
SSEtesting2.opt<-sum(selisih2.opt^2)
MSEtesting2.opt<-SSEtesting2.opt/nrow(testing.ts)
RMSEtesting2.opt<-sqrt(MSEtesting2.opt)

akurasi2.test = data.frame(Model_Winter = c("Winter 2","Winter optimal"),
                           Nilai_SSE=c(SSEtesting2,SSEtesting2.opt),
                           Nilai_MSE=c(MSEtesting2,MSEtesting2.opt),Nilai_RMSE=c(RMSEtesting2,RMSEtesting1.opt))

akurasi2.test
##     Model_Winter Nilai_SSE Nilai_MSE Nilai_RMSE
## 1       Winter 2  1332.722  111.0602 10.5385083
## 2 Winter optimal  1310.741  109.2284  0.6284411