Handling Autocorrelation II
by Muhammad Nachnoer Novatron Fitra Arss
A. Awalan
- Memanggil Packages
- Data Awal
- Data Training (70% amatan)
- Data Testing (30% amatan)
- Model Awal
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"
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.~
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~
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~
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
- Modelling Koyck
- Forecasting Koyck
- Akurasi Koyck
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
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"
#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)
- Modelling DLM
- Forecasting DLM
- Akurasi DLM
#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.
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"
#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)
- Modelling ARDLM
- Forecasting ARDLM
- Akurasi ARDLM
#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.
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"
#akurasi testing
MAPEATEST<-MAPE(G$forecasts,ktest$sales);MAPEATEST
## [1] 0.1545434
#akurasi training
MAPEATRAIN<-GoF(AR)[1,"MAPE"];MAPEATRAIN
## [1] 0.0169367
Akhiran
- Grafik Perbandingan Trend Aktual dengan 3 Metode Penanganan
- Tabel Perbandingan Metrik Akurasi
- Breusch-Godfrey Test
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.
#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.
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.