Pemulusan Data Harga Rata-Rata Lelang Plat Nomor Mobil di Shanghai tahun 2002-2019

Library / Packages

Package yang digunakan: forecast, graphics, TTR, TSA. Jika belum ada, install terlebih dahulu.

#install.packages("forecast")
#install.packages("graphics")
#install.packages("TTR")
#install.packages("TSA")

Jika sudah ada, panggil library package tersebut.

library("forecast")

## Warning: package 'forecast' was built under R version 4.2.3

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

library("graphics")
library("TTR")
library("TSA")

## Warning: package 'TSA' was built under R version 4.2.3

## Registered S3 methods overwritten by 'TSA':
##   method       from    
##   fitted.Arima forecast
##   plot.Arima   forecast

## 
## Attaching package: 'TSA'

## The following objects are masked from 'package:stats':
## 
##     acf, arima

## The following object is masked from 'package:utils':
## 
##     tar

Data Preparation

#setwd("C:/Users/LENOVO/Documents/MPDW/mpdw/P1")
#library(readxl)
#dt <- read_xlsx("Data_Shanghai.xlsx")
#write.table(dt, "Data_Shanghai.csv", sep=",", row.names = F)
#coba <- read.csv("Data_Shanghai.csv")

Impor Data

#install.packages("rio") #install jika belum ada
library(rio)
datashanghai <- import("https://raw.githubusercontent.com/aidara11/mpdw/main/Data/Data_Shanghai.csv")

Eksplorasi Data

View(datashanghai)    #melihat data
str(datashanghai)     #struktur data

## 'data.frame':    204 obs. of  2 variables:
##  $ Date         : IDate, format: "2002-01-01" "2002-02-01" ...
##  $ Average price: int  14735 14057 14662 16334 18357 20178 20904 21601 24040 27040 ...

dim(datashanghai)     #dimensi data

## [1] 204   2

Mengubah data agar terbaca sebagai data deret waktu

datashanghai.ts <- ts(datashanghai$`Average price`)  
str(datashanghai.ts)

##  Time-Series [1:204] from 1 to 204: 14735 14057 14662 16334 18357 20178 20904 21601 24040 27040 ...

Menampilkan ringkasan data

summary(datashanghai.ts)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   14057   34932   46037   54358   78142   93540

Membuat plot

ts.plot(datashanghai.ts, xlab="Time Period", ylab="Average Price", 
        main = "Harga Rata-Rata Lelang Plat Nomor Mobil di Shanghai")
#membuat titik2 di plot data
points(datashanghai.ts)

Pada plot data deret waktu tersebut, dapat terlihat bahwa data berpola trend karena terjadi kenaikan sekuler jangka panjang (perubahan sistematis selama periode waktu yang panjang) dalam data. Oleh karena itu, metode pemulusan yang cocok adalah Double Moving Average (DMA) dan Double Exponential Smoothing (DES).

Pemulusan (Smoothing)

1. Double Moving Average (DMA)

Pembagian Data

#membagi 80% data latih (training) dan 20% data uji (testing)
training_ma <- datashanghai[1:163,]
testing_ma <- datashanghai[164:204,]
train_ma.ts <- ts(training_ma$`Average price`)
test_ma.ts <- ts(testing_ma$`Average price`)

Eksplorasi Data

Eksplorasi data dilakukan pada keseluruhan data, data latih serta data uji menggunakan plot data deret waktu.

#eksplorasi keseluruhan data
plot(datashanghai.ts, col="green",main="Plot semua data")
points(datashanghai.ts)

#eksplorasi data latih
plot(train_ma.ts, col="orange",main="Plot data latih")
points(train_ma.ts)

#eksplorasi data uji
plot(test_ma.ts, col="orange",main="Plot data uji")
points(test_ma.ts)

Eksplorasi data juga dapat dilakukan menggunakan package ggplot2 .

#Eksplorasi dengan GGPLOT

library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.2.3

ggplot() + 
  geom_line(data = training_ma, aes(x = Date, y = `Average price`, col = "Data Latih")) +
  geom_line(data = testing_ma, aes(x = Date, y = `Average price`, col = "Data Uji")) +
  labs(x = "Periode Waktu", y = "Harga Rata-rata", color = "Legend") +
  scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
                      values = c("orange", "blue")) + 
  theme_bw() + theme(legend.position = "bottom",
                     plot.caption = element_text(hjust=0.5, size=12))

Metode DMA

Metode pemulusan Double Moving Average (DMA) pada dasarnya mirip dengan Single Moving Average (SMA). Namun demikian, metode ini lebih cocok digunakan untuk pola data trend. Proses pemulusan dengan rata rata dalam metode ini dilakukan sebanyak 2 kali.

data.sma <- SMA(train_ma.ts, n=4)

dma <- SMA(data.sma, n = 4)
At <- 2*data.sma - dma
Bt <- 2/(4-1)*(data.sma - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)

t = 1:41
f = c()

for (i in t) {
  f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}

data.gab2 <- cbind(aktual = c(train_ma.ts,rep(NA,41)), pemulusan1 = c(data.sma,rep(NA,41)),pemulusan2 = c(data.dma, rep(NA,41)),At = c(At, rep(NA,41)), Bt = c(Bt,rep(NA,41)),ramalan = c(data.ramal2, f[-1]))
data.gab2

##        aktual pemulusan1 pemulusan2       At           Bt   ramalan
##   [1,]  14735         NA         NA       NA           NA        NA
##   [2,]  14057         NA         NA       NA           NA        NA
##   [3,]  14662         NA         NA       NA           NA        NA
##   [4,]  16334   14947.00         NA       NA           NA        NA
##   [5,]  18357   15852.50         NA       NA           NA        NA
##   [6,]  20178   17382.75         NA       NA           NA        NA
##   [7,]  20904   18943.25   22546.38 21105.12  1441.250000        NA
##   [8,]  21601   20260.00   23843.96 22410.38  1433.583333  22546.38
##   [9,]  24040   21680.75   25204.19 23794.81  1409.375000  23843.96
##  [10,]  27040   23396.25   27273.23 25722.44  1550.791667  25204.19
##  [11,]  31721   26100.50   31502.38 29341.62  2160.750000  27273.23
##  [12,]  27848   27662.25   32582.77 30614.56  1968.208333  31502.38
##  [13,]  24267   27719.00   30218.17 29218.50   999.666667  32582.77
##  [14,]  25254   27272.50   27412.40 27356.44    55.958333  30218.17
##  [15,]  29551   26730.00   25703.44 26114.06  -410.625000  27412.40
##  [16,]  34845   28479.25   30027.69 29408.31   619.375000  25703.44
##  [17,]  36903   31638.25   36818.67 34746.50  2072.166667  30027.69
##  [18,]  37667   34741.50   41981.92 39085.75  2896.166667  36818.67
##  [19,]  38269   36921.00   43547.67 40897.00  2650.666667  41981.92
##  [20,]  39369   38052.00   42575.02 40765.81  1809.208333  43547.67
##  [21,]  38728   38508.25   40929.19 39960.81   968.375000  42575.02
##  [22,]  34842   37802.00   37770.65 37783.19   -12.541667  40929.19
##  [23,]  34284   36805.75   35162.00 35819.50  -657.500000  37770.65
##  [24,]  38054   36477.00   34941.58 35555.75  -614.166667  35162.00
##  [25,]  39516   36674.00   36231.19 36408.31  -177.125000  34941.58
##  [26,]  40053   37976.75   39632.38 38970.12   662.250000  36231.19
##  [27,]  43333   40239.00   44234.52 42636.31  1598.208333  39632.38
##  [28,]  45492   42098.50   46850.90 44949.94  1900.958333  44234.52
##  [29,]  34226   40776.00   41615.06 41279.44   335.625000  46850.90
##  [30,]  21001   36013.00   29731.96 32244.38 -2512.416667  41615.06
##  [31,]  23544   31065.75   20361.48 24643.19 -4281.708333  29731.96
##  [32,]  25991   26190.50   13989.15 18869.69 -4880.541667  20361.48
##  [33,]  30033   25142.25   17707.88 20681.62 -2973.750000  13989.15
##  [34,]  29768   27334.00   27168.79 27234.88   -66.083333  17707.88
##  [35,]  27620   28353.00   31016.44 29951.06  1065.375000  27168.79
##  [36,]  30282   29425.75   32529.08 31287.75  1241.333333  31016.44
##  [37,]  32520   30047.50   32143.23 31304.94   838.291667  32529.08
##  [38,]  32425   30711.75   32507.17 31789.00   718.166667  32143.23
##  [39,]  34684   32477.75   35497.85 34289.81  1208.041667  32507.17
##  [40,]  37355   34246.00   38204.75 36621.25  1583.500000  35497.85
##  [41,]  35661   35031.25   38222.19 36945.81  1276.375000  38204.75
##  [42,]  37479   36294.75   39265.27 38077.06  1188.208333  38222.19
##  [43,]  38378   37218.25   39752.73 38738.94  1013.791667  39265.27
##  [44,]  35905   36855.75   37698.67 37361.50   337.166667  39752.73
##  [45,]  28927   35172.25   33150.58 33959.25  -808.666667  37698.67
##  [46,]  26385   32398.75   27377.92 29386.25 -2008.333333  33150.58
##  [47,]  30320   30384.25   24853.42 27065.75 -2212.333333  27377.92
##  [48,]  36749   30595.25   28024.62 29052.88 -1028.250000  24853.42
##  [49,]  31220   31168.50   31221.52 31200.31    21.208333  28024.62
##  [50,]  34887   33294.00   36516.50 35227.50  1289.000000  31221.52
##  [51,]  38932   35447.00   40148.35 38267.81  1880.541667  36516.50
##  [52,]  38326   35841.25   39013.85 37744.81  1269.041667  40148.35
##  [53,]  38139   37571.00   40958.81 39603.69  1355.125000  39013.85
##  [54,]  39752   38787.25   41913.29 40662.88  1250.416667  40958.81
##  [55,]  39966   39045.75   41103.15 40280.19   822.958333  41913.29
##  [56,]  40459   39579.00   40967.75 40412.25   555.500000  41103.15
##  [57,]  41601   40444.50   42078.46 41424.88   653.583333  40967.75
##  [58,]  37899   39981.25   40345.62 40199.88   145.750000  42078.46
##  [59,]  38460   39604.75   39108.71 39307.12  -198.416667  40345.62
##  [60,]  40518   39619.50   39131.17 39326.50  -195.333333  39108.71
##  [61,]  40974   39462.75   39122.23 39258.44  -136.208333  39131.17
##  [62,]  40473   40106.25   40786.15 40514.19   271.958333  39122.23
##  [63,]  41573   40884.50   42328.25 41750.75   577.500000  40786.15
##  [64,]  43623   41660.75   43547.73 42792.94   754.791667  42328.25
##  [65,]  44853   42630.50   44813.83 43940.50   873.333333  43547.73
##  [66,]  47711   44440.00   47833.44 46476.06  1357.375000  44813.83
##  [67,]  46581   45692.00   49168.98 47778.19  1390.791667  47833.44
##  [68,]  46897   46510.50   49330.92 48202.75  1128.166667  49168.98
##  [69,]  49631   47705.00   50401.88 49323.12  1078.750000  49330.92
##  [70,]  51000   48527.25   50891.52 49945.81   945.708333  50401.88
##  [71,]  54317   50461.25   54061.67 52621.50  1440.166667  50891.52
##  [72,]  56042   52747.50   57559.58 55634.75  1924.833333  54061.67
##  [73,]  23370   46182.25   40686.73 42884.94 -2198.208333  57559.58
##  [74,]  32169   41474.50   31071.38 35232.62 -4161.250000  40686.73
##  [75,]  37659   37310.00   25445.73 30191.44 -4745.708333  31071.38
##  [76,]  36047   32311.25   20630.83 25303.00 -4672.166667  25445.73
##  [77,]  34947   35205.50   32922.48 33835.69  -913.208333  20630.83
##  [78,]  34491   35786.00   36840.69 36418.81   421.875000  32922.48
##  [79,]  36460   35486.25   36801.25 36275.25   526.000000  36840.69
##  [80,]  31788   34421.50   33082.65 33618.19  -535.541667  36801.25
##  [81,]  33224   33990.75   32440.12 33060.38  -620.250000  33082.65
##  [82,]  24351   31455.75   27484.40 29072.94 -1588.541667  32440.12
##  [83,]  31665   30257.00   26466.58 27982.75 -1516.166667  27484.40
##  [84,]  29399   29659.75   26857.98 27978.69 -1120.708333  26466.58
##  [85,]  33394   29702.25   28758.19 29135.81  -377.625000  26857.98
##  [86,]  27552   30502.50   31289.38 30974.62   314.750000  28758.19
##  [87,]  28724   29767.25   29532.77 29626.56   -93.791667  31289.38
##  [88,]  29100   29692.50   29319.79 29468.88  -149.083333  29532.77
##  [89,]  30363   28934.75   27618.92 28145.25  -526.333333  29319.79
##  [90,]  32522   30177.25   31067.77 30711.56   356.208333  27618.92
##  [91,]  36231   32054.00   35119.62 33893.38  1226.250000  31067.77
##  [92,]  29500   32154.00   34360.67 33478.00   882.666667  35119.62
##  [93,]  34402   33163.75   35291.25 34440.25   851.000000  34360.67
##  [94,]  35317   33862.50   35619.06 34916.44   702.625000  35291.25
##  [95,]  37593   34203.00   35631.65 35060.19   571.458333  35619.06
##  [96,]  38311   36405.75   39734.08 38402.75  1331.333333  35631.65
##  [97,]  38620   37460.25   40755.88 39437.62  1318.250000  39734.08
##  [98,]  39882   38601.50   41824.62 40535.38  1289.250000  40755.88
##  [99,]  41637   39612.50   42266.67 41205.00  1061.666667  41824.62
## [100,]  42262   40600.25   43152.96 42131.88  1021.083333  42266.67
## [101,]  40380   41040.25   42834.62 42116.88   717.750000  43152.96
## [102,]  39362   40910.25   41525.98 41279.69   246.291667  42834.62
## [103,]  40169   40543.25   40159.50 40313.00  -153.500000  41525.98
## [104,]  42180   40522.75   40137.12 40291.38  -154.250000  40159.50
## [105,]  43271   41245.50   41978.94 41685.56   293.375000  40137.12
## [106,]  45291   42727.75   45174.31 44195.69   978.625000  41978.94
## [107,]  15970   36678.00   30652.17 33062.50 -2410.333333  45174.31
## [108,]  38771   35825.75   30336.58 32532.25 -2195.666667  30652.17
## [109,]  44627   36164.75   33357.56 34480.44 -1122.875000  30336.58
## [110,]  46657   36506.25   36860.52 36718.81   141.708333  33357.56
## [111,]  47399   44363.50   54610.90 50511.94  4098.958333  36860.52
## [112,]  47700   46595.75   56076.06 52283.94  3792.125000  54610.90
## [113,]  48855   47652.75   54108.06 51525.94  2582.125000  56076.06
## [114,]  51174   48782.00   52004.50 50715.50  1289.000000  54108.06
## [115,]  52228   49989.25   52879.77 51723.56  1156.208333  52004.50
## [116,]  52622   51219.75   54234.44 53028.56  1205.875000  52879.77
## [117,]  54008   52508.00   55646.75 54391.25  1255.500000  54234.44
## [118,]  47635   51623.25   52103.56 51911.44   192.125000  55646.75
## [119,]  51437   51425.50   50977.79 51156.88  -179.083333  52103.56
## [120,]  53195   51568.75   51214.38 51356.12  -141.750000  50977.79
## [121,]  55632   51974.75   52519.23 52301.44   217.791667  51214.38
## [122,]  58625   54722.25   58554.65 57021.69  1532.958333  52519.23
## [123,]  61626   57269.50   62912.31 60655.19  2257.125000  58554.65
## [124,]  64367   60062.50   66821.25 64117.75  2703.500000  62912.31
## [125,]  58227   60711.25   64911.04 63231.12  1679.916667  66821.25
## [126,]  58271   60622.75   62216.50 61579.00   637.500000  64911.04
## [127,]  62559   60856.00   61344.12 61148.88   195.250000  62216.50
## [128,]  66425   61370.50   62171.12 61850.88   320.250000  61344.12
## [129,]  66708   63490.75   66667.00 65396.50  1270.500000  62171.12
## [130,]  66946   65659.50   70351.69 68474.81  1876.875000  66667.00
## [131,]  69346   67356.25   72167.92 70243.25  1924.666667  70351.69
## [132,]  75332   69583.00   74684.04 72643.62  2040.416667  72167.92
## [133,]  83571   73798.75   81631.04 78498.12  3132.916667  74684.04
## [134,]  91898   80036.75   92275.19 87379.81  4895.375000  81631.04
## [135,]  84101   83725.50   95291.33 90665.00  4626.333333  92275.19
## [136,]  80803   85093.25   92476.06 89522.94  2953.125000  95291.33
## [137,]  77823   83656.25   84536.77 84184.56   352.208333  92476.06
## [138,]  76465   79798.00   74347.58 76527.75 -2180.166667  84536.77
## [139,]  74939   77507.50   70830.42 73501.25 -2670.833333  74347.58
## [140,]  73492   75679.75   69878.71 72199.12 -2320.416667  70830.42
## [141,]  83723   77154.75   76521.00 76774.50  -253.500000  69878.71
## [142,]  75717   76967.75   77201.60 77108.06    93.541667  76521.00
## [143,]  76093   77256.25   78075.62 77747.88   327.750000  77201.60
## [144,]  73501   77258.50   77423.81 77357.69    66.125000  78075.62
## [145,]  73357   74667.00   71549.71 72796.62 -1246.916667  77423.81
## [146,]  73872   74205.75   71470.54 72564.62 -1094.083333  71549.71
## [147,]  74113   73710.75   71627.83 72461.00  -833.166667  71470.54
## [148,]  74503   73961.25   73669.69 73786.31  -116.625000  71627.83
## [149,]  73896   74096.00   74266.94 74198.56    68.375000  73669.69
## [150,]  74680   74298.00   74767.17 74579.50   187.666667  74266.94
## [151,]  73785   74216.00   74337.98 74289.19    48.791667  74767.17
## [152,]  73875   74059.00   73878.58 73950.75   -72.166667  74337.98
## [153,]  74075   74103.75   73994.69 74038.31   -43.625000  73878.58
## [154,]  73633   73842.00   73486.69 73628.81  -142.125000  73994.69
## [155,]  73687   73817.50   73587.40 73679.44   -92.041667  73486.69
## [156,]  74216   73902.75   73879.83 73889.00    -9.166667  73587.40
## [157,]  76618   74538.50   75394.02 75051.81   342.208333  73879.83
## [158,]  74830   74837.75   75777.12 75401.38   375.750000  75394.02
## [159,]  80759   76605.75   79330.02 78240.31  1089.708333  75777.12
## [160,]  79099   77826.50   80950.46 79700.88  1249.583333  79330.02
## [161,]  80020   78677.00   81494.08 80367.25  1126.833333  80950.46
## [162,]  83171   80762.25   84586.21 83056.62  1529.583333  81494.08
## [163,]  82642   81233.00   83913.52 82841.31  1072.208333  84586.21
## [164,]     NA         NA         NA       NA           NA  83913.52
## [165,]     NA         NA         NA       NA           NA  84985.73
## [166,]     NA         NA         NA       NA           NA  86057.94
## [167,]     NA         NA         NA       NA           NA  87130.15
## [168,]     NA         NA         NA       NA           NA  88202.35
## [169,]     NA         NA         NA       NA           NA  89274.56
## [170,]     NA         NA         NA       NA           NA  90346.77
## [171,]     NA         NA         NA       NA           NA  91418.98
## [172,]     NA         NA         NA       NA           NA  92491.19
## [173,]     NA         NA         NA       NA           NA  93563.40
## [174,]     NA         NA         NA       NA           NA  94635.60
## [175,]     NA         NA         NA       NA           NA  95707.81
## [176,]     NA         NA         NA       NA           NA  96780.02
## [177,]     NA         NA         NA       NA           NA  97852.23
## [178,]     NA         NA         NA       NA           NA  98924.44
## [179,]     NA         NA         NA       NA           NA  99996.65
## [180,]     NA         NA         NA       NA           NA 101068.85
## [181,]     NA         NA         NA       NA           NA 102141.06
## [182,]     NA         NA         NA       NA           NA 103213.27
## [183,]     NA         NA         NA       NA           NA 104285.48
## [184,]     NA         NA         NA       NA           NA 105357.69
## [185,]     NA         NA         NA       NA           NA 106429.90
## [186,]     NA         NA         NA       NA           NA 107502.10
## [187,]     NA         NA         NA       NA           NA 108574.31
## [188,]     NA         NA         NA       NA           NA 109646.52
## [189,]     NA         NA         NA       NA           NA 110718.73
## [190,]     NA         NA         NA       NA           NA 111790.94
## [191,]     NA         NA         NA       NA           NA 112863.15
## [192,]     NA         NA         NA       NA           NA 113935.35
## [193,]     NA         NA         NA       NA           NA 115007.56
## [194,]     NA         NA         NA       NA           NA 116079.77
## [195,]     NA         NA         NA       NA           NA 117151.98
## [196,]     NA         NA         NA       NA           NA 118224.19
## [197,]     NA         NA         NA       NA           NA 119296.40
## [198,]     NA         NA         NA       NA           NA 120368.60
## [199,]     NA         NA         NA       NA           NA 121440.81
## [200,]     NA         NA         NA       NA           NA 122513.02
## [201,]     NA         NA         NA       NA           NA 123585.23
## [202,]     NA         NA         NA       NA           NA 124657.44
## [203,]     NA         NA         NA       NA           NA 125729.65
## [204,]     NA         NA         NA       NA           NA 126801.85

Visualisasi hasil pemulusan metode DMA

ts.plot(datashanghai.ts, xlab="Time Period ", ylab="Average Price", main= "DMA N=4 Data Shanghai Car License Plate Auction Average Price")
points(datashanghai.ts)
lines(data.gab2[,3],col="green",lwd=2)
lines(data.gab2[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.8)

Selanjutnya perhitungan akurasi dilakukan baik pada data latih maupun data uji. Perhitungan akurasi dilakukan dengan ukuran Sum Squares Error (SSE), Mean Square Error (MSE) dan Mean Absolute Percentage Error (MAPE).

Akurasi Data Latih

#Menghitung nilai keakuratan data latih

error_train.dma = train_ma.ts-data.ramal2[1:length(train_ma.ts)]
SSE_train.dma = sum(error_train.dma[8:length(train_ma.ts)]^2)
MSE_train.dma = mean(error_train.dma[8:length(train_ma.ts)]^2)
MAPE_train.dma = mean(abs((error_train.dma[8:length(train_ma.ts)]/train_ma.ts[8:length(train_ma.ts)])*100))

akurasi_train.dma <- matrix(c(SSE_train.dma, MSE_train.dma, MAPE_train.dma))
row.names(akurasi_train.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.dma) <- c("Akurasi m = 4")
akurasi_train.dma

##      Akurasi m = 4
## SSE   6.677238e+09
## MSE   4.280281e+07
## MAPE  1.159579e+01

Semakin kecil SSE, MSE, dan MAPE maka semakin akurat sebuah model dalam melakukan peramalan. Perhitungan akurasi pada data latih menggunakan nilai MAPE menghasilkan nilai MAPE diantara 10-20 sehingga nilai akurasi ini dapat dikategorikan baik. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.

Akurasi Data Uji

#Menghitung nilai keakuratan data uji

error_test.dma = test_ma.ts-data.gab2[164:204,6]
SSE_test.dma = sum(error_test.dma^2)
MSE_test.dma = mean(error_test.dma^2)
MAPE_test.dma = mean(abs((error_test.dma/test_ma.ts*100)))

akurasi_test.dma <- matrix(c(SSE_test.dma, MSE_test.dma, MAPE_test.dma))
row.names(akurasi_test.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.dma) <- c("Akurasi m = 4")
akurasi_test.dma

##      Akurasi m = 4
## SSE   1.789688e+10
## MSE   4.365094e+08
## MAPE  1.989137e+01

Perhitungan akurasi pada data uji menghasilkan nilai MAPE di antara 10-20 sehingga nilai akurasi ini dapat dikategorikan sebagai baik.

2. Double Exponential Smoothing (DES)

Metode Exponential Smoothing adalah metode pemulusan dengan melakukan pembobotan menurun secara eksponensial. Nilai yang lebih baru diberi bobot yang lebih besar dari nilai terdahulu. Terdapat satu atau lebih parameter pemulusan yang ditentukan secara eksplisit dan hasil pemilihan parameter tersebut akan menentukan bobot yang akan diberikan pada nilai pengamatan.

Ada dua macam model, yaitu model tunggal dan ganda. Model tunggal atau Single Exponential Smoothing (SES) merupakan metode pemulusan yang tepat untuk data dengan pola stasioner atau konstan. Sedangkan model ganda atau Double Exponential Smoothing (DES) untuk data berpola tren. Data harga rata-rata lelang plat nomor mobil di Shanghai berpola tren sehingga menggunakan metode pemulusan DES.

Pembagian Data

Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.

#membagi 80% data latih (training) dan 20% data uji (testing)
training <- datashanghai[1:163,]
testing  <- datashanghai[164:204,]
train.ts <- ts(training$'Average price')
test.ts  <- ts(testing$'Average price')

Eksplorasi Data

Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.

#eksplorasi data
plot(datashanghai.ts, col="black",main="Plot semua data")
points(datashanghai.ts)

plot(train.ts, col="purple",main="Plot data latih")
points(train.ts)

plot(test.ts, col="red",main="Plot data uji")
points(test.ts)

Eksplorasi data juga dapat dilakukan menggunakan package ggplot2 .

#Eksplorasi dengan GGPLOT
library(ggplot2)
ggplot() + 
  geom_line(data = training, aes(x = Date, y = `Average price`, col = "Data Latih")) +
  geom_line(data = testing, aes(x = Date, y = `Average price`, col = "Data Uji")) +
  labs(x = "Periode Waktu", y = "Harga Rata-rata", color = "Legend") +
  scale_colour_manual(name="Keterangan:", breaks = c("Data Latih", "Data Uji"),
                      values = c("purple", "red")) + 
  theme_bw() + theme(legend.position = "bottom",
                     plot.caption = element_text(hjust=0.5, size=12))

Metode DES

Metode pemulusan DES digunakan untuk data yang memiliki pola tren. Metode DES adalah metode semacam SES, hanya saja dilakukan dua kali, yaitu pertama untuk tahapan ‘level’ dan kedua untuk tahapan ‘tren’. Pemulusan menggunakan metode ini akan menghasilkan peramalan tidak konstan untuk periode berikutnya.

Pemulusan dengan metode DES ini akan menggunakan fungsi HoltWinters() . Nilai argumen beta diinisialisasi bersamaan dengan nilai alpha dan nilai argumen gamma dibuat FALSE.

#beta=0.2 dan alpha=0.2
des.1<- HoltWinters(train.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)
plot(des.1)

#ramalan
ramalandes1<- forecast(des.1, h=41)     #h = panjang periode
ramalandes1

##     Point Forecast    Lo 80     Hi 80    Lo 95     Hi 95
## 164       81008.37 72884.16  89132.58 68583.46  93433.28
## 165       81950.30 73595.39  90305.22 69172.56  94728.04
## 166       82892.24 74233.18  91551.29 69649.35  96135.12
## 167       83834.17 74793.27  92875.07 70007.30  97661.04
## 168       84776.10 75273.90  94278.31 70243.73  99308.47
## 169       85718.04 75675.51  95760.56 70359.32 101076.76
## 170       86659.97 76000.21  97319.73 70357.27 102962.67
## 171       87601.90 76251.24  98952.57 70242.56 104961.24
## 172       88543.84 76432.49 100655.18 70021.13 107066.54
## 173       89485.77 76548.10 102423.44 69699.31 109272.22
## 174       90427.70 76602.21 104253.19 69283.44 111571.97
## 175       91369.63 76598.75 106140.52 68779.52 113959.75
## 176       92311.57 76541.38 108081.75 68193.15 116429.98
## 177       93253.50 76433.44 110073.57 67529.43 118977.57
## 178       94195.43 76277.91 112112.96 66792.94 121597.93
## 179       95137.37 76077.47 114197.26 65987.77 124286.96
## 180       96079.30 75834.52 116324.08 65117.58 127041.03
## 181       97021.23 75551.17 118491.30 64185.60 129856.87
## 182       97963.17 75229.30 120697.03 63194.72 132731.62
## 183       98905.10 74870.61 122939.59 62147.51 135662.69
## 184       99847.03 74476.58 125217.48 61046.28 138647.79
## 185      100788.97 74048.58 127529.36 59893.07 141684.86
## 186      101730.90 73587.80 129874.00 58689.74 144772.06
## 187      102672.83 73095.34 132250.33 57437.96 147907.71
## 188      103614.77 72572.19 134657.34 56139.24 151090.29
## 189      104556.70 72019.25 137094.15 54794.97 154318.44
## 190      105498.63 71437.34 139559.93 53406.38 157590.88
## 191      106440.57 70827.22 142053.92 51974.65 160906.49
## 192      107382.50 70189.57 144575.43 50500.82 164264.18
## 193      108324.43 69525.04 147123.83 48985.88 167662.98
## 194      109266.37 68834.22 149698.51 47430.73 171102.00
## 195      110208.30 68117.66 152298.94 45836.22 174580.38
## 196      111150.23 67375.87 154924.59 44203.13 178097.34
## 197      112092.17 66609.34 157574.99 42532.18 181652.15
## 198      113034.10 65818.51 160249.69 40824.08 185244.12
## 199      113976.03 65003.80 162948.26 39079.47 188872.60
## 200      114917.97 64165.62 165670.31 37298.95 192536.98
## 201      115859.90 63304.34 168415.46 35483.10 196236.69
## 202      116801.83 62420.31 171183.35 33632.47 199971.19
## 203      117743.77 61513.88 173973.65 31747.57 203739.96
## 204      118685.70 60585.36 176786.04 29828.90 207542.50

#beta=0.3 dan aplha=0.6
des.2<- HoltWinters(train.ts, gamma = FALSE, beta = 0.3, alpha = 0.6)
plot(des.2)

#ramalan
ramalandes2<- forecast(des.2, h=41)
ramalandes2

##     Point Forecast      Lo 80     Hi 80       Lo 95     Hi 95
## 164       84212.92  77069.817  91356.01   73288.489  95137.34
## 165       85356.20  76297.132  94415.27   71501.549  99210.86
## 166       86499.49  75137.696  97861.28   69123.126 103875.85
## 167       87642.78  73664.188 101621.37   66264.370 109021.18
## 168       88786.06  71924.720 105647.41   62998.864 114573.26
## 169       89929.35  69951.649 109907.05   59376.092 120482.61
## 170       91072.64  67767.740 114377.54   55430.871 126714.40
## 171       92215.93  65389.811 119042.04   51188.924 133242.93
## 172       93359.21  62830.844 123887.58   46670.102 140048.32
## 173       94502.50  60101.231 128903.77   41890.300 147114.70
## 174       95645.79  57209.545 134082.03   36862.628 154428.94
## 175       96789.07  54163.028 139415.12   31598.162 161979.99
## 176       97932.36  50967.916 144896.81   26106.440 169758.28
## 177       99075.65  47629.668 150521.63   20395.811 177755.48
## 178      100218.93  44153.121 156284.75   14473.672 185964.20
## 179      101362.22  40542.610 162181.83    8346.652 194377.79
## 180      102505.51  36802.050 168208.97    2020.740 202990.28
## 181      103648.80  32935.010 174362.58   -4498.608 211796.20
## 182      104792.08  28944.757 180639.41  -11206.392 220790.56
## 183      105935.37  24834.305 187036.44  -18098.005 229968.75
## 184      107078.66  20606.445 193550.87  -25169.179 239326.49
## 185      108221.94  16263.772 200180.12  -32415.944 248859.83
## 186      109365.23  11808.709 206921.75  -39834.595 258565.06
## 187      110508.52   7243.527 213773.51  -47421.658 268438.70
## 188      111651.81   2570.357 220733.25  -55173.873 278477.49
## 189      112795.09  -2208.789 227798.97  -63088.166 288678.35
## 190      113938.38  -7092.014 234968.77  -71161.634 299038.39
## 191      115081.67 -12077.520 242240.85  -79391.527 309554.86
## 192      116224.95 -17163.603 249613.51  -87775.240 320225.15
## 193      117368.24 -22348.642 257085.13  -96310.293 331046.78
## 194      118511.53 -27631.094 264654.15 -104994.326 342017.38
## 195      119654.82 -33009.488 272319.12 -113825.089 353134.72
## 196      120798.10 -38482.417 280078.62 -122800.431 364396.64
## 197      121941.39 -44048.537 287931.32 -131918.297 375801.08
## 198      123084.68 -49706.560 295875.91 -141176.715 387346.07
## 199      124227.96 -55455.249 303911.18 -150573.796 399029.72
## 200      125371.25 -61293.419 312035.92 -160107.726 410850.23
## 201      126514.54 -67219.929 320249.01 -169776.761 422805.84
## 202      127657.83 -73233.682 328549.33 -179579.222 434894.87
## 203      128801.11 -79333.621 336935.85 -189513.493 447115.72
## 204      129944.40 -85518.726 345407.53 -199578.014 459466.81

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.

Visualisasi hasil pemulusan metode DES

Selanjutnya jika ingin membandingkan plot data latih dan data uji adalah sebagai berikut.

#Visually evaluate the prediction
plot(datashanghai.ts)
lines(des.1$fitted[,1], lty=2, col="purple")
lines(ramalandes1$mean, col="red")

Untuk mendapatkan nilai parameter optimum dari DES, argumen alpha dan beta dapat dibuat NULL seperti berikut.

#Lamda dan gamma optimum
des.opt<- HoltWinters(train.ts, gamma = FALSE)
des.opt

## Holt-Winters exponential smoothing with trend and without seasonal component.
## 
## Call:
## HoltWinters(x = train.ts, gamma = FALSE)
## 
## Smoothing parameters:
##  alpha: 0.722304
##  beta : 0.01760668
##  gamma: FALSE
## 
## Coefficients:
##         [,1]
## a 82689.1861
## b   430.9262

plot(des.opt)

#ramalan
ramalandesopt<- forecast(des.opt, h=41)   #h = panjang periode
ramalandesopt

##     Point Forecast    Lo 80     Hi 80    Lo 95     Hi 95
## 164       83120.11 76567.48  89672.74 73098.73  93141.50
## 165       83551.04 75418.76  91683.32 71113.79  95988.28
## 166       83981.96 74487.73  93476.20 69461.78  98502.15
## 167       84412.89 73690.45  95135.33 68014.33 100811.45
## 168       84843.82 72984.71  96702.92 66706.88 102980.75
## 169       85274.74 72345.81  98203.67 65501.65 105047.84
## 170       85705.67 71757.86  99653.48 64374.34 107037.00
## 171       86136.60 71209.95 101063.24 63308.27 108964.92
## 172       86567.52 70694.25 102440.79 62291.44 110843.60
## 173       86998.45 70204.88 103792.01 61314.90 112681.99
## 174       87429.37 69737.35 105121.40 60371.76 114486.99
## 175       87860.30 69288.11 106432.49 59456.59 116264.01
## 176       88291.23 68854.32 107728.13 58565.05 118017.41
## 177       88722.15 68433.66 109010.64 57693.59 119750.72
## 178       89153.08 68024.22 110281.93 56839.28 121466.87
## 179       89584.00 67624.39 111543.62 55999.68 123168.33
## 180       90014.93 67232.82 112797.04 55172.70 124857.16
## 181       90445.86 66848.34 114043.37 54356.57 126535.14
## 182       90876.78 66469.97 115283.60 53549.78 128203.78
## 183       91307.71 66096.83 116518.59 52751.00 129864.42
## 184       91738.64 65728.18 117749.09 51959.08 131518.19
## 185       92169.56 65363.36 118975.76 51173.01 133166.11
## 186       92600.49 65001.78 120199.20 50391.90 134809.07
## 187       93031.41 64642.92 121419.90 49614.96 136447.86
## 188       93462.34 64286.34 122638.34 48841.49 138083.19
## 189       93893.27 63931.60 123854.93 48070.86 139715.67
## 190       94324.19 63578.36 125070.02 47302.50 141345.88
## 191       94755.12 63226.28 126283.96 46535.92 142974.32
## 192       95186.04 62875.05 127497.04 45770.64 144601.45
## 193       95616.97 62524.41 128709.53 45006.27 146227.67
## 194       96047.90 62174.11 129921.68 44242.42 147853.38
## 195       96478.82 61823.93 131133.71 43478.75 149478.90
## 196       96909.75 61473.67 132345.83 42714.94 151104.56
## 197       97340.68 61123.13 133558.22 41950.73 152730.63
## 198       97771.60 60772.16 134771.05 41185.83 154357.37
## 199       98202.53 60420.58 135984.48 40420.02 155985.03
## 200       98633.45 60068.26 137198.65 39653.08 157613.83
## 201       99064.38 59715.07 138413.69 38884.80 159243.96
## 202       99495.31 59360.88 139629.74 38114.99 160875.62
## 203       99926.23 59005.58 140846.89 37343.49 162508.97
## 204      100357.16 58649.07 142065.25 36570.14 164144.18

Selanjutnya akan dilakukan perhitungan akurasi pada data latih maupun data uji dengan ukuran akurasi SSE, MSE dan MAPE.

Akurasi Data Latih

#Akurasi Data Training
ssedes.train1<-des.1$SSE
msedes.train1<-ssedes.train1/length(train.ts)
sisaandes1<-ramalandes1$residuals
head(sisaandes1)

## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA       NA 1283.000 3325.080 5176.741 6249.000

mapedes.train1 <- sum(abs(sisaandes1[3:length(train.ts)]/train.ts[3:length(train.ts)])
                      *100)/length(train.ts)

akurasides.1 <- matrix(c(ssedes.train1,msedes.train1,mapedes.train1))
row.names(akurasides.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.1) <- c("Akurasi lamda=0.2 dan gamma=0.2")
akurasides.1

##      Akurasi lamda=0.2 dan gamma=0.2
## SSE                     6.440180e+09
## MSE                     3.951030e+07
## MAPE                    1.246787e+01

ssedes.train2<-des.2$SSE
msedes.train2<-ssedes.train2/length(train.ts)
sisaandes2<-ramalandes2$residuals
head(sisaandes2)

## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]       NA       NA 1283.000 2632.260 3049.157 2465.068

mapedes.train2 <- sum(abs(sisaandes2[3:length(train.ts)]/train.ts[3:length(train.ts)])
                      *100)/length(train.ts)

akurasides.2 <- matrix(c(ssedes.train2,msedes.train2,mapedes.train2))
row.names(akurasides.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.2) <- c("Akurasi lamda=0.6 dan gamma=0.3")
akurasides.2

##      Akurasi lamda=0.6 dan gamma=0.3
## SSE                     4.971376e+09
## MSE                     3.049924e+07
## MAPE                    9.507739e+00

Hasil akurasi dari data latih skenario 2 dengan lamda=0.6 dan gamma=0.3 memiliki hasil yang lebih baik karena memiliki nilai SSE, MSE, dan MAPE yang lebih kecil. Berdasarkan nilai MAPE-nya, skenario 2 dapat dikategorikan peramalan sangat baik, sedangkan skenario 1 dikategorikan peramalan baik.

Akurasi Data Uji

#Akurasi Data Testing
selisihdes1 <- ramalandes1$mean - testing$`Average price`
selisihdes1

## Time Series:
## Start = 164 
## End = 204 
## Frequency = 1 
##  [1] -1163.631 -3473.697 -1810.764  -737.831  2424.102  2474.036  3511.969
##  [8]  2474.902  3485.835  5002.768  3192.702  4423.635  5788.568  4894.501
## [15]  5530.435  6725.368  8394.301  8781.234 10047.168  9055.101  9638.034
## [22] 11256.967  9480.901 11043.834 12199.767 11016.700 12368.634 13592.567
## [29] 19446.500 20664.433 21090.367 23119.300 22132.233 24192.166 24654.100
## [36] 25611.033 27507.966 27789.899 29427.832 30235.766 29120.699

SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(testing$`Average price`)
MAPEtestingdes1<-sum(abs(selisihdes1/testing$`Average price`)*100)/length(testing$`Average price`)

selisihdes2<-ramalandes2$mean-testing$`Average price`
selisihdes2

## Time Series:
## Start = 164 
## End = 204 
## Frequency = 1 
##  [1]  2040.91543   -67.79747  1796.48964  3070.77674  6434.06385  6685.35096
##  [7]  7924.63806  7088.92517  8301.21227 10019.49938  8410.78648  9843.07359
## [13] 11409.36069 10716.64780 11553.93490 12950.22201 14820.50911 15408.79622
## [19] 16876.08332 16085.37043 16869.65753 18689.94464 17115.23175 18879.51885
## [25] 20236.80596 19255.09306 20808.38017 22233.66727 28288.95438 29708.24148
## [31] 30335.52859 32565.81569 31780.10280 34041.38990 34704.67701 35862.96411
## [37] 37961.25122 38444.53833 40283.82543 41293.11254 40379.39964

SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(testing$`Average price`)
MAPEtestingdes2<-sum(abs(selisihdes2/testing$`Average price`)*100)/length(testing$`Average price`)

selisihdesopt<-ramalandesopt$mean-testing$`Average price`
selisihdesopt

## Time Series:
## Start = 164 
## End = 204 
## Frequency = 1 
##  [1]   948.1123 -1872.9616  -721.0354  -159.1092  2491.8169  2030.7431
##  [7]  2557.6692  1009.5954  1509.5215  2515.4477   194.3738   914.3000
## [13]  1768.2262   363.1523   488.0785  1172.0046  2329.9308  2205.8569
## [19]  2960.7831  1457.7092  1529.6354  2637.5616   350.4877  1402.4139
## [25]  2047.3400   353.2662  1194.1923  1907.1185  7250.0446  7956.9708
## [31]  7871.8969  9389.8231  7891.7493  9440.6754  9391.6016  9837.5277
## [37] 11223.4539 10994.3800 12121.3062 12418.2323 10792.1585

SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(testing$`Average price`)
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing$`Average price`)*100)/length(testing$`Average price`)

akurasitestingdes <-
  matrix(c(SSEtestingdes1,MSEtestingdes1,MAPEtestingdes1,SSEtestingdes2,MSEtestingdes2,
           MAPEtestingdes2,SSEtestingdesopt,MSEtestingdesopt,MAPEtestingdesopt),
         nrow=3,ncol=3)
row.names(akurasitestingdes)<- c("SSE", "MSE", "MAPE")
colnames(akurasitestingdes) <- c("des ske1","des ske2","des opt")
akurasitestingdes

##          des ske1     des ske2      des opt
## SSE  9.898361e+09 2.129104e+10 1.345996e+09
## MSE  2.414234e+08 5.192937e+08 3.282918e+07
## MAPE 1.402999e+01 2.181454e+01 4.657467e+00

Hasil akurasi dari data latih DES Opt memiliki hasil yang lebih baik karena memiliki nilai SSE, MSE, dan MAPE yang lebih kecil dibandingkan hasil akurasi pada DES skenario 1 dan 2. Berdasarkan nilai MAPE-nya,DES Opt dapat dikategorikan peramalan sangat baik, sedangkan DES skenario 1 dan 2 dikategorikan peramalan baik.

Perbandingan Metode DMA dan DES

perbandingan_metode <-
  matrix(c(SSE_test.dma, MSE_test.dma, MAPE_test.dma, SSEtestingdesopt,MSEtestingdesopt,MAPEtestingdesopt),
         nrow=3,ncol=2)
row.names(perbandingan_metode)<- c("SSE", "MSE", "MAPE")
colnames(perbandingan_metode) <- c("DMA","DES")
perbandingan_metode

##               DMA          DES
## SSE  1.789688e+10 1.345996e+09
## MSE  4.365094e+08 3.282918e+07
## MAPE 1.989137e+01 4.657467e+00

Metode DMA dan DES dapat dibandingkan hasilnya dengan menggunakan ukuran akurasi yang sama, yaitu SSE, MSE, dan MAPE dari data uji. Didapatkan hasil bahwa metode DES lebih baik dibandingkan metode DMA dilihat dari SSE, MSE, dan MAPE yang lebih kecil nilainya. Berdasarkan nilai MAPE-nya, metode DES memberikan peramalan dengan akurasi yang sangat baik, sedangkan metode DMA hanya memberikan peramalan dengan akurasi yang baik.