Mengimpor Data

Data yang akan digunakan merupakan data agregat volume Sicepat dalam periode mingguan.

data <- read.csv("D:/R/Time Series/Data Volume Weekly.csv", header = TRUE)
data <- within(data, {
        berat <- NULL 
        revenue <- NULL
        })
head(data)
##      periode  paket
## 1 2018-12-31 326721
## 2 2019-01-07 482785
## 3 2019-01-14 488021
## 4 2019-01-21 523393
## 5 2019-01-28 566250
## 6 2019-02-04 535349

Selanjutnya dilakukan pengecekan periode dan amatan yang kosong.

#Cek data null
data <- data %>% 
  mutate(date = ymd(periode))

range(data$date)
## [1] "2018-12-31" "2022-12-26"
colSums(is.na(data))
## periode   paket    date 
##       0       0       0

Karena tidak ada null pada periode dan nilai amatan, maka data dapat dianalisis tanpa melalui proses pre-processing. Selanjutnya dibentuk data time series dari dataframe sebelumnya. Frekuensi yang digunakana adalah 52 karena dalam setahun ada 52 weeks.

## Time Series:
## Start = c(2019, 1) 
## End = c(2023, 1) 
## Frequency = 52 
##   [1]   326721   482785   488021   523393   566250   535349   575466   549293
##   [9]   601553   564572   536731   521483   551811   556184   597471   494523
##  [17]   616282   669738   815363   993394  1109132   953366    92769   495382
##  [25]   709082   825202   878720   946005   955848   929098  1094886  1122162
##  [33]  1011334  1169007  1252470  1346709  1415765  1227112  1236192  1464433
##  [41]  1534849  1386327  1378512  1779577  1802059  2126312  1646150  1759121
##  [49]  2008124  2670534  2017053  1764342  1570000  2083121  1969890  1732496
##  [57]  2144218  2110470  1783125  1871610  1942249  2467872  2177428  2144182
##  [65]  2214300  2479215  2617012  2830420  2593198  3044321  3686688  4161450
##  [73]  1314028  2275687  3495027  3607705  3008365  3099803  3569250  3865605
##  [81]  2985929  3026084  3269763  3499807  3448414  3854575  4268453  4633435
##  [89]  5541772  3825206  4125186  4925843  4712507  4776273  4300510  4612556
##  [97]  4686811  5856687  3931456  4662897  4810496  5841928  6126548  4982529
## [105]  4961341  5411422  4714522  4328108  4905182  6245009  4792387  4570639
## [113]  4981773  6098665  5839373  6117883  6244335  6668015  7396627  5910316
## [121]  7254806  6998551  9101183  1316932  5946526  7102172  6743271  7629737
## [129]  5953063  6682232  6713190  8433755  6767326  6167530  8144318  8142210
## [137]  8825369  8096780  7864972  7921923 10186035  6663928  5290596  5550229
## [145]  7462237 10235582  6573161  8060257  7952431 11647238  7244368  8164817
## [153]  7693470  7910135  9878955  7325946  7828542  9473954  7924994  6798824
## [161]  7462175  8888031  7931526  7279022  7817555  9319468  7816889  7720100
## [169]  6738963  7134089 11008705  9141514 10326650  7483966  4579221  8230153
## [177]  6877050  8092117  7158696  9158847  6922352  7001916  7674474  7987499
## [185]  6703381  5984904  6555918  6755242  7893880  6056630  6477116  6457991
## [193]  7685434  6185830  5332590  6575160  5300147  6820886  4895473  5571487
## [201]  5110155  5847498  4400002  4261845  5092899  4925575  5378198  3480787
## [209]  3811375

Cek Dekomposisi Data

Data training yang digunakan adalah data dari week 1 2019 sampai data week 39 periode 26 September 2022 (sampai raw 197). Sisanya akan menjadi data testing.

# Membagi Data Training dan Data Testing
data_train <- head(volume_ts, 197)
data_test <- tail(volume_ts, length(volume_ts)-length(data_train))

Akan dilihat terlebih dahulu pola datanya dengan memberi garis regresi pada plot data.

#This will plot the time series
ts.plot(data_train, xlab="Periode", ylab="Jumlah Volume", main="Volume Harian Sicepat, 2019-2022")

# This will fit in a line
abline(reg=lm(data_train~time(data_train)))

Hasil plot menunjukkan volume yang terus menaik hingga 2022. Namun di akhir 2022 terlihat volume yang berbalik arah dan cenderung semakin turun.

# Dekomposisi Time Series
data_train%>% decompose() %>% autoplot()

Pemodelan

# Pemodelan Holt's Winter Exponential
model_hoW <- HoltWinters(data_train)

# Evaluasi Model
model_how_forecast <- forecast(object = model_hoW, h = 12)

volume_ts %>% autoplot(series = "data_train")+
  autolayer(data_test, series = "data_test") +
  autolayer(model_how_forecast$mean, series = "forecast")

accuracy(model_how_forecast$mean, x = data_test)
##                 ME   RMSE      MAE       MPE     MAPE        ACF1 Theil's U
## Test set -850723.1 941950 859695.2 -18.71711 18.84865 -0.08954647  1.115609

Hasil akurasi menunjukkan bahwa model sudah masuk kategori baik dengan MAPE sebesar 18%.

# Model STLM
model_stlm <- stlm(y = data_train, s.window = 12, method = "ets")

model_stlm_forecast <- forecast(model_stlm, h = 12)

volume_ts %>% autoplot(series = "Data Training")+
  autolayer(data_test, series = "Data Testing") +
  autolayer(model_stlm_forecast$mean, series = "forecast")

accuracy(model_stlm_forecast$mean, x = data_test)
##                ME    RMSE     MAE       MPE     MAPE        ACF1 Theil's U
## Test set -1044106 1130423 1044106 -22.41917 22.41917 -0.03499239  1.329555

Setelah melihat hasil akurasi dan membandingkannya dengan forecast data harian, maka forecast data weekly memberikan hasil yang lebih baik dan lebih mendekati nilai sebenarnya.

Hasil <- data.frame(
   Forecast  = model_how_forecast$mean,
   Volume_Real = data_test
)

Percentage <- with(Hasil, (abs(Forecast - Volume_Real)/Volume_Real)*100)
Fore_per_Act <- with(Hasil, (Forecast/Volume_Real))
Fore_per_Act <- round(Fore_per_Act, 2)
Percentage <- round(Percentage, 2)
#Periode <- data.frame(as.matrix(Percentage), date=time(Percentage))
#Periode <- Periode[,-1]
Hasil_Forecast <- data.frame(Hasil,Fore_per_Act, Percentage)
Hasil_Forecast
##    Forecast Volume_Real Fore_per_Act Percentage
## 1   6767053     6820886         0.99       0.79
## 2   5622374     4895473         1.15      14.85
## 3   6146835     5571487         1.10      10.33
## 4   6008056     5110155         1.18      17.57
## 5   7136708     5847498         1.22      22.05
## 6   5269546     4400002         1.20      19.76
## 7   5582101     4261845         1.31      30.98
## 8   5503990     5092899         1.08       8.07
## 9   5994841     4925575         1.22      21.71
## 10  6006968     5378198         1.12      11.69
## 11  4874250     3480787         1.40      40.03
## 12  4892134     3811375         1.28      28.36