Tugas Praktikum 3 STA542 ADW -Simple Exponential Smoothing-

Soal: Data yang digunakan pada tugas praktikum 3 ini adalah data time series yang sudah Anda pilih/tentukan pada tugas praktikum 1. Lakukan pemulusan first and second order exponential smoothing dengan alpha (0.25, 0.5, 0.75, dan alpha optimum) pada data tersebut. Kemudia bandingkan hasil keakurat pemulusan dari setiap metode tersebut. Berikan kesimpulan Anda!

Load Packages

library(forecast)

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

library(graphics)
library(tseries)
require(Mcomp)

## Loading required package: Mcomp

library(TSstudio)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

Dataset ini berisi data bulanan okupansi kereta api selama periode tahunan. rentang data selama tahun 1999-2011. Kolom okupansi terdiri dari persentase okupansi kereta api pada bulan tertentu dengan total 150 Observasi atau 150 Bulan.

Import data

okupansi<-read.csv("C:/Users/DELL/Documents/Dataset R/Occupancy_train.csv", header= TRUE)
print(head(okupansi))

##   X    Time Total.Occupancy.rate..percent.
## 1 0 1999M01                           43.7
## 2 1 1999M02                           41.0
## 3 2 1999M03                           36.5
## 4 3 1999M04                           32.8
## 5 4 1999M05                           24.5
## 6 5 1999M06                           24.1

print(tail(okupansi))

##       X    Time Total.Occupancy.rate..percent.
## 145 144 2011M01                           48.9
## 146 145 2011M02                           47.8
## 147 146 2011M03                           42.6
## 148 147 2011M04                           37.7
## 149 148 2011M05                           29.6
## 150 149 2011M06                           27.6

Menampilkan Data Univariat yaitu Kolom Ketiga

occupancy <- okupansi [,3]
occupancy

##   [1] 43.7 41.0 36.5 32.8 24.5 24.1 26.0 26.2 30.7 29.9 35.2 33.8 44.1 41.8 36.9
##  [16] 34.3 25.1 23.5 26.9 26.9 28.3 31.5 36.5 37.5 47.7 44.8 40.8 34.6 27.1 25.3
##  [31] 28.9 29.2 30.5 32.8 36.2 37.8 48.1 46.6 45.1 36.5 28.7 26.7 30.6 29.8 31.7
##  [46] 35.0 39.9 40.3 48.8 48.8 44.0 39.6 29.4 26.6 31.3 29.9 32.8 35.2 40.0 42.1
##  [61] 50.4 48.9 45.3 39.5 30.1 29.0 32.5 30.8 32.9 34.2 41.0 40.8 50.9 49.7 46.4
##  [76] 38.1 29.0 29.6 31.6 29.7 32.1 33.3 39.1 38.8 48.8 48.7 44.1 37.7 29.2 27.6
##  [91] 30.7 30.7 32.9 34.8 41.0 40.4 51.1 51.6 46.9 38.5 30.8 28.8 31.7 31.4 33.4
## [106] 33.7 40.5 40.1 50.8 50.8 47.6 38.3 30.8 27.5 31.3 30.5 32.1 34.4 38.2 38.4
## [121] 48.3 48.2 43.6 37.8 30.0 25.4 30.4 29.1 31.6 33.4 37.8 39.6 49.5 48.5 43.7
## [136] 37.3 28.1 26.9 30.5 29.1 31.6 33.4 38.9 39.0 48.9 47.8 42.6 37.7 29.6 27.6

Membentuk Data time-series

occupancy.ts<-ts(occupancy, start= c(1999,1), end=c(2011,6), frequency= 12) 
occupancy.ts

##       Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
## 1999 43.7 41.0 36.5 32.8 24.5 24.1 26.0 26.2 30.7 29.9 35.2 33.8
## 2000 44.1 41.8 36.9 34.3 25.1 23.5 26.9 26.9 28.3 31.5 36.5 37.5
## 2001 47.7 44.8 40.8 34.6 27.1 25.3 28.9 29.2 30.5 32.8 36.2 37.8
## 2002 48.1 46.6 45.1 36.5 28.7 26.7 30.6 29.8 31.7 35.0 39.9 40.3
## 2003 48.8 48.8 44.0 39.6 29.4 26.6 31.3 29.9 32.8 35.2 40.0 42.1
## 2004 50.4 48.9 45.3 39.5 30.1 29.0 32.5 30.8 32.9 34.2 41.0 40.8
## 2005 50.9 49.7 46.4 38.1 29.0 29.6 31.6 29.7 32.1 33.3 39.1 38.8
## 2006 48.8 48.7 44.1 37.7 29.2 27.6 30.7 30.7 32.9 34.8 41.0 40.4
## 2007 51.1 51.6 46.9 38.5 30.8 28.8 31.7 31.4 33.4 33.7 40.5 40.1
## 2008 50.8 50.8 47.6 38.3 30.8 27.5 31.3 30.5 32.1 34.4 38.2 38.4
## 2009 48.3 48.2 43.6 37.8 30.0 25.4 30.4 29.1 31.6 33.4 37.8 39.6
## 2010 49.5 48.5 43.7 37.3 28.1 26.9 30.5 29.1 31.6 33.4 38.9 39.0
## 2011 48.9 47.8 42.6 37.7 29.6 27.6

Menguji apakah data yang digunakan Stasioner atau tidak

adf.test(x = occupancy.ts)

## Warning in adf.test(x = occupancy.ts): p-value smaller than printed p-value

## 
##  Augmented Dickey-Fuller Test
## 
## data:  occupancy.ts
## Dickey-Fuller = -8.007, Lag order = 5, p-value = 0.01
## alternative hypothesis: stationary

Karena p-value yang didapatkan < 0.05 kita dapat menyimpulkan bahwa tersebut telah stasioner.

Plot Time Series

par(col="coral")
ts.plot(occupancy.ts, xlab="Period", ylab="Occupancy Rate", lty=1)
title("Occupancy Of Train")
points(occupancy.ts)

Berdasarkan plot yang dihasilkan, data ini merupakan data musiman.

Create training and validation Data

occ.test <- tail(occupancy.ts, 30)
occ.train <- head(occupancy.ts, length(occupancy.ts) - length(occ.test))

occ.test

##       Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
## 2009 48.3 48.2 43.6 37.8 30.0 25.4 30.4 29.1 31.6 33.4 37.8 39.6
## 2010 49.5 48.5 43.7 37.3 28.1 26.9 30.5 29.1 31.6 33.4 38.9 39.0
## 2011 48.9 47.8 42.6 37.7 29.6 27.6

occ.train

##       Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
## 1999 43.7 41.0 36.5 32.8 24.5 24.1 26.0 26.2 30.7 29.9 35.2 33.8
## 2000 44.1 41.8 36.9 34.3 25.1 23.5 26.9 26.9 28.3 31.5 36.5 37.5
## 2001 47.7 44.8 40.8 34.6 27.1 25.3 28.9 29.2 30.5 32.8 36.2 37.8
## 2002 48.1 46.6 45.1 36.5 28.7 26.7 30.6 29.8 31.7 35.0 39.9 40.3
## 2003 48.8 48.8 44.0 39.6 29.4 26.6 31.3 29.9 32.8 35.2 40.0 42.1
## 2004 50.4 48.9 45.3 39.5 30.1 29.0 32.5 30.8 32.9 34.2 41.0 40.8
## 2005 50.9 49.7 46.4 38.1 29.0 29.6 31.6 29.7 32.1 33.3 39.1 38.8
## 2006 48.8 48.7 44.1 37.7 29.2 27.6 30.7 30.7 32.9 34.8 41.0 40.4
## 2007 51.1 51.6 46.9 38.5 30.8 28.8 31.7 31.4 33.4 33.7 40.5 40.1
## 2008 50.8 50.8 47.6 38.3 30.8 27.5 31.3 30.5 32.1 34.4 38.2 38.4

1. First Order Exponential Smoothing

1.a. First Order Eksponensial Smoothing untuk alpha = 0.25

occ.holt.ses1A <- HoltWinters(occ.train, alpha= 0.25, beta= FALSE, gamma= FALSE)
str(occ.holt.ses1A)

## List of 9
##  $ fitted      : Time-Series [1:119, 1:2] from 1999 to 2009: 43.7 43 41.4 39.2 35.6 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:2] "xhat" "level"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 0.25
##  $ beta        : logi FALSE
##  $ gamma       : logi FALSE
##  $ coefficients: Named num 35.8
##   ..- attr(*, "names")= chr "a"
##  $ seasonal    : chr "additive"
##  $ SSE         : num 6563
##  $ call        : language HoltWinters(x = occ.train, alpha = 0.25, beta = FALSE, gamma = FALSE)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses1A$SSE

## [1] 6563.254

head(occ.holt.ses1A$fitted,10)

##              xhat    level
## Feb 1999 43.70000 43.70000
## Mar 1999 43.02500 43.02500
## Apr 1999 41.39375 41.39375
## May 1999 39.24531 39.24531
## Jun 1999 35.55898 35.55898
## Jul 1999 32.69424 32.69424
## Aug 1999 31.02068 31.02068
## Sep 1999 29.81551 29.81551
## Oct 1999 30.03663 30.03663
## Nov 1999 30.00247 30.00247

occupancy.forecast.1a <- forecast(occ.holt.ses1A, h = 5)
occupancy.forecast.1a

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       35.77668 26.22510 45.32826 21.16880 50.38457
## Feb 2009       35.77668 25.93114 45.62223 20.71922 50.83414
## Mar 2009       35.77668 25.64570 45.90766 20.28269 51.27068
## Apr 2009       35.77668 25.36809 46.18528 19.85811 51.69525
## May 2009       35.77668 25.09769 46.45568 19.44458 52.10879

plot(occ.holt.ses1A)

ac1a <- accuracy(occupancy.forecast.1a$mean, x = occ.test)

1.b. First Order Eksponensial Smoothing untuk alpha = 0.5

occ.holt.ses1b <- HoltWinters(occ.train, alpha= 0.5, beta= FALSE, gamma= FALSE)
str(occ.holt.ses1b)

## List of 9
##  $ fitted      : Time-Series [1:119, 1:2] from 1999 to 2009: 43.7 42.4 39.4 36.1 30.3 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:2] "xhat" "level"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 0.5
##  $ beta        : logi FALSE
##  $ gamma       : logi FALSE
##  $ coefficients: Named num 37
##   ..- attr(*, "names")= chr "a"
##  $ seasonal    : chr "additive"
##  $ SSE         : num 4893
##  $ call        : language HoltWinters(x = occ.train, alpha = 0.5, beta = FALSE, gamma = FALSE)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses1b$SSE

## [1] 4893.09

head(occ.holt.ses1b$fitted,10)

##              xhat    level
## Feb 1999 43.70000 43.70000
## Mar 1999 42.35000 42.35000
## Apr 1999 39.42500 39.42500
## May 1999 36.11250 36.11250
## Jun 1999 30.30625 30.30625
## Jul 1999 27.20312 27.20312
## Aug 1999 26.60156 26.60156
## Sep 1999 26.40078 26.40078
## Oct 1999 28.55039 28.55039
## Nov 1999 29.22520 29.22520

occupancy.forecast.1b <- forecast(occ.holt.ses1b, h = 5)
occupancy.forecast.1b

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       37.00148 28.75023 45.25273 24.38228 49.62068
## Feb 2009       37.00148 27.77630 46.22666 22.89279 51.11017
## Mar 2009       37.00148 26.89581 47.10716 21.54618 52.45678
## Apr 2009       37.00148 26.08610 47.91686 20.30785 53.69511
## May 2009       37.00148 25.33245 48.67051 19.15524 54.84772

plot(occ.holt.ses1b)

ac1b <-  accuracy(occupancy.forecast.1b$mean, x = occ.test)

1.c. First Order Eksponensial Smoothing untuk alpha = 0.75

occ.holt.ses1c <- HoltWinters(occ.train, alpha= 0.75, beta= FALSE, gamma= FALSE)
str(occ.holt.ses1c)

## List of 9
##  $ fitted      : Time-Series [1:119, 1:2] from 1999 to 2009: 43.7 41.7 37.8 34 26.9 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:2] "xhat" "level"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 0.75
##  $ beta        : logi FALSE
##  $ gamma       : logi FALSE
##  $ coefficients: Named num 38.1
##   ..- attr(*, "names")= chr "a"
##  $ seasonal    : chr "additive"
##  $ SSE         : num 3548
##  $ call        : language HoltWinters(x = occ.train, alpha = 0.75, beta = FALSE, gamma = FALSE)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses1c$SSE

## [1] 3547.739

head(occ.holt.ses1c$fitted,10)

##              xhat    level
## Feb 1999 43.70000 43.70000
## Mar 1999 41.67500 41.67500
## Apr 1999 37.79375 37.79375
## May 1999 34.04844 34.04844
## Jun 1999 26.88711 26.88711
## Jul 1999 24.79678 24.79678
## Aug 1999 25.69919 25.69919
## Sep 1999 26.07480 26.07480
## Oct 1999 29.54370 29.54370
## Nov 1999 29.81092 29.81092

occupancy.forecast.1c <- forecast(occ.holt.ses1c, h = 5)
occupancy.forecast.1c

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       38.07052 31.04397 45.09707 27.32434 48.81670
## Feb 2009       38.07052 29.28734 46.85370 24.63780 51.50324
## Mar 2009       38.07052 27.82766 48.31338 22.40541 53.73563
## Apr 2009       38.07052 26.55148 49.58956 20.45367 55.68737
## May 2009       38.07052 25.40323 50.73781 18.69758 57.44346

plot(occ.holt.ses1c)

ac1c <- accuracy(occupancy.forecast.1c$mean, x = occ.test)

1.d. First Order Eksponensial Smoothing untuk alpha Optimum

occ.holt.ses1d <- HoltWinters(occ.train, beta= FALSE, gamma= FALSE)
str(occ.holt.ses1d)

## List of 9
##  $ fitted      : Time-Series [1:119, 1:2] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:2] "xhat" "level"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 1
##  $ beta        : logi FALSE
##  $ gamma       : logi FALSE
##  $ coefficients: Named num 38.4
##   ..- attr(*, "names")= chr "a"
##  $ seasonal    : chr "additive"
##  $ SSE         : num 2830
##  $ call        : language HoltWinters(x = occ.train, beta = FALSE, gamma = FALSE)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses1d$SSE

## [1] 2829.749

head(occ.holt.ses1d$fitted,10)

##              xhat    level
## Feb 1999 43.70000 43.70000
## Mar 1999 41.00018 41.00018
## Apr 1999 36.50030 36.50030
## May 1999 32.80024 32.80024
## Jun 1999 24.50055 24.50055
## Jul 1999 24.10003 24.10003
## Aug 1999 25.99987 25.99987
## Sep 1999 26.19999 26.19999
## Oct 1999 30.69970 30.69970
## Nov 1999 29.90005 29.90005

occupancy.forecast.1d <- forecast(occ.holt.ses1d, h = 5)
occupancy.forecast.1d

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       38.39999 32.12445 44.67552 28.80238 47.99759
## Feb 2009       38.39999 29.52533 47.27464 24.82737 51.97260
## Mar 2009       38.39999 27.53092 49.26906 21.77718 55.02280
## Apr 2009       38.39999 25.84953 50.95044 19.20573 57.59425
## May 2009       38.39999 24.36820 52.43177 16.94022 59.85975

plot(occ.holt.ses1d)

ac1d <- accuracy(occupancy.forecast.1d$mean, x = occ.test)
ac1d

##                ME     RMSE      MAE      MPE     MAPE      ACF1 Theil's U
## Test set 3.180013 7.642126 6.780003 4.633663 16.46855 0.3892996  1.214678

2. Second Order Exponential Smoothing

2.a. Second Order Eksponensial Smoothing, alpha = 0.25

occ.holt.ses2a <- HoltWinters(occ.train, alpha = 0.25, beta= 0.1, gamma= FALSE)
str(occ.holt.ses2a)

## List of 9
##  $ fitted      : Time-Series [1:118, 1:3] from 1999 to 2009: 38.3 35.1 31.7 26.9 23.2 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:3] "xhat" "level" "trend"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 0.25
##  $ beta        : num 0.1
##  $ gamma       : logi FALSE
##  $ coefficients: Named num [1:2] 34.983 -0.199
##   ..- attr(*, "names")= chr [1:2] "a" "b"
##  $ seasonal    : chr "additive"
##  $ SSE         : num 8093
##  $ call        : language HoltWinters(x = occ.train, alpha = 0.25, beta = 0.1, gamma = FALSE)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses2a$SSE

## [1] 8092.64

head(occ.holt.ses2a$fitted,10)

##              xhat    level     trend
## Mar 1999 38.30000 41.00000 -2.700000
## Apr 1999 35.10500 37.85000 -2.745000
## May 1999 31.72612 34.52875 -2.802625
## Jun 1999 26.93632 29.91959 -2.983278
## Jul 1999 23.17305 26.22724 -3.054186
## Aug 1999 20.89628 23.87979 -2.983512
## Sep 1999 19.37129 22.22221 -2.850919
## Oct 1999 19.63576 22.20347 -2.567701
## Nov 1999 19.89073 22.20182 -2.311095
## Dec 1999 21.78968 23.71805 -1.928364

occupancy.forecast.2a <- forecast(occ.holt.ses2a, h = 5)
occupancy.forecast.2a

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       34.78447 24.18218 45.38677 18.56966 50.99929
## Feb 2009       34.58575 23.58986 45.58164 17.76899 51.40252
## Mar 2009       34.38703 22.94036 45.83371 16.88085 51.89321
## Apr 2009       34.18831 22.23425 46.14237 15.90616 52.47047
## May 2009       33.98959 21.47282 46.50637 14.84684 53.13235

plot(occ.holt.ses2a)

ac2a <-accuracy(occupancy.forecast.2a$mean, x = occ.test)

2.b. Second Order Eksponensial Smoothing, alpha = 0.5

occ.holt.ses2b <- HoltWinters(occ.train, alpha = 0.5, beta= 0.1, gamma= FALSE)
str(occ.holt.ses2b)

## List of 9
##  $ fitted      : Time-Series [1:118, 1:3] from 1999 to 2009: 38.3 34.6 30.8 24.5 21.1 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:3] "xhat" "level" "trend"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 0.5
##  $ beta        : num 0.1
##  $ gamma       : logi FALSE
##  $ coefficients: Named num [1:2] 36.6655 0.0434
##   ..- attr(*, "names")= chr [1:2] "a" "b"
##  $ seasonal    : chr "additive"
##  $ SSE         : num 5789
##  $ call        : language HoltWinters(x = occ.train, alpha = 0.5, beta = 0.1, gamma = FALSE)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses2b$SSE

## [1] 5789.443

head(occ.holt.ses2b$fitted,10)

##              xhat    level     trend
## Mar 1999 38.30000 41.00000 -2.700000
## Apr 1999 34.61000 37.40000 -2.790000
## May 1999 30.82450 33.70500 -2.880500
## Jun 1999 24.46552 27.66225 -3.196725
## Jul 1999 21.06776 24.28276 -3.215001
## Aug 1999 20.56549 23.53388 -2.968389
## Sep 1999 20.69608 23.38275 -2.686664
## Oct 1999 23.51157 25.69804 -2.186468
## Nov 1999 24.83874 26.70579 -1.867047
## Dec 1999 28.67039 30.01937 -1.348984

occupancy.forecast.2b <- forecast(occ.holt.ses2b, h = 5)
occupancy.forecast.2b

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       36.70885 27.71382 45.70387 22.95214 50.46555
## Feb 2009       36.75222 26.48646 47.01799 21.05209 52.45236
## Mar 2009       36.79560 25.19760 48.39361 19.05798 54.53322
## Apr 2009       36.83898 23.85059 49.82738 16.97494 56.70302
## May 2009       36.88236 22.44821 51.31651 14.80724 58.95749

plot(occ.holt.ses2b)

ac2b <- accuracy(occupancy.forecast.2b$mean, x = occ.test)

2.c. Second Order Eksponensial Smoothing, alpha = 0.75

occ.holt.ses2c <- HoltWinters(occ.train, alpha = 0.75, beta= 0.1, gamma= FALSE)
str(occ.holt.ses2c)

## List of 9
##  $ fitted      : Time-Series [1:118, 1:3] from 1999 to 2009: 38.3 34.1 30.2 22.6 20.5 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:3] "xhat" "level" "trend"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 0.75
##  $ beta        : num 0.1
##  $ gamma       : logi FALSE
##  $ coefficients: Named num [1:2] 38.062 0.189
##   ..- attr(*, "names")= chr [1:2] "a" "b"
##  $ seasonal    : chr "additive"
##  $ SSE         : num 3970
##  $ call        : language HoltWinters(x = occ.train, alpha = 0.75, beta = 0.1, gamma = FALSE)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses2c$SSE

## [1] 3970.05

head(occ.holt.ses2c$fitted,10)

##              xhat    level     trend
## Mar 1999 38.30000 41.00000 -2.700000
## Apr 1999 34.11500 36.95000 -2.835000
## May 1999 30.19512 33.12875 -2.933625
## Jun 1999 22.56302 25.92378 -3.360759
## Jul 1999 20.47027 23.71576 -3.245486
## Aug 1999 21.78681 24.61757 -2.830756
## Sep 1999 22.59694 25.09670 -2.499767
## Oct 1999 26.78220 28.67423 -1.892037
## Nov 1999 27.46235 29.12055 -1.658202
## Dec 1999 32.18771 33.26559 -1.077878

occupancy.forecast.2c <- forecast(occ.holt.ses2c, h = 5)
occupancy.forecast.2c

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       38.25072 30.79736 45.70409 26.85178 49.64966
## Feb 2009       38.43938 28.77692 48.10184 23.66192 53.21684
## Mar 2009       38.62804 26.86535 50.39073 20.63856 56.61752
## Apr 2009       38.81670 24.99025 52.64314 17.67097 59.96242
## May 2009       39.00535 23.11770 54.89300 14.70729 63.30342

plot(occ.holt.ses2c)

ac2c <- accuracy(occupancy.forecast.2c$mean, x = occ.test)

2.d. Second Order Eksponensial Smoothing, untuk alpha Optimum

occ.holt.ses2d <- HoltWinters(occ.train, beta= 0.1, gamma= FALSE)
str(occ.holt.ses2d)

## List of 9
##  $ fitted      : Time-Series [1:118, 1:3] from 1999 to 2009: 38.3 33.6 29.8 21 20.9 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:3] "xhat" "level" "trend"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 1
##  $ beta        : num 0.1
##  $ gamma       : logi FALSE
##  $ coefficients: Named num [1:2] 38.4 0.214
##   ..- attr(*, "names")= chr [1:2] "a" "b"
##  $ seasonal    : chr "additive"
##  $ SSE         : num 3070
##  $ call        : language HoltWinters(x = occ.train, beta = 0.1, gamma = FALSE)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses2d$SSE

## [1] 3070.381

head(occ.holt.ses2d$fitted,10)

##              xhat    level      trend
## Mar 1999 38.30000 41.00000 -2.7000000
## Apr 1999 33.62013 36.50012 -2.8799881
## May 1999 29.83806 32.80005 -2.9619958
## Jun 1999 21.00459 24.50035 -3.4957663
## Jul 1999 20.91355 24.09980 -3.1862454
## Aug 1999 23.32203 25.99966 -2.6776341
## Sep 1999 23.80995 26.19981 -2.3898561
## Oct 1999 28.99865 30.69954 -1.7008970
## Nov 1999 28.28917 29.89994 -1.6107677
## Dec 1999 34.27981 35.19954 -0.9197306

occupancy.forecast.2d <- forecast(occ.holt.ses2d, h = 5)
occupancy.forecast.2d

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       38.61356 32.05618 45.17093 28.58492 48.64219
## Feb 2009       38.82711 29.07923 48.57499 23.91901 53.73521
## Mar 2009       39.04066 26.51342 51.56791 19.88190 58.19943
## Apr 2009       39.25422 24.10197 54.40647 16.08085 62.42759
## May 2009       39.46777 21.75174 57.18381 12.37344 66.56211

plot(occ.holt.ses2d)

ac2d <- accuracy(occupancy.forecast.2d$mean, x = occ.test)
ac2d

##                ME     RMSE      MAE      MPE     MAPE      ACF1 Theil's U
## Test set 2.539336 7.670975 6.908132 2.910278 17.07283 0.3913609  1.261667

accuraci <- c("ME", "RMSE", "MAE", "MPE", "MAPE", "ACf1", "Theil's")

compare_akurasi <- rbind(FE_0.25=c(ac1a),FE_0.5=c(ac1b),FE_0.75=c(ac1c),FE_Op=c(ac1d),SE_0.25=c(ac2a),SE_0.5=c(ac2b),SE_0.75=c(ac2c),SE_Op=c(ac2d))
compare_akurasi

##             [,1]     [,2]     [,3]      [,4]     [,5]      [,6]     [,7]
## FE_0.25 5.803316 9.053623 8.113990 11.148634 18.85088 0.3892996 1.304115
## FE_0.5  4.578519 8.321805 7.379112  8.106851 17.44216 0.3892996 1.242606
## FE_0.75 3.509480 7.784989 6.845896  5.451894 16.49885 0.3892996 1.216974
## FE_Op   3.180013 7.642126 6.780003  4.633663 16.46855 0.3892996 1.214678
## SE_0.25 7.192967 9.816895 8.788804 14.722905 20.04236 0.3870871 1.389588
## SE_0.5  4.784396 8.485242 7.537341  8.591280 17.76776 0.3897431 1.257594
## SE_0.75 2.951962 7.785989 6.960781  3.950454 17.03346 0.3911357 1.252068
## SE_Op   2.539336 7.670975 6.908132  2.910278 17.07283 0.3913609 1.261667

rbind(accuraci,compare_akurasi)

##          [,1]               [,2]               [,3]              
## accuraci "ME"               "RMSE"             "MAE"             
## FE_0.25  "5.80331645213274" "9.05362258124307" "8.11398987127964"
## FE_0.5   "4.57851928433817" "8.32180502277339" "7.3791115706029" 
## FE_0.75  "3.50948025689362" "7.78498886791279" "6.84589605137873"
## FE_Op    "3.18001323799943" "7.64212563321564" "6.78000264759989"
## SE_0.25  "7.19296715345959" "9.81689478492941" "8.7888044462908" 
## SE_0.5   "4.78439625494357" "8.48524235335907" "7.5373410202447" 
## SE_0.75  "2.95196157428025" "7.78598882542578" "6.96078134854723"
## SE_Op    "2.53933580312171" "7.67097517527415" "6.90813244887526"
##          [,4]               [,5]               [,6]               
## accuraci "MPE"              "MAPE"             "ACf1"             
## FE_0.25  "11.1486340863648" "18.8508788168545" "0.389299559325403"
## FE_0.5   "8.10685126767234" "17.4421588885548" "0.389299559325403"
## FE_0.75  "5.45189367004185" "16.4988509392698" "0.389299559325403"
## FE_Op    "4.6336625834998"  "16.4685515592895" "0.389299559325403"
## SE_0.25  "14.7229054056979" "20.0423630484686" "0.387087121554134"
## SE_0.5   "8.5912802170403"  "17.7677627680441" "0.389743073565871"
## SE_0.75  "3.95045353485753" "17.0334602448619" "0.391135725203828"
## SE_Op    "2.91027814952564" "17.0728311623803" "0.391360851182678"
##          [,7]              
## accuraci "Theil's"         
## FE_0.25  "1.30411548112884"
## FE_0.5   "1.24260578440109"
## FE_0.75  "1.21697428694699"
## FE_Op    "1.21467788438302"
## SE_0.25  "1.38958767846755"
## SE_0.5   "1.25759433030555"
## SE_0.75  "1.25206796915104"
## SE_Op    "1.26166735874688"

Dari hasil yang diperoleh, nilai MAPE terkecil yaitu ketika menggunakan metode First Order Eksponensial dengan nilai alpha optimum. Namun, peramalan yang diperoleh pada metode ini menghasilkan nilai ramalan yang sama untuk 5 waktu brturut-turut. Maka, metode ini tidak cocok untuk data musiman. Olehnya itu, saya mencoba menggunakn triple Eksponensial

3. Metode Tambahan

Third Order Eksponensial Smoothing, untuk alpha Optimum

occ.holt.ses3 <- HoltWinters(occ.train, beta= 0.1, gamma= 0.1)
str(occ.holt.ses3)

## List of 9
##  $ fitted      : Time-Series [1:108, 1:4] from 2000 to 2009: 43.9 41.6 36.8 34.3 25 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:4] "xhat" "level" "trend" "season"
##  $ x           : Time-Series [1:120] from 1999 to 2009: 43.7 41 36.5 32.8 24.5 24.1 26 26.2 30.7 29.9 ...
##  $ alpha       : num 0.131
##  $ beta        : num 0.1
##  $ gamma       : num 0.1
##  $ coefficients: Named num [1:14] 37.133 -0.0891 12.3683 10.8029 6.3425 ...
##   ..- attr(*, "names")= chr [1:14] "a" "b" "s1" "s2" ...
##  $ seasonal    : chr "additive"
##  $ SSE         : num 290
##  $ call        : language HoltWinters(x = occ.train, beta = 0.1, gamma = 0.1)
##  - attr(*, "class")= chr "HoltWinters"

occ.holt.ses3$SSE

## [1] 290.4932

occ.holt.ses3$fitted

##              xhat    level        trend    season
## Jan 2000 43.86082 32.04905  0.037805944 11.773958
## Feb 2000 41.56648 32.11825  0.040944730  9.407292
## Mar 2000 36.81197 32.18984  0.044009163  4.578125
## Apr 2000 34.30202 32.24540  0.045164377  2.011458
## May 2000 25.02606 32.29030  0.045137869 -7.309375
## Jun 2000 23.27354 32.34514  0.046108190 -9.117708
## Jul 2000 26.42317 32.42096  0.049080050 -6.046875
## Aug 2000 26.69108 32.53262  0.055337482 -5.896875
## Sep 2000 31.22658 32.61537  0.058079116 -1.446875
## Oct 2000 29.98303 32.28940  0.019673751 -2.326042
## Nov 2000 35.43418 32.50814  0.039580895  2.886458
## Dec 2000 34.22762 32.68759  0.053567582  1.486458
## Jan 2001 45.06184 33.17059  0.096510952 11.794738
## Feb 2001 43.17202 33.61331  0.131131421  9.427579
## Mar 2001 38.69635 33.95808  0.152495369  4.585773
## Apr 2001 36.57802 34.38664  0.180101535  2.011283
## May 2001 27.15836 34.30716  0.154144044 -7.302951
## Jun 2001 25.50899 34.45365  0.153378250 -9.098034
## Jul 2001 28.72479 34.57960  0.150635644 -6.005449
## Aug 2001 29.02744 34.75323  0.152934958 -5.878725
## Sep 2001 33.38288 34.92881  0.155199460 -1.701127
## Oct 2001 32.62881 34.70569  0.117367504 -2.194252
## Nov 2001 37.94419 34.84552  0.119614089  2.979053
## Dec 2001 36.60373 34.73625  0.096725141  1.770753
## Jan 2002 47.12632 34.98996  0.112423806 12.023933
## Feb 2002 44.92437 35.23016  0.125201424  9.569013
## Mar 2002 40.49097 35.57525  0.147190610  4.768532
## Apr 2002 38.37440 36.32728  0.207674686  1.839438
## May 2002 29.16404 36.28898  0.183077041 -7.308021
## Jun 2002 27.47196 36.41116  0.176987485 -9.116191
## Jul 2002 30.66348 36.48685  0.166857076 -5.990227
## Aug 2002 30.94766 36.64537  0.166024075 -5.863733
## Sep 2002 34.86017 36.66079  0.150963309 -1.951584
## Oct 2002 34.32716 36.39705  0.109492505 -2.179379
## Nov 2002 39.54068 36.59483  0.118322171  2.827523
## Dec 2002 38.75803 36.76031  0.123037510  1.874682
## Jan 2003 49.33750 37.08570  0.143272730 12.108524
## Feb 2003 47.00924 37.15844  0.136219178  9.714587
## Mar 2003 42.85833 37.52966  0.159719219  5.168950
## Apr 2003 39.69050 37.83920  0.174701361  1.676596
## May 2003 30.82720 38.00202  0.173513796 -7.348335
## Jun 2003 28.95977 37.98825  0.154784676 -9.183256
## Jul 2003 31.96143 37.83336  0.123817440 -5.995742
## Aug 2003 32.02207 37.87038  0.115137470 -5.963439
## Sep 2003 35.56819 37.70703  0.087289561 -2.226130
## Oct 2003 35.36109 37.43105  0.050962646 -2.120925
## Nov 2003 40.36847 37.46088  0.048848630  2.858740
## Dec 2003 39.51403 37.46137  0.044013267  2.008644
## Jan 2004 49.98452 37.84474  0.077948871 12.061828
## Feb 2004 47.93078 37.97721  0.083401224  9.870162
## Mar 2004 43.55206 38.18781  0.096120299  5.268136
## Apr 2004 40.30110 38.51331  0.119058433  1.668734
## May 2004 31.16346 38.52724  0.108545622 -7.472326
## Jun 2004 29.20255 38.49623  0.094589910 -9.388266
## Jul 2004 32.60296 38.56424  0.091931856 -6.053205
## Aug 2004 32.58544 38.64266  0.090580688 -6.147798
## Sep 2004 36.09946 38.49893  0.067150446 -2.466622
## Oct 2004 36.03646 38.14622  0.025164012 -2.134920
## Nov 2004 40.75818 37.93039  0.001064153  2.826729
## Dec 2004 40.20073 37.96318  0.004237567  2.233305
## Jan 2005 50.15609 38.04606  0.012101808 12.097924
## Feb 2005 48.13202 38.15579  0.021864121  9.954365
## Mar 2005 43.84585 38.38342  0.042440689  5.419991
## Apr 2005 40.43614 38.76104  0.075958702  1.599137
## May 2005 31.01101 38.53043  0.045301680 -7.564716
## Jun 2005 28.92487 38.31183  0.018911221 -9.405863
## Jul 2005 32.38495 38.41933  0.027770890 -6.062150
## Aug 2005 32.05865 38.34409  0.017469974 -6.302912
## Sep 2005 35.29397 38.05204 -0.013482543 -2.744582
## Oct 2005 35.26955 37.61941 -0.055396965 -2.294466
## Nov 2005 40.07205 37.30555 -0.081243294  2.847737
## Dec 2005 39.28812 37.09675 -0.093999429  2.285368
## Jan 2006 49.00084 36.93869 -0.100404968 12.162552
## Feb 2006 46.79948 36.81193 -0.103040591 10.090587
## Mar 2006 42.52208 36.95830 -0.078100110  5.641888
## Apr 2006 38.42605 37.08727 -0.057393175  1.396181
## May 2006 29.12824 36.93459 -0.066921140 -7.739427
## Jun 2006 27.46390 36.87709 -0.065979490 -9.347210
## Jul 2006 30.63443 36.82897 -0.064193428 -6.130345
## Aug 2006 30.20222 36.77338 -0.063332964 -6.507825
## Sep 2006 33.69650 36.77537 -0.056800646 -3.022065
## Oct 2006 34.08122 36.61404 -0.067253149 -2.465575
## Nov 2006 39.34659 36.64112 -0.057820579  2.763289
## Dec 2006 39.00711 36.80027 -0.036122879  2.242962
## Jan 2007 49.07420 36.94694 -0.017844072 12.145104
## Feb 2007 47.45938 37.19494  0.008740447 10.255699
## Mar 2007 43.58910 37.74705  0.063077671  5.778973
## Apr 2007 39.68425 38.24462  0.106526455  1.333103
## May 2007 30.55353 38.19574  0.090985610 -7.733193
## Jun 2007 29.07790 38.31907  0.094220046 -9.335386
## Jul 2007 32.34274 38.37682  0.090573174 -6.124648
## Aug 2007 32.00060 38.38304  0.082138490 -6.464579
## Sep 2007 35.36936 38.38637  0.074256798 -3.091263
## Oct 2007 35.84747 38.20218  0.048412966 -2.403129
## Nov 2007 40.89595 37.96879  0.020231823  2.906933
## Dec 2007 40.31606 37.93706  0.015035786  2.363972
## Jan 2008 50.25704 37.92374  0.012200376 12.321100
## Feb 2008 48.64194 38.00719  0.019325640 10.615424
## Mar 2008 44.42398 38.30972  0.047645777  6.066614
## Apr 2008 40.09370 38.77415  0.089324602  1.230219
## May 2008 30.98210 38.62809  0.065785984 -7.711781
## Jun 2008 29.37385 38.66998  0.063396339 -9.359529
## Jul 2008 32.34579 38.48747  0.038805902 -6.180488
## Aug 2008 31.89736 38.38904  0.025082030 -6.516758
## Sep 2008 34.97514 38.23075  0.006744474 -3.262355
## Oct 2008 35.23951 37.86019 -0.030985830 -2.589695
## Nov 2008 40.54956 37.71903 -0.042002651  2.872534
## Dec 2008 39.64106 37.36870 -0.072835906  2.345201

occupancy.forecast.3 <- forecast(occ.holt.ses3, h = 5)
occupancy.forecast.3

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2009       49.41215 47.30369 51.52060 46.18755 52.63675
## Feb 2009       47.75766 45.62736 49.88797 44.49964 51.01569
## Mar 2009       43.20817 41.05214 45.36419 39.91081 46.50553
## Apr 2009       37.85090 35.66507 40.03672 34.50797 41.19383
## May 2009       28.95979 26.73990 31.17967 25.56477 32.35481

plot(occ.holt.ses3)

ac3 <- accuracy(occupancy.forecast.3$mean, x = occ.test)
ac3

##                 ME      RMSE       MAE       MPE     MAPE       ACF1 Theil's U
## Test set 0.1422679 0.7308488 0.6074853 0.5693121 1.544204 -0.2036131 0.1144312

Kesimpulan

Jika menggunakan metode Simple Eksponensial dalam hal ini digunakan 2 cara yaitu First Order Exponensial dan Second Order Exponensial, diperoleh nila RMSE dan MAPE yang terkecil pada penggunaan metode First Order Eksponensial denga nilai alpha Optimum berturut-turut yaitu 7.6421 16.4685. Namun, nilai MAPE yang dihasilkan oleh metode triple eksponensial dengan alpha optimum menghasilkan nilai RMSE dan MAPE berturut-turut sebesar 0.7308488 dan 1.544204. Kedua metode tersebut menghasilkan nilai akurasi yang sangat signifikan. Hal ini berarti bahwa Data musiman tidak cocok meramalkan suatu kejadian menggunakan metode first and second order eksponensial.