Indeks Pembangunan Manusia menjelaskan bagaimana penduduk dapat mengakses hasil pembangunan dalam memperoleh pendapatan, pendidikan, kesehatan dan sebagianya. IPM dibentuk oleh 3 (tiga) dimensi dasar :

  1. Umur panjang dan hidup sehat (a long and healthy life)

  2. Pengetahuan (knowledge)

  3. Standar hidup layak (decent standard of living)

Data IPM yang digunakan pada analisis ini adalah Metode baru IPM, hal yang berubah adalah Indikator :

  1. Angka melek huruf pada metode lama diganti dengan Angka Harapan Lama Sekolah

  2. Produk Domestik Bruto (PDB) per kapita diganti dengan Produk Nasional Bruto (PNB) per kapita

Metode Penghitungan :

  1. Metode agregasi diubah dari rata-rata aritmatik menjadi rata-rata geometrik

Status IPM menggambarkan level pencapaian pembangunan manusia dalam suatu periode :

Sangat tinggi : IPM >= 80

Tinggi : 70 <= IPM < 80

Sedang : 60 <= IPM < 70

Rendah : IPM < 60

Provinsi DKI Jakarta terbagi menjadi 6 (enam) kabupaten / kota, yang terdiri dari satu wilayah kabupaten dan lima kota. Hasil Survei Penduduk Antar Sensus (SUPAS) 2015 berdasarkan Proyeksi Penduduk Indonesia 2015 - 2045, jumlah penduduk DKI Jakarta Pertengahan Tahun 2021 tercatat 10.64 juta jiwa. IPM DKI Jakarta tahun 2021 sebesar 81.11, nilai tersebut meningkat dari tahun-tahun sebelumnya. Jika dibandingkan dengan pencapain IPM Indonesia, DKI Jakarta selalu menduduki peringkat tertinggi di antara 34 Provinsi di Indonesia.

#load data
library("readxl")
dataipm <- read_excel(path="D:/Semester 6/Metode Peramalan Deret Waktu/ipm.xlsx", col_names=TRUE)
dataipm
## # A tibble: 12 x 2
##    Tahun   IPM
##    <dbl> <dbl>
##  1  2010  76.3
##  2  2011  77.0
##  3  2012  77.5
##  4  2013  78.1
##  5  2014  78.4
##  6  2015  79.0
##  7  2016  79.6
##  8  2017  80.1
##  9  2018  80.5
## 10  2019  80.8
## 11  2020  80.8
## 12  2021  81.1
x <- dataipm$Tahun
y <- dataipm$IPM
#diagram pencar identifikasi model
plot(dataipm$Tahun,dataipm$IPM, pch = 20, col = "blue", main = "Scatter Plot Tahun vs IPM", xlab="Tahun", ylab="IPM")

Scatter Plot Tahun vs IPM menampilkan plot data yang menunjukkan adanya hubungan linear antara Tahun dan IPM.

library(forecast)
## Warning: package 'forecast' was built under R version 4.1.2
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(TTR)
## Warning: package 'TTR' was built under R version 4.1.1
#Membentuk objek time series
datats<-ts(dataipm$IPM)
datats
## Time Series:
## Start = 1 
## End = 12 
## Frequency = 1 
##  [1] 76.31 76.98 77.53 78.08 78.39 78.99 79.60 80.06 80.47 80.76 80.77 81.11
#Membuat plot time series
ts.plot(datats, xlab="Time Period ", ylab="IPM", main= "Time Series Plot of IPM")
points(datats)

Plot data time series IPM menunjukkan bahwa terdapat pola trend pada data.

#================Single Moving Average (SMA)================#
#Pemulusan SMA dengan n=4
data.sma<-SMA(datats, n=4)
data.sma
## Time Series:
## Start = 1 
## End = 12 
## Frequency = 1 
##  [1]      NA      NA      NA 77.2250 77.7450 78.2475 78.7650 79.2600 79.7800
## [10] 80.2225 80.5150 80.7775
data.ramal<-c(NA,data.sma)
data.ramal #forecast 1 periode ke depan
##  [1]      NA      NA      NA      NA 77.2250 77.7450 78.2475 78.7650 79.2600
## [10] 79.7800 80.2225 80.5150 80.7775
data.gab<-cbind(aktual=c(datats,rep(NA,5)),pemulusan=c(data.sma,rep(NA,5)),ramalan=c(data.ramal,rep(data.ramal[length(data.ramal)],4)))
data.gab #forecast 5 periode ke depan
##       aktual pemulusan ramalan
##  [1,]  76.31        NA      NA
##  [2,]  76.98        NA      NA
##  [3,]  77.53        NA      NA
##  [4,]  78.08   77.2250      NA
##  [5,]  78.39   77.7450 77.2250
##  [6,]  78.99   78.2475 77.7450
##  [7,]  79.60   78.7650 78.2475
##  [8,]  80.06   79.2600 78.7650
##  [9,]  80.47   79.7800 79.2600
## [10,]  80.76   80.2225 79.7800
## [11,]  80.77   80.5150 80.2225
## [12,]  81.11   80.7775 80.5150
## [13,]     NA        NA 80.7775
## [14,]     NA        NA 80.7775
## [15,]     NA        NA 80.7775
## [16,]     NA        NA 80.7775
## [17,]     NA        NA 80.7775
#Plot time series
ts.plot(data.gab[,1], xlab="Time Period ", ylab="IPM", main= "SMA N=4 Data IPM")
points(data.gab[,1])
lines(data.gab[,2],col="green",lwd=2)
lines(data.gab[,3],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.8)

#Menghitung nilai keakuratan
error.sma = datats-data.ramal[1:length(datats)]
SSE.sma = sum(error.sma[5:length(datats)]^2)
MSE.sma = mean(error.sma[5:length(datats)]^2)
MAPE.sma = mean(abs((error.sma[5:length(datats)]/datats[5:length(datats)])*100))

akurasi.sma <- matrix(c(SSE.sma, MSE.sma, MAPE.sma))
row.names(akurasi.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi.sma) <- c("Akurasi m = 4")
akurasi.sma
##      Akurasi m = 4
## SSE       9.491812
## MSE       1.186477
## MAPE      1.313441
#Pemulusan DMA dengan n=4
dma <- SMA(data.sma, n = 4)
At <- 2*data.sma - dma
Bt <- 2/(4-1)*(data.sma - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)

t = 1:5
f = c()

for (i in t) {
  f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}

data.gab2 <- cbind(aktual = c(datats,rep(NA,5)), pemulusan1 = c(data.sma,rep(NA,5)),pemulusan2 = c(data.dma, rep(NA,5)),At = c(At, rep(NA,5)), Bt = c(Bt,rep(NA,5)),ramalan = c(data.ramal2, f[-1]))
data.gab2
##       aktual pemulusan1 pemulusan2       At        Bt  ramalan
##  [1,]  76.31         NA         NA       NA        NA       NA
##  [2,]  76.98         NA         NA       NA        NA       NA
##  [3,]  77.53         NA         NA       NA        NA       NA
##  [4,]  78.08    77.2250         NA       NA        NA       NA
##  [5,]  78.39    77.7450         NA       NA        NA       NA
##  [6,]  78.99    78.2475         NA       NA        NA       NA
##  [7,]  79.60    78.7650   80.04729 79.53438 0.5129167       NA
##  [8,]  80.06    79.2600   80.51938 80.01563 0.5037500 80.04729
##  [9,]  80.47    79.7800   81.05813 80.54688 0.5112500 80.51938
## [10,]  80.76    80.2225   81.41521 80.93813 0.4770833 81.05813
## [11,]  80.77    80.5150   81.46604 81.08562 0.3804167 81.41521
## [12,]  81.11    80.7775   81.53375 81.23125 0.3025000 81.46604
## [13,]     NA         NA         NA       NA        NA 81.53375
## [14,]     NA         NA         NA       NA        NA 81.83625
## [15,]     NA         NA         NA       NA        NA 82.13875
## [16,]     NA         NA         NA       NA        NA 82.44125
## [17,]     NA         NA         NA       NA        NA 82.74375
#Plot time series
ts.plot(data.gab2[,1], xlab="Time Period ", ylab="IPM", main= "DMA N=4 Data IPM")
points(data.gab2[,1])
lines(data.gab2[,3],col="green",lwd=2)
lines(data.gab2[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.8)

error.dma = datats-data.ramal2[1:length(datats)]
SSE.dma = sum(error.dma[8:length(datats)]^2)
MSE.dma = mean(error.dma[8:length(datats)]^2)
MAPE.dma = mean(abs((error.dma[8:length(datats)]/datats[8:length(datats)])*100))

akurasi.dma <- matrix(c(SSE.dma, MSE.dma, MAPE.dma))
row.names(akurasi.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi.dma) <- c("Akurasi m = 4")
akurasi.dma
##      Akurasi m = 4
## SSE      0.6345374
## MSE      0.1269075
## MAPE     0.3368329
akurasi.sma
##      Akurasi m = 4
## SSE       9.491812
## MSE       1.186477
## MAPE      1.313441

Hasil SSE, MSE, MAPE metode pemulusan Double Moving Average dan Single Moving Average menunjukkan bahwa metode terbaik untuk pemulusan data Indeks Pembangunan Manusia Provinsi DKI Jakarta adalah metode Double Moving Average karena nilai SSE, MSE, dan MAPE paling kecil. Hal ini sejalan dengan sebaran bentuk data time series Indeks Pembangunan Manusia Provinsi DKI Jakarta yang mengikuti pola trend maka metode terbaik untuk melakukan pemulusan adalah metode Double Moving Average.

#korelasi Tahun dan IPM
cor(x, y)
## [1] 0.9879386

Nilai korelasi antara Tahun dan IPM sebesar 0.9879386, nilai tersebut terbilang kuat karena mendekati 1, sehingga menjelaskan bahwa ada hubungan kuat antara Tahun dan IPM, artinya ketika tahun meningkat maka IPM juga akan meningkat.

#model regresi
model<- lm(y~x, data = dataipm)
summary(model)
## 
## Call:
## lm(formula = y ~ x, data = dataipm)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.42154 -0.16017  0.05061  0.16141  0.30594 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -816.54150   44.39144  -18.39 4.86e-09 ***
## x              0.44437    0.02202   20.18 1.97e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2634 on 10 degrees of freedom
## Multiple R-squared:  0.976,  Adjusted R-squared:  0.9736 
## F-statistic: 407.1 on 1 and 10 DF,  p-value: 1.97e-09

Hipotesis :

H0 : Tidak ada hubungan linear antara Tahun dan IPM

H1 : Ada hubungan linear antara Tahun dan IPM

Model dugaan regresi :

Yduga = -816.54150 + 0.44437X

dengan p-value = 1.97x10^-9 < alpha = 0.05 sehingga tolak H0, menandakan bahwa cukup bukti untuk mengatakan adanya hubungan linear antara Tahun dan IPM.

Nilai R-squared sebesar 0.9736, nilai tersebut cukup kuat untuk mengatakan jika nilai tahun meningkat satu satuan, maka nilai IPM akan meningkat sebesar 0.4437

#sisaan dan fitted value
resiipm<- residuals(model)
fit<- predict(model)
#Diagnostik dengan eksploratif
par(mfrow = c(2,2))
qqnorm(resiipm)
qqline(resiipm, col = "steelblue", lwd = 2)
plot(fit, resiipm, col = "steelblue", pch = 20, xlab = "Sisaan", ylab = "Fitted Values", main = "Sisaan vs Fitted Values")
abline(a = 0, b = 0, lwd = 2)
hist(resiipm, col = "steelblue")
plot(seq(1,12,1), resiipm, col = "steelblue", pch = 20, xlab = "Sisaan", ylab = "Order", main = "Sisaan vs Order")
lines(seq(1,12,1), resiipm, col = "red")
abline(a = 0, b = 0, lwd = 2)

Interpretasi :

  1. Normal Q-Q Plot : Plot Q-Q Norm Data IPM Provinsi DKI Jakarta menunjukkan bahwa data mengikuti garis biru dan lurus, artinya secara eksplorasi data IPM Provinsi DKI Jakarta menyebar normal.

  2. Residuals vs Fitted Values Plot menunjukkan bahwa sebaran data tidak acak, karena terbentuk pola tertentu, menandakan bahwa adanya autokorelasi pada data.

#ACF dan PACF identifikasi autokorelasi
par(mfrow = c(1,1))
acf(resiipm)

pacf(resiipm)

Plot ACF dan PACF menunjukkan bahwa data Indeks Pembangunan Manusia Provinsi DKI Jakarta masih berada pada batas normal autokorelasi atau tidak ada autokorelasi.

#Deteksi autokorelasi dengan uji-Durbin Watson
library(lmtest)
## Warning: package 'lmtest' was built under R version 4.1.1
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.1.1
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
#Durbin Watson Test
#H0: tidak ada autokorelasi
#H1: ada autokorelasi
dwtest(model)
## 
##  Durbin-Watson test
## 
## data:  model
## DW = 0.53015, p-value = 6.42e-05
## alternative hypothesis: true autocorrelation is greater than 0

Durbin Watson Test bertujuan untuk melihat apakah terdapat autokorelasi pada data.

Hasil Durbin Watson Test pada Data IPM Provinsi DKI Jakarta menunjukkan

p-value = 6.42x10^-5 < alpha = 0.05

artinya Tolak H0, cukup bukti untuk mengatakan adanya autokorelasi pada data.

#Breusch-Godfrey Test 
#H0: tidak ada autokorelasi
#H1: ada autokorelasi
bgtest(y ~ x, data=dataipm, order=1)
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  y ~ x
## LM test = 5.1467, df = 1, p-value = 0.02329

Breusch-Godfrey Test bertujuan untuk melihat apakah terdapat autokorelasi pada data.

Hasil Breusch-GOdfrey Test pada Data IPM Provinsi DKI Jakarta menunjukkan p-value = 0.02329 < alpha = 0.05 artinya Tolak H0, cukup bukti untuk mengatakan adanya autokorelasi pada data.

Penanganan autokorelasi dengan metode Hildreth Lu.

y <- dataipm$IPM
x <- dataipm$Tahun
#Penanganan Autokorelasi Hildreth 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
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, model))}))
round(tab, 4)
##     rho    SSE
## 1  0.10 0.4607
## 2  0.20 0.3942
## 3  0.30 0.3366
## 4  0.40 0.2878
## 5  0.50 0.2478
## 6  0.60 0.2167
## 7  0.70 0.1944
## 8  0.80 0.1809
## 9  0.90 0.1763
## 10 0.91 0.1763
## 11 0.92 0.1764
## 12 0.93 0.1766
## 13 0.94 0.1769
## 14 0.95 0.1773
## 15 0.96 0.1778
## 16 0.97 0.1783
## 17 0.98 0.1790
## 18 0.99 0.1797

SSE terkecil adalah 0.1763 sehingga rho terbaik adalah antara 0.90 dan 0.91.

#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.4;
r <- seq(0.8,0.92, by= 0.001)
tab <- data.frame("rho" = r, "SSE" = sapply(r, function(i){deviance(hildreth.lu.func(i, model))}))
round(tab, 4)
##       rho    SSE
## 1   0.800 0.1809
## 2   0.801 0.1808
## 3   0.802 0.1808
## 4   0.803 0.1807
## 5   0.804 0.1806
## 6   0.805 0.1805
## 7   0.806 0.1804
## 8   0.807 0.1803
## 9   0.808 0.1802
## 10  0.809 0.1802
## 11  0.810 0.1801
## 12  0.811 0.1800
## 13  0.812 0.1799
## 14  0.813 0.1798
## 15  0.814 0.1797
## 16  0.815 0.1797
## 17  0.816 0.1796
## 18  0.817 0.1795
## 19  0.818 0.1794
## 20  0.819 0.1794
## 21  0.820 0.1793
## 22  0.821 0.1792
## 23  0.822 0.1792
## 24  0.823 0.1791
## 25  0.824 0.1790
## 26  0.825 0.1789
## 27  0.826 0.1789
## 28  0.827 0.1788
## 29  0.828 0.1787
## 30  0.829 0.1787
## 31  0.830 0.1786
## 32  0.831 0.1785
## 33  0.832 0.1785
## 34  0.833 0.1784
## 35  0.834 0.1784
## 36  0.835 0.1783
## 37  0.836 0.1782
## 38  0.837 0.1782
## 39  0.838 0.1781
## 40  0.839 0.1781
## 41  0.840 0.1780
## 42  0.841 0.1780
## 43  0.842 0.1779
## 44  0.843 0.1779
## 45  0.844 0.1778
## 46  0.845 0.1778
## 47  0.846 0.1777
## 48  0.847 0.1777
## 49  0.848 0.1776
## 50  0.849 0.1776
## 51  0.850 0.1775
## 52  0.851 0.1775
## 53  0.852 0.1774
## 54  0.853 0.1774
## 55  0.854 0.1773
## 56  0.855 0.1773
## 57  0.856 0.1772
## 58  0.857 0.1772
## 59  0.858 0.1772
## 60  0.859 0.1771
## 61  0.860 0.1771
## 62  0.861 0.1771
## 63  0.862 0.1770
## 64  0.863 0.1770
## 65  0.864 0.1769
## 66  0.865 0.1769
## 67  0.866 0.1769
## 68  0.867 0.1769
## 69  0.868 0.1768
## 70  0.869 0.1768
## 71  0.870 0.1768
## 72  0.871 0.1767
## 73  0.872 0.1767
## 74  0.873 0.1767
## 75  0.874 0.1767
## 76  0.875 0.1766
## 77  0.876 0.1766
## 78  0.877 0.1766
## 79  0.878 0.1766
## 80  0.879 0.1765
## 81  0.880 0.1765
## 82  0.881 0.1765
## 83  0.882 0.1765
## 84  0.883 0.1765
## 85  0.884 0.1764
## 86  0.885 0.1764
## 87  0.886 0.1764
## 88  0.887 0.1764
## 89  0.888 0.1764
## 90  0.889 0.1764
## 91  0.890 0.1764
## 92  0.891 0.1764
## 93  0.892 0.1763
## 94  0.893 0.1763
## 95  0.894 0.1763
## 96  0.895 0.1763
## 97  0.896 0.1763
## 98  0.897 0.1763
## 99  0.898 0.1763
## 100 0.899 0.1763
## 101 0.900 0.1763
## 102 0.901 0.1763
## 103 0.902 0.1763
## 104 0.903 0.1763
## 105 0.904 0.1763
## 106 0.905 0.1763
## 107 0.906 0.1763
## 108 0.907 0.1763
## 109 0.908 0.1763
## 110 0.909 0.1763
## 111 0.910 0.1763
## 112 0.911 0.1763
## 113 0.912 0.1763
## 114 0.913 0.1763
## 115 0.914 0.1764
## 116 0.915 0.1764
## 117 0.916 0.1764
## 118 0.917 0.1764
## 119 0.918 0.1764
## 120 0.919 0.1764
## 121 0.920 0.1764
#grafik SSE optimum
plot(tab$SSE ~ tab$rho , type = "l")
abline(v = tab[tab$SSE==min(tab$SSE),"rho"], lty = 3)

Hasil rho terbaik dari metode Hildreth Lu menunjukkan bahwa rho sekitar 0.8 sampai 0.9, dilakukan pengujian rho terbaik untuk nilai 0.8 dan 0.9.

# Model terbaik rho 0.9
modelhl <- hildreth.lu.func(0.9, model)
summary(modelhl)
## 
## Call:
## lm(formula = y ~ x)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.262945 -0.031786  0.002045  0.082941  0.182273 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.92123   27.02291  -0.108    0.916
## x            0.05555    0.13345   0.416    0.687
## 
## Residual standard error: 0.14 on 9 degrees of freedom
## Multiple R-squared:  0.01889,    Adjusted R-squared:  -0.09013 
## F-statistic: 0.1733 on 1 and 9 DF,  p-value: 0.687

Hipotesis :

H0 : Tidak ada hubungan linear antara Tahun dan IPM

H1 : ada hubungan linear antara Tahun dan IPM

Model Hildreth Lu dengan rho 0.9 menunjukkan bahwa model dugaan regresi dengan p-value = 0.687 > 0.05 artinya terima H0, tidak cukup bukti untuk mengatakan bahwa ada hubungan linear antara Tahun dan IPM.

Dugaan Persamaan Regresi :

ŷ = -2.92123 + 0.05555*x

Model dugaan regresi dengan rho rekomendasi Hildreth Lu justru menunjukkan bahwa model dugaan regresi tidak linear, gunakan rho lebih rendah 0.1 satuan dan menunjukkan bahwa model dugaan regresi terdapat hubungan linear.

# Model terbaik rho 0.8
modelhl2 <- hildreth.lu.func(0.8, model)
summary(modelhl2)
## 
## Call:
## lm(formula = y ~ x)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.26426 -0.04278  0.01004  0.10547  0.19091 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)   
## (Intercept) -89.41055   27.30795  -3.274  0.00962 **
## x             0.26145    0.06759   3.868  0.00380 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1418 on 9 degrees of freedom
## Multiple R-squared:  0.6244, Adjusted R-squared:  0.5827 
## F-statistic: 14.96 on 1 and 9 DF,  p-value: 0.0038

Hipotesis :

H0 : Tidak ada hubungan linear antara Tahun dan IPM

H1 : ada hubungan linear antara Tahun dan IPM

Model Hildreth Lu dengan rho 0.8 menunjukkan bahwa model dugaan regresi dengan p-value = 0.0038 < 0.05 artinya tolak H0, cukup bukti untuk mengatakan bahwa ada hubungan linear antara Tahun dan IPM.

Dugaan persamaan regresi :

ŷ = -89.41055 + 0.26145*x

# Deteksi autokorelasi model Hidreth Lu SSE 0.9
dwtest(modelhl)
## 
##  Durbin-Watson test
## 
## data:  modelhl
## DW = 1.8932, p-value = 0.2811
## alternative hypothesis: true autocorrelation is greater than 0

Hasil Durbin-Watson model Hildreth Lu dengan rho 0.9 menunjukkan bahwa

p-value sebesar 0.2811 > alpha = 0.05

artinya tak tolak H0, cukup bukti untuk mengatakan bahwa model Hildreth Lu dengan rho 0.9 tidak terdapat autokorelasi pada data.

# Deteksi autokorelasi model Hidreth Lu SSE 0.8
dwtest(modelhl2)
## 
##  Durbin-Watson test
## 
## data:  modelhl2
## DW = 1.6695, p-value = 0.163
## alternative hypothesis: true autocorrelation is greater than 0

Hasil Durbin-Watson model Hildreth Lu dengan rho 0.8 menunjukkan bahwa

p-value sebesar 0.163 > alpha = 0.05

artinya tak tolak H0, cukup bukti untuk mengatakan bahwa model Hildreth Lu dengan rho 0.8 tidak terdapat autokorelasi pada data.

# Transformasi Balik
cat("y = ", -89.41055/(1-0.8), "+", coef(modelhl2)[2],"x", sep = "")
## y = -447.0528+0.2614545x

Penanganan Autokorelasi dengan Metode Cochrane Orcutt.

p <- c(2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020,2021)
p
##  [1] 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021
q <- c(76.31,76.98,77.53,78.08,78.39,78.99, 79.6, 80.06, 80.47, 80.76, 80.77, 81.11)
q
##  [1] 76.31 76.98 77.53 78.08 78.39 78.99 79.60 80.06 80.47 80.76 80.77 81.11
ipm <- as.data.frame(cbind(p,q))
ipm
##       p     q
## 1  2010 76.31
## 2  2011 76.98
## 3  2012 77.53
## 4  2013 78.08
## 5  2014 78.39
## 6  2015 78.99
## 7  2016 79.60
## 8  2017 80.06
## 9  2018 80.47
## 10 2019 80.76
## 11 2020 80.77
## 12 2021 81.11
model_ipm <- lm(ipm$q~ipm$p)
model_ipm
## 
## Call:
## lm(formula = ipm$q ~ ipm$p)
## 
## Coefficients:
## (Intercept)        ipm$p  
##   -816.5415       0.4444
library(orcutt)
## Warning: package 'orcutt' was built under R version 4.1.2
modelco <- cochrane.orcutt(model_ipm)
## Warning in cochrane.orcutt(model_ipm): Did not converge
modelco
## Cochrane-orcutt estimation for first order autocorrelation 
##  
## Call:
## lm(formula = ipm$q ~ ipm$p)
## 
##  number of interaction: 100
##  rho 0.869529
## 
## Durbin-Watson statistic 
## (original):    0.53015 , p-value: 6.42e-05
## (transformed): NA , p-value: NA
##  
##  coefficients: 
## [1] NA

Penanganan data IPM Provinsi DKI Jakarta tidak mendukung dengan metode Cochrane Orcutt, tetapi untuk rho yang direkomendasikan oleh metode Cochrane Orcutt hampir sama dengan metode Hildreth Lu yaitu 0.8

Terdapat error dengan penanganan metode Cochrane Orcutt, dengan rho 0.869529, nilai rho metode Cochrane Orcutt hampir sama dengan nilai rho metode Hildreth Lu pada nilai sekitar 0.8.

Kesimpulan :

Data Indeks Pembangunan Manusia Provinsi DKI Jakarta Tahun 2010 - 2021 menujukkan pola trend pada data time series, terdapat autokorelasi dengan eksplorasi data, Uji Durbin Watson, Uji Breusch-Godfrey Test membuktikan bahwa terdapat autokorelasi di data tersebut.

Penanganan autokorelasi pada data menggunakan Metode Hildreth Lu dengan rho terbaik sebesar 0.8 menghasilkan p-value = 0.163 menunjukkan data tidak terdapat autokorelasi. Persamaan dugaan regresi setelah dilakukan penanganan autokorelasi dengan metode Hildreth Lu :

y = -447.0528+0.2614545x

Sumber :

  1. BPS [Badan Pusat Statistik]. Booklet Indeks Pembangunan Manusia Metode Baru Badan Pusat Statistik.

  2. BPS Provinsi DKI Jakarta. 2021. Indeks Pembangunan Manusia DKI Jakarta 2021. Jakarta (ID) : Badan Pusat Statistik Provinsi DKI Jakarta.