Tugas Individu MPDW
MEMANGGIL LIBRARY YANG DIGUNAKAN
lapply(c("forecast","TTR","readxl",
"tseries","lmtest","orcutt","HoRM","rmarkdown","ggplot2"),
library,character.only=T)INDEKS PEMBANGUNAN MANUSIA
Indeks Pembangunan Manusia merupakan indikator penting yang dapat digunakan untuk mengukur tingkat pembangunan suatu masyarakat, utamanya untuk pemerintah dalam upaya penetapan kebijakan serta pembangunan negara.Semakin cepat pertumbuhan IPM dalam suatu wilayah atau negara, menuju suatu hal dalam bidang pembangunan Manusia yang sangat baik.
Data yang digunakan pada tugas kali ini merupakan data Indeks Pembangunan Manusia untuk Provinsi Sumatera Barat pada tahun 2010-2021 yang bersumber dari BPS(Badan Pusat Statistik). Variabel X sebagai tahun dan variabel Y sebagai skor IPM
IPM <- read_excel("DATA PASTI TUGAS AUTOKORELASI PROVINSI.xlsx")
knitr::kable(IPM,align = "c")| y | x |
|---|---|
| 67.25 | 2010 |
| 67.81 | 2011 |
| 68.36 | 2012 |
| 68.91 | 2013 |
| 69.36 | 2014 |
| 69.98 | 2015 |
| 70.73 | 2016 |
| 71.24 | 2017 |
| 71.73 | 2018 |
| 72.39 | 2019 |
| 72.38 | 2020 |
| 72.65 | 2021 |
Tahun<-IPM$x
IPM_SKOR<-IPM$yplot(Tahun,IPM_SKOR,pch = 20, col = "blue", main = "Scatter Plot Tahun vs IPM",
ylab = "IPM_SKOR", xlab = "Tahun")
Tahun<-IPM$x
IPM_SKOR<-IPM$y
model <- lm(IPM_SKOR~Tahun, data = IPM)
summary(model)##
## Call:
## lm(formula = IPM_SKOR ~ Tahun, data = IPM)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.45231 -0.09554 -0.03215 0.20099 0.33126
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -981.4216 38.6982 -25.36 2.08e-10 ***
## Tahun 0.5218 0.0192 27.18 1.05e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2296 on 10 degrees of freedom
## Multiple R-squared: 0.9866, Adjusted R-squared: 0.9853
## F-statistic: 738.5 on 1 and 10 DF, p-value: 1.053e-10Deteksi autokorelasi
1.) Residual Plot
#sisaan dan fitted value
resi1 <- residuals(model)
fit <- predict(model)
#Diagnostik dengan eksploratif
par(mfrow = c(2,2))
qqnorm(resi1)
qqline(resi1, col = "steelblue", lwd = 2)
plot(fit, resi1, col = "steelblue", pch = 20, xlab = "Sisaan",
ylab = "Fitted Values", main = "Sisaan vs Fitted Values")
abline(a = 0, b = 0, lwd = 2)
hist(resi1, col = "steelblue",main = "Histogram Residual")
plot(seq(1,12,1), resi1, col = "steelblue", pch = 20,
xlab = "Sisaan", ylab = "Order", main = "Sisaan vs Order")
lines(seq(1,12,1), resi1, col = "red")
abline(a = 0, b = 0, lwd = 2)
2.) ACF dan FAF
ACF dan FAF pada model
#ACF dan PACF identifikasi autokorelasi
par(mfrow = c(1,2))
acf(resi1)
pacf(resi1)
3.) Durbin Watson Test
Hipotesis :
H0 = Sisaan Saling Bebas
H1 = Sisaan Tidak Saling Bebas
lmtest::dwtest(model, alternative = 'two.sided') #ada autokorelasi##
## Durbin-Watson test
##
## data: model
## DW = 0.82777, p-value = 0.004736
## alternative hypothesis: true autocorrelation is not 04.) Breuch-Godfrey Test
bgtest(IPM_SKOR ~ Tahun, data=IPM, order=1)##
## Breusch-Godfrey test for serial correlation of order up to 1
##
## data: IPM_SKOR ~ Tahun
## LM test = 3.7277, df = 1, p-value = 0.05352Berdasarkan Uji Statistik didapatkan p-value < 0.05 pada uji Durbin Watson yang artinya Tolak H0 (Terdapat Autokorelasi). Sedangkan pada uji Breusch-Godfrey p-value > 0.05 yang artinya Terima H0 (Terdapat autokorelasi). Dikarenakan pada uji Durbin-Watson terdeteksi adanya Autokorelasi, Sehingga akan digunakan Cochran Orcutt dan Hildreth-lu dalam menangani permasalahan autokorelasi tersebut. Selanjutnya penjabaran syntax dan pembahasannya akan di jelaskan dibawah ini.
PENANGANAN AUTOKORELASI
Cochran Orcutt
modelcochrane <- orcutt::cochrane.orcutt(model,convergence=6,max.iter = 10000)
modelcochrane## Cochrane-orcutt estimation for first order autocorrelation
##
## Call:
## lm(formula = IPM_SKOR ~ Tahun, data = IPM)
##
## number of interaction: 1193
## rho 0.895751
##
## Durbin-Watson statistic
## (original): 0.82777 , p-value: 2.368e-03
## (transformed): 1.88748 , p-value: 2.778e-01
##
## coefficients:
## (Intercept) Tahun
## -433.117072 0.250835rho <- modelcochrane$rho
rho## [1] 0.8957505IPM_SKOR[-1]## [1] 67.81 68.36 68.91 69.36 69.98 70.73 71.24 71.73 72.39 72.38 72.65IPM_SKOR[-12]## [1] 67.25 67.81 68.36 68.91 69.36 69.98 70.73 71.24 71.73 72.39 72.38(IPM_SKOR.trans <- IPM_SKOR[-1]-IPM_SKOR[-12]*rho)## [1] 7.570779 7.619159 7.676496 7.633833 7.850745 8.045380 7.883567 7.916734
## [9] 8.137817 7.536621 7.815579(Tahun.trans <- Tahun[-1]-Tahun[-12]*rho)## [1] 210.5415 210.6457 210.7500 210.8542 210.9585 211.0627 211.1670 211.2712
## [9] 211.3755 211.4797 211.5840Model Pakai Transformasi
modeltf <- lm(IPM_SKOR.trans~Tahun.trans)
summary(modeltf) ##
## Call:
## lm(formula = IPM_SKOR.trans ~ Tahun.trans)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.35768 -0.09587 -0.03476 0.08096 0.26967
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -45.1522 36.3343 -1.243 0.245
## Tahun.trans 0.2508 0.1721 1.457 0.179
##
## Residual standard error: 0.1882 on 9 degrees of freedom
## Multiple R-squared: 0.1909, Adjusted R-squared: 0.101
## F-statistic: 2.123 on 1 and 9 DF, p-value: 0.1791lmtest::dwtest(modeltf,alternative = 'two.sided') ##
## Durbin-Watson test
##
## data: modeltf
## DW = 1.8875, p-value = 0.5555
## alternative hypothesis: true autocorrelation is not 0bgtest(modeltf)##
## Breusch-Godfrey test for serial correlation of order up to 1
##
## data: modeltf
## LM test = 0.0083218, df = 1, p-value = 0.9273Melakukan Transformasi Balik
cat("IPM = ", coef(modeltf)[1]/(1-rho), "+", coef(modeltf)[2]," Tahun", sep = "") #persamaan regresi setelah di transformasi ke persamaan awal## IPM = -433.1171+0.2508351 TahunHildreth Lu
# Hildreth-Lu
hildreth.lu.func<- function(r, model){
x <- model.matrix(model)[,-1]
y <- model.response(model.frame(model))
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.999, by= 0.001))
tab <- data.frame("rho" = r, "SSE" = sapply(r, function(i){deviance(hildreth.lu.func(i, model))}))
tab$rho[which.min(tab$SSE)]#rho optimal## [1] 0.896#grafik rho dan SSE
plot(tab$SSE ~ tab$rho , type = "l")
abline(v = tab[tab$SSE==min(tab$SSE),"rho"], lty = 3)
# Model Hildreth-Lu
# Model terbaik
modelhl <- hildreth.lu.func(0.896, model)
summary(modelhl)##
## Call:
## lm(formula = y ~ x)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.35773 -0.09587 -0.03475 0.08096 0.26965
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -44.8943 36.3347 -1.236 0.248
## x 0.2501 0.1726 1.449 0.181
##
## Residual standard error: 0.1882 on 9 degrees of freedom
## Multiple R-squared: 0.1893, Adjusted R-squared: 0.09918
## F-statistic: 2.101 on 1 and 9 DF, p-value: 0.1811Pengecekan Autokorelasi
lmtest::dwtest(modeltf,alternative = "two.sided")##
## Durbin-Watson test
##
## data: modeltf
## DW = 1.8875, p-value = 0.5555
## alternative hypothesis: true autocorrelation is not 0lmtest::dwtest(modelhl,alternative = "two.sided")##
## Durbin-Watson test
##
## data: modelhl
## DW = 1.8879, p-value = 0.556
## alternative hypothesis: true autocorrelation is not 0bgtest(modeltf)##
## Breusch-Godfrey test for serial correlation of order up to 1
##
## data: modeltf
## LM test = 0.0083218, df = 1, p-value = 0.9273bgtest(modelhl)##
## Breusch-Godfrey test for serial correlation of order up to 1
##
## data: modelhl
## LM test = 0.0082115, df = 1, p-value = 0.9278Berdasarkan hasil tersebut dapat disimpulkan bahwa dengan menggunakan Cochrane-Orcutt dan Hildreth-Lu tersebut , mampu menangani adanya autokorelasi pada model yang dibentuk semula
cat("IPM = ", coef(modelhl)[1]/(1-0.8965), "+", coef(modelhl)[2]," Tahun", sep = "") #persamaan regresi setelah di transformasi ke persamaan awal## IPM = -433.7611+0.2501259 Tahun