Handling Autocorrelation II

by Muhammad Nachnoer Novatron Fitra Arss

A. Awalan

  1. Memanggil Packages
  2. lapply(c("dLagM","dynlm","MLmetrics","readxl","dplyr","car","lmtest","caTools","ggplot2","hrbrthemes","kableExtra"),library,character.only=T)[[1]]
    ##  [1] "dLagM"     "dynlm"     "zoo"       "nardl"     "stats"     "graphics" 
    ##  [7] "grDevices" "utils"     "datasets"  "methods"   "base"

  3. Data Awal
  4. Data yang digunakan adalah data Superstore dari kaggle.com dengan 2 peubah uji yaitu Jumlah Penjualan dan Rataan biaya yang dikeluarkan dari 1 Januari 2015 hingga 4 Januari 2020.

    super<-read_excel("C:/Users/falco/Downloads/Month_Value_1.xlsx")
    super<-super[,c(2,3)];glimpse(super)
    ## Rows: 64
    ## Columns: 2
    ## $ Sales_quantity <dbl> 12729, 11636, 15922, 15227, 8620, 13160, 17254, 8642, 1~
    ## $ Average_cost   <dbl> 1257.764, 1358.507, 1384.697, 1235.607, 1626.622, 1275.~

  5. Data Training (70% amatan)
  6. ktrain<-super[1:45,];colnames(ktrain)<-c("sales","cost");glimpse(ktrain)
    ## Rows: 45
    ## Columns: 2
    ## $ sales <dbl> 12729, 11636, 15922, 15227, 8620, 13160, 17254, 8642, 16144, 181~
    ## $ cost  <dbl> 1257.764, 1358.507, 1384.697, 1235.607, 1626.622, 1275.375, 1110~

  7. Data Testing (30% amatan)
  8. ktest<-super[-1:-45,];colnames(ktest)<-c("sales","cost");glimpse(ktest)
    ## Rows: 19
    ## Columns: 2
    ## $ sales <dbl> 22644, 19765, 33207, 24096, 21624, 33379, 22265, 16967, 24958, 2~
    ## $ cost  <dbl> 1759.034, 1669.575, 1422.044, 1513.113, 1690.090, 1623.737, 1470~

  9. Model Awal
  10. model<-lm(super);model
    ## 
    ## Call:
    ## lm(formula = super)
    ## 
    ## Coefficients:
    ##  (Intercept)  Average_cost  
    ##    22720.234        -2.078
    #Breusch-Godfrey Test
    bgtest(model)
    ## 
    ##  Breusch-Godfrey test for serial correlation of order up to 1
    ## 
    ## data:  model
    ## LM test = 10.764, df = 1, p-value = 0.001035

    Interpretasi:P-value < 0,05, maka dalam tingkat signifikansi 95%, terdapat cukup bukti untuk menyatakan bahwa terdekteksi adanya autokorelasi pada model awal. Oleh karena itu, hal ini perlu diatasi, salah satunya dengan menambahkan lag peubah tertentu. Terdapat 3 metode yaitu, Koyck, Distributed Lag, dan Autoregressive Distributed Lag Model.

B.Koyck

  1. Modelling Koyck
  2. K<-koyckDlm(ktrain$cost,ktrain$sales);summary(K)
    ## 
    ## Call:
    ## "Y ~ (Intercept) + Y.1 + X.t"
    ## 
    ## Residuals:
    ##      Min       1Q   Median       3Q      Max 
    ## -13184.1  -4010.7   -404.1   4302.1  16075.5 
    ## 
    ## Coefficients:
    ##               Estimate Std. Error t value Pr(>|t|)
    ## (Intercept)  2046.9825 14964.0010   0.137    0.892
    ## Y.1            -0.2685     0.3653  -0.735    0.467
    ## X.t            11.5430    11.8020   0.978    0.334
    ## 
    ## Residual standard error: 6677 on 41 degrees of freedom
    ## Multiple R-Squared: -0.547,  Adjusted R-squared: -0.6225 
    ## Wald test: 0.4921 on 2 and 41 DF,  p-value: 0.6149 
    ## 
    ## Diagnostic tests:
    ## NULL
    ## 
    ##                             alpha     beta        phi
    ## Geometric coefficients:  1613.753 11.54304 -0.2684612

  3. Forecasting Koyck
  4. E<-forecast(model = K, x=ktest$cost, h=19);E
    ## $forecasts
    ##  [1] 16080.86 17001.86 13897.35 15782.00 17318.90 16140.38 14689.67 20235.40
    ##  [9] 18680.22 21254.77 25883.32 19187.27 16057.14 16832.89 15343.76 21829.26
    ## [17] 15937.47 15497.14 20578.30
    ## 
    ## $call
    ## forecast.koyckDlm(model = K, x = ktest$cost, h = 19)
    ## 
    ## attr(,"class")
    ## [1] "forecast.koyckDlm" "dLagM"

  5. Akurasi Koyck
  6. #MAPE training
    MAPEKTRAIN <- GoF(K)[1,"MAPE"];MAPEKTRAIN
    ## [1] 0.3480124
      #MAPE testing
    MAPEKTEST <- MAPE(E$forecasts, ktest$sales);MAPEKTEST
    ## [1] 0.3343468

C.Distributed Lag Model (DLM)

  1. Modelling DLM
  2. #Lag optimum untuk peubah Rataan Biaya
    QOPT<-finiteDLMauto(formula=sales~cost,data=data.frame(ktrain),model.type = "dlm",error.type = "AIC");QOPT
    ##    q - k    MASE      AIC      BIC   GMRAE   MBRAE R.Adj.Sq Ljung-Box
    ## 10    10 0.44097 698.6259 718.8454 0.36255 0.02481  0.31403 0.0810852

    Interpretasi: Didapatkan lag optimum untuk peubah Rataan Biaya berdasarkan AIC adalah 10 hari sebelumnya.

    #Model
    DLMOD<-dlm(x=ktrain$cost,y=ktrain$sales,q=QOPT$`q - k`);summary(DLMOD)
    ## 
    ## Call:
    ## lm(formula = model.formula, data = design)
    ## 
    ## Residuals:
    ##    Min     1Q Median     3Q    Max 
    ##  -6834  -2807     -8   2029   7368 
    ## 
    ## Coefficients:
    ##               Estimate Std. Error t value Pr(>|t|)  
    ## (Intercept) 18656.8896  9666.5764   1.930   0.0660 .
    ## x.t            -8.2330     3.1480  -2.615   0.0155 *
    ## x.1            -0.2154     3.0910  -0.070   0.9451  
    ## x.2             2.9144     3.1501   0.925   0.3645  
    ## x.3            -6.1798     2.9352  -2.105   0.0464 *
    ## x.4            -2.0580     2.8493  -0.722   0.4774  
    ## x.5             2.3741     2.8617   0.830   0.4153  
    ## x.6            -2.7064     2.8274  -0.957   0.3484  
    ## x.7             2.3688     2.8826   0.822   0.4196  
    ## x.8             5.7940     2.9213   1.983   0.0594 .
    ## x.9             1.9110     3.1695   0.603   0.5525  
    ## x.10            4.1045     3.1783   1.291   0.2094  
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## 
    ## Residual standard error: 4447 on 23 degrees of freedom
    ## Multiple R-squared:  0.536,  Adjusted R-squared:  0.314 
    ## F-statistic: 2.415 on 11 and 23 DF,  p-value: 0.03597
    ## 
    ## AIC and BIC values for the model:
    ##        AIC      BIC
    ## 1 698.6259 718.8454

    Interpretasi: Terdapat 2 peubah yang berpengaruh terhadap model dalam tingkat kepercayaan 95%, yaitu X.t dan X.3. Artinya, berdasarkan metode DLM, jumlah penjualan saat ini dipengaruhi oleh rataan biaya saat ini dan pada 3 hari sebelumnya. Model mengindikasikan performa yang cukup baik yaitu dengan R-Squared 0,54.

  3. Forecasting DLM
  4. FF<-forecast(DLMOD,x=ktest$cost,h=19);FF
    ## $forecasts
    ##  [1] 20227.373 17131.172 24258.876 20735.536 16377.468 23946.651 22476.283
    ##  [8] 17224.882 17997.244 16672.415  9345.115 12719.129 18036.801 12307.610
    ## [15] 15179.338 17054.849 18757.224 26772.721 22219.607
    ## 
    ## $call
    ## forecast.dlm(model = DLMOD, x = ktest$cost, h = 19)
    ## 
    ## attr(,"class")
    ## [1] "forecast.dlm" "dLagM"

  5. Akurasi DLM
  6. #MAPE training
    MAPEDTRAIN<-GoF(DLMOD)[1,"MAPE"];MAPEDTRAIN
    ## [1] 0.1824237
    #MAPE testing
    MAPEDTEST<-MAPE(FF$forecasts,ktest$sales);MAPEDTEST
    ## [1] 0.2528312

D. AutoRegressive Distributed Lag Model (ARDLM)

  1. Modelling ARDLM
  2. #Lag optimum untuk peubah Rataan Biaya dan Jumlah Penjualan
    PQOPT<-ardlBoundOrders(data.frame(ktrain),sales~cost);c(p=PQOPT$p$cost,q=PQOPT$q)
    ##  p  q 
    ##  9 15

    Interpretasi: Didapatkan lag optimum berdasarkan AIC untuk peubah Rataan Biaya adalah 9 hari sebelumnya, sedangkan lag optimum untuk Jumlah Penjualan adalah 15 hari sebelumnya.

    #Model
    AR<-ardlDlm(sales~cost,ktrain,p=PQOPT$p$cost,q=PQOPT$q);summary(AR)
    ## 
    ## Time series regression with "ts" data:
    ## Start = 16, End = 45
    ## 
    ## Call:
    ## dynlm(formula = as.formula(model.text), data = data)
    ## 
    ## Residuals:
    ##       16       17       18       19       20       21       22       23 
    ##  -14.911 -125.283  702.568 -210.425 -521.037 -593.103  183.617  -34.078 
    ##       24       25       26       27       28       29       30       31 
    ##  241.098 -227.108  358.166 -344.053  -81.359    6.912  580.153  666.585 
    ##       32       33       34       35       36       37       38       39 
    ## -218.016  -93.405 -221.779  -34.431  157.577  581.880 -201.243   18.723 
    ##       40       41       42       43       44       45 
    ## -204.215  199.808 -736.879 -302.069  323.555  142.752 
    ## 
    ## Coefficients:
    ##               Estimate Std. Error t value Pr(>|t|)  
    ## (Intercept) -2.265e+04  1.327e+04  -1.707   0.1630  
    ## cost.t      -2.281e+00  1.923e+00  -1.186   0.3011  
    ## cost.1       5.095e-01  2.279e+00   0.224   0.8341  
    ## cost.2       6.383e-01  2.105e+00   0.303   0.7768  
    ## cost.3       3.073e+00  1.896e+00   1.621   0.1804  
    ## cost.4       3.705e+00  2.303e+00   1.609   0.1830  
    ## cost.5       2.116e+00  1.988e+00   1.064   0.3471  
    ## cost.6      -3.372e-01  1.484e+00  -0.227   0.8314  
    ## cost.7       1.368e+00  1.692e+00   0.809   0.4641  
    ## cost.8       1.663e+00  1.743e+00   0.954   0.3941  
    ## cost.9      -5.282e-02  1.460e+00  -0.036   0.9729  
    ## sales.1     -1.158e-01  4.459e-01  -0.260   0.8079  
    ## sales.2     -3.306e-01  3.326e-01  -0.994   0.3764  
    ## sales.3      4.302e-01  3.874e-01   1.111   0.3290  
    ## sales.4      6.109e-03  3.691e-01   0.017   0.9876  
    ## sales.5     -8.088e-02  2.406e-01  -0.336   0.7537  
    ## sales.6     -2.604e-01  2.852e-01  -0.913   0.4128  
    ## sales.7      3.823e-02  3.594e-01   0.106   0.9204  
    ## sales.8      1.490e-01  3.032e-01   0.492   0.6488  
    ## sales.9      1.179e-01  2.777e-01   0.425   0.6929  
    ## sales.10    -2.817e-01  2.711e-01  -1.039   0.3574  
    ## sales.11    -2.294e-01  3.115e-01  -0.736   0.5023  
    ## sales.12     8.887e-01  2.782e-01   3.194   0.0331 *
    ## sales.13     4.753e-01  3.981e-01   1.194   0.2985  
    ## sales.14     7.005e-01  3.915e-01   1.789   0.1481  
    ## sales.15    -3.124e-02  4.697e-01  -0.067   0.9502  
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## 
    ## Residual standard error: 962.8 on 4 degrees of freedom
    ## Multiple R-squared:  0.9958, Adjusted R-squared:  0.9697 
    ## F-statistic: 38.09 on 25 and 4 DF,  p-value: 0.00143

    Interpretasi: Hanya terdapat 1 peubah yang berpengaruh terhadap model dalam tingkat kepercayaan 95%, yaitu Sales.12. Artinya, berdasarkan metode ARLM, jumlah penjualan saat ini hanya dipengaruhi oleh jumlah penjualan pada 12 hari sebelumnya. Model mengindikasikan performa yang sangat baik yaitu dengan R-Squared 0,99.

  3. Forecasting ARDLM
  4. G<-forecast(AR,x=ktest$cost,h=19);G
    ## $forecasts
    ##  [1] 17211.71 16988.57 37104.45 22930.32 21758.58 37642.00 27212.18 17911.18
    ##  [9] 28244.42 21749.09 13004.69 25633.50 19331.53 20992.52 43746.57 28231.37
    ## [17] 28732.12 49143.83 37275.77
    ## 
    ## $call
    ## forecast.ardlDlm(model = AR, x = ktest$cost, h = 19)
    ## 
    ## attr(,"class")
    ## [1] "forecast.ardlDlm" "dLagM"

  5. Akurasi ARDLM
  6. #akurasi testing
    MAPEATEST<-MAPE(G$forecasts,ktest$sales);MAPEATEST
    ## [1] 0.1545434
    #akurasi training
    MAPEATRAIN<-GoF(AR)[1,"MAPE"];MAPEATRAIN
    ## [1] 0.0169367

Akhiran

  1. Grafik Perbandingan Trend Aktual dengan 3 Metode Penanganan
  2. cc<-data.frame(x=ktest$cost,y=ktest$sales,DL=FF$forecasts,AR=G$forecasts,Koyck=E$forecasts)
    ggplot(cc,aes(x=x))+geom_smooth(aes(y=y),lty=2,lwd=2,col="#00ffab")+geom_smooth(aes(y=DL),lwd=2,col="#ff9f45")+
      geom_smooth(aes(y=AR),lwd=2,col="#7fb5ff")+geom_smooth(aes(y=Koyck),lwd=2,col="#f68989")+
      geom_text(x=max(cc$x), y=tail(cc$y, 1),label="Aktual",hjust=-0.15,vjust=3.6, hjust=-0.1, col="#00ffab",size=5)+
      geom_text(x=max(cc$x), y=tail(cc$DL, 1), 
                label="DLM", hjust=-0.1, vjust=5,col="#ff9f45",size=5)+
      geom_text(x=max(cc$x), y=tail(cc$AR, 1), 
                label="ARDLM", hjust=-0.1,vjust=9 ,col="#7fb5ff",size=5)+
      geom_text(x=max(cc$x), y=tail(cc$Koyck, 1), 
                label="Koyck", hjust=-0.1,vjust=-2.2,col="#f68989",size=5)+
      xlim(min(cc$x), max(cc$x)+136)+
      labs(y="Rataan Biaya\n", x="\nJumlah Penjualan", 
           title="Superstore 1 Januari 2015 - 4 Januari 2020 ")+
      theme_tinyhand(axis_title_just = "center", axis_text_size = 12,
                      axis_title_size =13)+theme(plot.title= element_text(hjust=0.5,color="white"),plot.background=element_rect(fill="#000044",color="#000044"),
          axis.title = element_text(color="white"),axis.text = element_text(color="white"))

    Interpretasi: Secara eksploratif ARDLM merupakan metode yang paling sesuai untuk forecasting karena memiliki trend yang paling mendekati pola data aktual dibandingkan 2 metode lainnya.

  3. Tabel Perbandingan Metrik Akurasi
  4. #Training
    tabtrain<-data.frame(Metode=c("Autoregressive","Distributed","Koyck"),MAPE=c(MAPEATRAIN,MAPEDTRAIN,MAPEKTRAIN));tabtrain
    ##           Metode      MAPE
    ## 1 Autoregressive 0.0169367
    ## 2    Distributed 0.1824237
    ## 3          Koyck 0.3480124
    #Testing
    tabtest<-data.frame(Metode=c("Autoregressive","Distributed","Koyck"),MAPE=c(MAPEATEST,MAPEDTEST,MAPEKTEST));tabtest
    ##           Metode      MAPE
    ## 1 Autoregressive 0.1545434
    ## 2    Distributed 0.2528312
    ## 3          Koyck 0.3343468

    Interpretasi: Nilai MAPE terkecil baik untuk data training maupun testing pada case ini terdapat pada Autoregressive Distributed Lag Model, yaitu masing-masing 0.016% dan 0.15%. Dengan kata lain, keduanya memiliki tingkat akurasi yang sangat tinggi yaitu sekitar 99,9%. Maka, dapat disimpulkan bahwa model dari hasil metode tersebut merupakan model terbaik untuk modelling dan forecasting.

  5. Breusch-Godfrey Test
  6. bgtest(AR$model)
    ## 
    ##  Breusch-Godfrey test for serial correlation of order up to 1
    ## 
    ## data:  AR$model
    ## LM test = 0.03387, df = 1, p-value = 0.854

    Interpretasi: P-value > 0,05, artinya dalam tingkat signifikansi 95%, terdapat cukup bukti untuk menyatakan bahwa tidak terdapat autokorelasi, artinya penanganan autokorelasi dengan menambahkan lag dari peubah respon berhasil.