Penelitian ini menggunakan data IPM Provinsi di Indonesia dan faktor yang mempengaruhi tahun 2023. Variabel dependen yang digunakan yaitu Indeks Pembangunan Manusia (Y). Sedangkan variabel independen yang digunakan yaitu Harapan Lama Sekolah (X1), Rata-rata Lama Sekolah (X2), Pengeluaran (X3), Tingkat Partisipasi Angkatan Kerja (X4), dan Umur Harapan Hidup saat lahir (X5). Tahapan analisis dalam penelitian yaitu menyiapkan dan mendeskripsikan data, memodelkan IPM dan faktor yang mempengaruhi menggunakan Regresi Linier, Quantile Regression dan Bayesian Quantile Regression.
dataku<-read.csv("D:/Artikel - Fitri/DATA REV3.csv")head(dataku)## P Y X1 X2 X3 X4 X5 X6
## 1 Kepulauan Bangka 74.09 12.31 8.25 13.589 4.56 68.34 73.90
## 2 Gorontalo 71.25 13.16 8.10 11.069 3.06 70.79 70.50
## 3 Riau 74.95 13.30 9.32 11.448 4.23 64.45 74.18
## 4 DKI Jakarta 83.55 13.33 11.45 19.373 6.53 65.21 75.81
## 5 Kepulauan Riau 79.08 13.05 10.41 14.998 6.80 68.68 74.90
## 6 Sulawesi Selatan 74.60 13.54 8.76 11.841 4.33 65.66 73.63summary(dataku)## P Y X1 X2
## Length:34 Min. :63.01 Min. :11.15 Min. : 7.150
## Class :character 1st Qu.:72.40 1st Qu.:12.87 1st Qu.: 8.160
## Mode :character Median :73.91 Median :13.26 Median : 8.895
## Mean :73.77 Mean :13.30 Mean : 8.928
## 3rd Qu.:75.02 3rd Qu.:13.67 3rd Qu.: 9.422
## Max. :83.55 Max. :15.66 Max. :11.450
## X3 X4 X5 X6
## Min. : 7.562 Min. :2.270 Min. :63.60 Min. :68.17
## 1st Qu.:10.125 1st Qu.:3.487 1st Qu.:66.66 1st Qu.:71.85
## Median :11.276 Median :4.320 Median :69.69 Median :73.78
## Mean :11.470 Mean :4.614 Mean :69.34 Mean :73.13
## 3rd Qu.:12.285 3rd Qu.:5.763 3rd Qu.:71.02 3rd Qu.:74.56
## Max. :19.373 Max. :7.520 Max. :77.20 Max. :75.81MODEL_REGLIN
model_reglin<-lm(Y~X1+X2+X3+X4+X5, data=dataku)
summary(model_reglin)##
## Call:
## lm(formula = Y ~ X1 + X2 + X3 + X4 + X5, data = dataku)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.1548 -0.2961 0.2110 0.4924 1.0282
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 35.22824 5.41554 6.505 4.75e-07 ***
## X1 1.32118 0.23535 5.614 5.20e-06 ***
## X2 0.84413 0.26735 3.157 0.00379 **
## X3 1.15508 0.08331 13.865 4.59e-14 ***
## X4 0.20486 0.14711 1.393 0.17470
## X5 -0.01088 0.05823 -0.187 0.85315
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8303 on 28 degrees of freedom
## Multiple R-squared: 0.9587, Adjusted R-squared: 0.9513
## F-statistic: 130 on 5 and 28 DF, p-value: < 2.2e-16Regresi Kuantil Multivariate
library(quantreg)## Loading required package: SparseMmodel_kuantil=rq(Y~X1+X2+X3+X4+X5,data=dataku,tau=c(0.1,0.25,0.5,0.75,0.9))
summary(model_kuantil,se='iid',method='br')## Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique
## Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique##
## Call: rq(formula = Y ~ X1 + X2 + X3 + X4 + X5, tau = c(0.1, 0.25, 0.5,
## 0.75, 0.9), data = dataku)
##
## tau: [1] 0.1
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 32.66382 11.86578 2.75278 0.01025
## X1 1.60530 0.51566 3.11311 0.00424
## X2 1.20421 0.58579 2.05572 0.04924
## X3 1.05643 0.18254 5.78746 0.00000
## X4 -0.29477 0.32232 -0.91452 0.36825
## X5 -0.04359 0.12759 -0.34161 0.73520
##
## Call: rq(formula = Y ~ X1 + X2 + X3 + X4 + X5, tau = c(0.1, 0.25, 0.5,
## 0.75, 0.9), data = dataku)
##
## tau: [1] 0.25
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 31.94613 3.39917 9.39822 0.00000
## X1 1.40875 0.14772 9.53661 0.00000
## X2 0.59402 0.16781 3.53988 0.00142
## X3 1.17721 0.05229 22.51242 0.00000
## X4 0.44483 0.09233 4.81758 0.00005
## X5 0.02745 0.03655 0.75105 0.45889
##
## Call: rq(formula = Y ~ X1 + X2 + X3 + X4 + X5, tau = c(0.1, 0.25, 0.5,
## 0.75, 0.9), data = dataku)
##
## tau: [1] 0.5
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 35.23023 5.65154 6.23374 0.00000
## X1 0.91008 0.24560 3.70550 0.00092
## X2 1.21779 0.27900 4.36479 0.00016
## X3 1.16961 0.08694 13.45290 0.00000
## X4 0.24107 0.15352 1.57031 0.12758
## X5 0.01872 0.06077 0.30805 0.76033
##
## Call: rq(formula = Y ~ X1 + X2 + X3 + X4 + X5, tau = c(0.1, 0.25, 0.5,
## 0.75, 0.9), data = dataku)
##
## tau: [1] 0.75
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 38.08483 3.43537 11.08609 0.00000
## X1 1.03457 0.14929 6.92980 0.00000
## X2 1.01308 0.16960 5.97351 0.00000
## X3 1.12326 0.05285 21.25442 0.00000
## X4 0.17711 0.09332 1.89788 0.06807
## X5 -0.00427 0.03694 -0.11560 0.90879
##
## Call: rq(formula = Y ~ X1 + X2 + X3 + X4 + X5, tau = c(0.1, 0.25, 0.5,
## 0.75, 0.9), data = dataku)
##
## tau: [1] 0.9
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 41.20906 1.47140 28.00679 0.00000
## X1 1.02184 0.06394 15.98038 0.00000
## X2 1.02577 0.07264 14.12146 0.00000
## X3 1.05569 0.02264 46.63893 0.00000
## X4 0.06916 0.03997 1.73035 0.09458
## X5 -0.02774 0.01582 -1.75328 0.09050CI_list <- lapply(summary(model_kuantil,se='iid',method='br'), function(m) {
coef_mat <- m$coefficients
est <- coef_mat[, 1]
se <- coef_mat[, 2]
lower <- est - 1.96 * se
upper <- est + 1.96 * se
data.frame(
Estimate = est,
CI_lower = lower,
CI_upper = upper
)
})## Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique
## Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique#Print CI 95% - QR
CI_list## [[1]]
## Estimate CI_lower CI_upper
## (Intercept) 32.66381897 9.40689539 55.9207425
## X1 1.60530411 0.59461199 2.6159962
## X2 1.20421235 0.05607295 2.3523518
## X3 1.05643396 0.69865855 1.4142094
## X4 -0.29476878 -0.92651773 0.3369802
## X5 -0.04358548 -0.29366177 0.2064908
##
## [[2]]
## Estimate CI_lower CI_upper
## (Intercept) 31.94612924 25.28376314 38.60849535
## X1 1.40874742 1.11921640 1.69827845
## X2 0.59402364 0.26511836 0.92292892
## X3 1.17720677 1.07471554 1.27969800
## X4 0.44482952 0.26385362 0.62580543
## X5 0.02745112 -0.04418775 0.09908999
##
## [[3]]
## Estimate CI_lower CI_upper
## (Intercept) 35.23022896 24.15320783 46.3072501
## X1 0.91008123 0.42869950 1.3914630
## X2 1.21779101 0.67094463 1.7646374
## X3 1.16960956 0.99920500 1.3400141
## X4 0.24107137 -0.05982382 0.5419666
## X5 0.01871998 -0.10038865 0.1378286
##
## [[4]]
## Estimate CI_lower CI_upper
## (Intercept) 38.084833240 31.35150544 44.81816104
## X1 1.034572783 0.74195793 1.32718764
## X2 1.013084960 0.68067646 1.34549345
## X3 1.123262333 1.01967946 1.22684521
## X4 0.177106732 -0.00579677 0.36001023
## X5 -0.004270375 -0.07667228 0.06813153
##
## [[5]]
## Estimate CI_lower CI_upper
## (Intercept) 41.20905662 38.325121610 44.092991624
## X1 1.02184079 0.896511638 1.147169933
## X2 1.02577301 0.883399947 1.168146071
## X3 1.05568954 1.011324215 1.100054868
## X4 0.06916005 -0.009178899 0.147498996
## X5 -0.02773971 -0.058749994 0.003270572install packages bayesqr
library(bayesQR)## Warning: package 'bayesQR' was built under R version 4.5.2model bayes qr tau=0,1 0,25 0,5 0,75 0,9
model_bqr1<-bayesQR(formula=Y~X1+X2+X3+X4+X5, data=dataku, quantile=0.1, ndraw=5000)## Current iteration :
## [1] 500
## Current iteration :
## [1] 1000
## Current iteration :
## [1] 1500
## Current iteration :
## [1] 2000
## Current iteration :
## [1] 2500
## Current iteration :
## [1] 3000
## Current iteration :
## [1] 3500
## Current iteration :
## [1] 4000
## Current iteration :
## [1] 4500
## Current iteration :
## [1] 5000summary(model_bqr1)##
## Type of dependent variable: continuous
## Lasso variable selection: no
## Normal approximation of posterior: yes
## Estimated quantile: 0.1
## Lower credible bound: 0.025
## Upper credible bound: 0.975
## Number of burnin draws: 0
## Number of retained draws: 5000
##
##
## Summary of the estimated beta:
##
## Bayes Estimate lower upper adj.lower adj.upper
## (Intercept) 5.552 -12.7818 23.979 -21.187 32.291
## X1 1.781 0.4579 3.202 -0.796 4.358
## X2 1.123 -0.8851 3.205 -4.649 6.895
## X3 1.030 0.4540 1.656 -0.445 2.505
## X4 0.655 -0.5132 1.795 -2.633 3.943
## X5 0.252 -0.0124 0.507 -0.204 0.708model_bqr2<-bayesQR(formula=Y~X1+X2+X3+X4+X5, data=dataku, quantile=0.25, ndraw=5000)## Current iteration :
## [1] 500
## Current iteration :
## [1] 1000
## Current iteration :
## [1] 1500
## Current iteration :
## [1] 2000
## Current iteration :
## [1] 2500
## Current iteration :
## [1] 3000
## Current iteration :
## [1] 3500
## Current iteration :
## [1] 4000
## Current iteration :
## [1] 4500
## Current iteration :
## [1] 5000summary(model_bqr2)##
## Type of dependent variable: continuous
## Lasso variable selection: no
## Normal approximation of posterior: yes
## Estimated quantile: 0.25
## Lower credible bound: 0.025
## Upper credible bound: 0.975
## Number of burnin draws: 0
## Number of retained draws: 5000
##
##
## Summary of the estimated beta:
##
## Bayes Estimate lower upper adj.lower adj.upper
## (Intercept) 12.941 -3.33010 28.95 -12.900 38.782
## X1 1.620 0.53859 2.64 -0.535 3.776
## X2 1.065 -0.15348 2.33 -1.600 3.729
## X3 1.101 0.72260 1.50 0.107 2.095
## X4 0.539 -0.14212 1.21 -0.985 2.063
## X5 0.200 0.00168 0.41 -0.185 0.586model_bqr3<-bayesQR(formula=Y~X1+X2+X3+X4+X5, data=dataku, quantile=0.5, ndraw=5000)## Current iteration :
## [1] 500
## Current iteration :
## [1] 1000
## Current iteration :
## [1] 1500
## Current iteration :
## [1] 2000
## Current iteration :
## [1] 2500
## Current iteration :
## [1] 3000
## Current iteration :
## [1] 3500
## Current iteration :
## [1] 4000
## Current iteration :
## [1] 4500
## Current iteration :
## [1] 5000summary(model_bqr3)##
## Type of dependent variable: continuous
## Lasso variable selection: no
## Normal approximation of posterior: yes
## Estimated quantile: 0.5
## Lower credible bound: 0.025
## Upper credible bound: 0.975
## Number of burnin draws: 0
## Number of retained draws: 5000
##
##
## Summary of the estimated beta:
##
## Bayes Estimate lower upper adj.lower adj.upper
## (Intercept) 17.140 1.2115 31.840 -6.151 40.430
## X1 1.434 0.3238 2.592 -1.365 4.234
## X2 1.183 0.0593 2.303 -1.457 3.822
## X3 1.145 0.7576 1.515 0.179 2.111
## X4 0.471 -0.0220 0.965 -0.534 1.476
## X5 0.171 -0.0163 0.378 -0.240 0.582model_bqr4<-bayesQR(formula=Y~X1+X2+X3+X4+X5, data=dataku, quantile=0.75, ndraw=5000)## Current iteration :
## [1] 500
## Current iteration :
## [1] 1000
## Current iteration :
## [1] 1500
## Current iteration :
## [1] 2000
## Current iteration :
## [1] 2500
## Current iteration :
## [1] 3000
## Current iteration :
## [1] 3500
## Current iteration :
## [1] 4000
## Current iteration :
## [1] 4500
## Current iteration :
## [1] 5000summary(model_bqr4)##
## Type of dependent variable: continuous
## Lasso variable selection: no
## Normal approximation of posterior: yes
## Estimated quantile: 0.75
## Lower credible bound: 0.025
## Upper credible bound: 0.975
## Number of burnin draws: 0
## Number of retained draws: 5000
##
##
## Summary of the estimated beta:
##
## Bayes Estimate lower upper adj.lower adj.upper
## (Intercept) 13.873 -3.313276 30.35 -14.460 42.205
## X1 1.428 0.125874 2.87 -2.267 5.124
## X2 1.379 -0.044908 2.77 -2.142 4.899
## X3 1.171 0.664539 1.69 -0.373 2.716
## X4 0.484 -0.096823 1.12 -0.791 1.759
## X5 0.200 0.000496 0.44 -0.273 0.673model_bqr5<-bayesQR(formula=Y~X1+X2+X3+X4+X5, data=dataku, quantile=0.9, ndraw=5000)## Current iteration :
## [1] 500
## Current iteration :
## [1] 1000
## Current iteration :
## [1] 1500
## Current iteration :
## [1] 2000
## Current iteration :
## [1] 2500
## Current iteration :
## [1] 3000
## Current iteration :
## [1] 3500
## Current iteration :
## [1] 4000
## Current iteration :
## [1] 4500
## Current iteration :
## [1] 5000summary(model_bqr5)##
## Type of dependent variable: continuous
## Lasso variable selection: no
## Normal approximation of posterior: yes
## Estimated quantile: 0.9
## Lower credible bound: 0.025
## Upper credible bound: 0.975
## Number of burnin draws: 0
## Number of retained draws: 5000
##
##
## Summary of the estimated beta:
##
## Bayes Estimate lower upper adj.lower adj.upper
## (Intercept) 6.644 -12.50911 24.955 -23.443 36.731
## X1 1.667 -0.25847 3.809 -3.908 7.241
## X2 1.523 -0.63206 3.605 -4.538 7.584
## X3 1.153 0.37323 1.958 -1.366 3.672
## X4 0.592 -0.29807 1.689 -2.247 3.431
## X5 0.251 0.00572 0.542 -0.311 0.813Menghitung MSE BQR
coef_mean_1 <- colMeans(model_bqr1[[1]]$betadraw)
coef_mean_1## [1] 5.5519842 1.7807442 1.1230508 1.0300508 0.6550916 0.2523497coef_mean_2 <- colMeans(model_bqr2[[1]]$betadraw)
coef_mean_2## [1] 12.9409588 1.6204536 1.0649404 1.1012575 0.5392033 0.2003870coef_mean_3 <- colMeans(model_bqr3[[1]]$betadraw)
coef_mean_3## [1] 17.1395076 1.4341752 1.1828473 1.1446856 0.4708146 0.1709446coef_mean_4 <- colMeans(model_bqr4[[1]]$betadraw)
coef_mean_4## [1] 13.8726887 1.4283380 1.3785095 1.1712136 0.4837788 0.1999002coef_mean_5 <- colMeans(model_bqr5[[1]]$betadraw)
coef_mean_5## [1] 6.6441135 1.6666504 1.5228818 1.1529562 0.5916955 0.2509373X_mat <- model.matrix(~ X1 + X2 + X3 + X4 + X5, data=dataku)
pred_1 <- X_mat %*% coef_mean_1
pred_2 <- X_mat %*% coef_mean_2
pred_3 <- X_mat %*% coef_mean_3
pred_4 <- X_mat %*% coef_mean_4
pred_5 <- X_mat %*% coef_mean_5
y <- dataku$Y
mse_1 <- mean((y - pred_1)^2)
mse_2 <- mean((y - pred_2)^2)
mse_3 <- mean((y - pred_3)^2)
mse_4 <- mean((y - pred_4)^2)
mse_5 <- mean((y - pred_5)^2)print MSE
mse_1## [1] 5.859494mse_2## [1] 1.474532mse_3## [1] 0.8483179mse_4## [1] 1.867804mse_5## [1] 5.298423