1. Library yang Digunakan

library(readxl)
## Warning: package 'readxl' was built under R version 4.2.1
library(orcutt)
## Warning: package 'orcutt' was built under R version 4.2.1
## Loading required package: lmtest
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(lmtest)
library(lawstat)
## Warning: package 'lawstat' was built under R version 4.2.1

2. Data yang digunakan

setwd("C:/5 2022-2023/Metode Peramalan Deret Waktu/K3/")
data <- read_excel("IPM_Kepri.xlsx")
View(data)
head(data)
x <- data$Tahun
y <- data$`KEP. RIAU`
#diagram pencar identifikasi model
plot(x,y,pch = 20, col = "blue", main = "Scatter Plot X vs Y",
     ylab = "IPM Provinsi Kep.Riau", xlab = "Tahun")

Dapat dilihat bahwa plot yang terbentuk berpola trend naik, yang artinya semakin lama IPM Provinsi Kepulauan Riau semakin tinggi.

#korelasi x dan y
cor(x,y)
## [1] 0.9899972

Dari nilai korelasi diatas dapat dilihat ada hubungan positif yang kuat antara Tahun dan IPM.

3. Model Regresi Deret Waktu

mod_reg <- lm(y~x)
summary(mod_reg)
## 
## Call:
## lm(formula = y ~ x)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.32897 -0.14432  0.01181  0.18608  0.29711 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -781.81672   38.55893  -20.28 1.88e-09 ***
## x              0.42451    0.01913   22.19 7.76e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2288 on 10 degrees of freedom
## Multiple R-squared:  0.9801, Adjusted R-squared:  0.9781 
## F-statistic: 492.4 on 1 and 10 DF,  p-value: 7.755e-10

Persamaan Regresi : y = -781.81672 + 0.42451x

4. Deteksi Autokorelasi Secara Eksploratif dengan Residual Plot

res <- residuals(mod_reg)
fit <- predict(mod_reg)

#Dengan Plot Cara 1
par(mfrow = c(2,2))

qqnorm(res)
qqline(res, col = "red", lwd = 2)

plot(fit, res, col = "red", pch = 20, xlab = "Sisaan", 
     ylab = "Fitted Values", main = "Sisaan vs Fitted Values")
abline(a = 0, b = 0, lwd = 2)

hist(res, col = "red")

plot(seq(1,12,1), res, col = "red", pch = 20, 
     xlab = "Sisaan", ylab = "Order", main = "Sisaan vs Order")
lines(seq(1,12,1), res, col = "blue")
abline(a = 0, b = 0, lwd = 2)

Yang bisa dilihat dari plot di atas :

  1. Sisaan menyebar normal

  2. Tebaran tidak berpola sehingga sisaan saling bebas

  3. Lebar pita sama sehingga ragam sisaan homogen

  4. Sisaan di sekitar 0

Dengan ACF dan PACF Plot

par(mfrow = c(2,1))
acf(res)
pacf(res)

Tidak ada garis vertikal yang melebihi garis horizontal kecuali di lag = 0, artinya tidak ada autokorelasi pada model ini.

Pengecekan kebebasan sisaan dengan Uji Formal

1. Durbin-Watson Test H0: tidak ada autokorelasi H1: ada autokorelasi

lmtest::dwtest(mod_reg,alternative = 'two.sided') 
## 
##  Durbin-Watson test
## 
## data:  mod_reg
## DW = 0.7724, p-value = 0.002851
## alternative hypothesis: true autocorrelation is not 0

p-value = 0.002851 < 0.05, artinya Tolak H0, sehingga cukup bukti untuk menyatakan bahwa terdapat autokorelasi pada taraf nyata 5% menurut Durbin-Watson Test.

2. Breusch-Godfrey Test H0: tidak ada autokorelasi H1: ada autokorelasi

lmtest::bgtest(y ~ x, order=1) #Perform Breusch-Godfrey test for first-order serial correlation
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  y ~ x
## LM test = 2.8628, df = 1, p-value = 0.09065

p-value = 0.09065 > 5% , artinya Tidak Tolak H0 sehingga dapat disimpulkan bahwa tidak terdapat autokorelasi pada taraf nyata 5% menurut Breusch-Godfrey Test.

3. Run’s Test

lawstat::runs.test(res,alternative="two.sided")
## 
##  Runs Test - Two sided
## 
## data:  res
## Standardized Runs Statistic = 0, p-value = 1

p-value = 1 > 5% , artinya Tidak Tolak H0 sehingga dapat disimpulkan bahwa tidak terdapat autokorelasi pada taraf nyata 5% menurut Run’s Test.

5. Deteksi Autokorelasi Metode Cochrane-orcutt

#Interactive method using to solve first order autocorrelation problems. 

modelco <- orcutt::cochrane.orcutt(mod_reg)
modelco 
## Cochrane-orcutt estimation for first order autocorrelation 
##  
## Call:
## lm(formula = y ~ x)
## 
##  number of interaction: 76
##  rho 0.651462
## 
## Durbin-Watson statistic 
## (original):    0.77240 , p-value: 1.426e-03
## (transformed): 1.94827 , p-value: 3.15e-01
##  
##  coefficients: 
## (Intercept)           x 
## -613.259516    0.340992
#rho optimum
rho <- modelco$rho
rho
## [1] 0.6514619

Diperoleh nilai rho optimum adalah 0.6514619. Selanjutnya dilakukan transformasi terhadap Y dan X.

#transformasi terhadap y dan x
(y.trans <- y[-1]-y[-12]*rho)
##  [1] 25.27151 25.70881 25.88022 25.83025 25.93270 25.94468 26.24833 26.33866
##  [9] 26.72459 26.41766 26.54599
(x.trans <- x[-1]-x[-12]*rho)
##  [1] 701.5616 701.9101 702.2586 702.6072 702.9557 703.3043 703.6528 704.0013
##  [9] 704.3499 704.6984 705.0470

Diperoleh model yang baru dengan X dan Y yang sudah ditransformasi

#model baru
modelcorho <- lm(y.trans~x.trans)
summary(modelcorho) 
## 
## Call:
## lm(formula = y.trans ~ x.trans)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.210916 -0.128456 -0.008725  0.080172  0.291371 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -213.74430   30.20039  -7.078 5.81e-05 ***
## x.trans        0.34099    0.04294   7.941 2.35e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.157 on 9 degrees of freedom
## Multiple R-squared:  0.8751, Adjusted R-squared:  0.8612 
## F-statistic: 63.06 on 1 and 9 DF,  p-value: 2.348e-05

Persamaan regresi yang baru : y* = -213.74430 + 0.34099x* Kemudian diperiksa kembali autokorelasinya dengan Uji Durbin-Watson

lmtest::dwtest(modelcorho,alternative = 'two.sided') 
## 
##  Durbin-Watson test
## 
## data:  modelcorho
## DW = 1.9483, p-value = 0.6301
## alternative hypothesis: true autocorrelation is not 0

p-value = 0.6301 > 5% , artinya Tidak Tolak H0 sehingga dapat disimpulkan bahwa tidak terdapat autokorelasi di model baru ini pada taraf nyata 5% dengan Durbin-Watson Test. Ini menunjukkan masalah autokorelasi teratasi dengan metode Cochrane-orcutt. Selanjutnya akan dilakukan transformasi balik

b0 <- modelcorho$coefficients[1]/(1-rho)
b1 <- modelcorho$coefficients[2]
b0
## (Intercept) 
##   -613.2595
b1
##   x.trans 
## 0.3409918

Diperoleh persamaannya adalah y = -613.2595 + 0.3409918x

Metode Hidreth-Lu

hildreth.lu.func<- function(r, mod_reg){
  x <- model.matrix(mod_reg)[,-1]
  y <- model.response(model.frame(mod_reg))
  n <- length(y)
  t <- 2:n
  y <- y[t]-r*y[t-1]
  x <- x[t]-r*x[t-1]
  
  return(lm(y~x))
}

#mencari rho yang meminimumkan SSE (iteratif)
r <- c(seq(0.1,0.8, by= 0.1), seq(0.9,0.99, by= 0.01))
tab <- data.frame("rho" = r, "SSE" = sapply(r, function(i){deviance(hildreth.lu.func(i, mod_reg))}))
round(tab, 4) #0,50 memiliki SSE Terkecil
#grafik rho dan SSE
plot(tab$SSE ~ tab$rho , type = "l")
abline(v = tab[tab$SSE==min(tab$SSE),"rho"], lty = 3)

rho optimal di sekitar 0.7 karena memiliki SSE terkecil.

#rho optimal di sekitar 0.7
r <- seq(0.6, 0.8, by= 0.01)
tab <- data.frame("rho" = r, "SSE" = sapply(r, function(i){deviance(hildreth.lu.func(i, mod_reg))}))
round(tab, 4)

rho optimal disekitar 0.64 sampai 0.66. Dipilihlah rho = 0.65 sebagai rho optimal.

#grafik SSE optimum
plot(tab$SSE ~ tab$rho , type = "l")
abline(v = tab[tab$SSE==min(tab$SSE),"rho"], lty = 3)

# Model terbaik
mod_hl <- hildreth.lu.func(0.65, mod_reg)
summary(mod_hl)
## 
## Call:
## lm(formula = y ~ x)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.211295 -0.128511 -0.008282  0.079970  0.291241 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -214.94048   30.20026  -7.117 5.56e-05 ***
## x              0.34142    0.04276   7.984 2.25e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.157 on 9 degrees of freedom
## Multiple R-squared:  0.8763, Adjusted R-squared:  0.8625 
## F-statistic: 63.75 on 1 and 9 DF,  p-value: 2.249e-05

Persamaan regresi baru hasil transformasi Hildrath-Lu : y* = -214.94048 + 0.34142x*

# Deteksi autokorelasi
lmtest::dwtest(mod_hl)
## 
##  Durbin-Watson test
## 
## data:  mod_hl
## DW = 1.9465, p-value = 0.3139
## alternative hypothesis: true autocorrelation is greater than 0

p-value = 0.3139 > 5% , artinya Tidak Tolak H0 sehingga cukup bukti untuk menyatakan bahwa tidak terdapat autokorelasi pada taraf nyata 5% dengan Durbin-Watson Test.

# Transformasi Balik
cat("y = ", coef(mod_hl)[1]/(1-0.65), "+", coef(mod_hl)[2],"x", sep = "") 
## y = -614.1157+0.3414156x
#persamaan regresi setelah di transformasi ke persamaan awal

6. Kesimpulan 1. Metode Cochrane-orcutt dan Hildrath-Lu mampu mengatasi masalah autokorelasi pada regresi deret waktu IPM Provinsi Kepulauan Riau. 2. Dengan Metode Cochrane-orcutt diperoleh persamaan akhirnya adalah : y = -613.2595 + 0.3409918x 3. Dengan Metode Hildrath-Lu diperoleh persamaan akhirnya adalah : y = -614.1157 + 0.3414156x 4. Kedua metode diatas memberikan persamaan akhir yang tidak jauh beda.

Sumber Data https://bps.go.id/indicator/26/413/1/-metode-baru-indeks-pembangunan-manusia.html