library(readxl)
library(car)
## Loading required package: carData
library(lmtest)
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(MASS)
library(glmnet)
## Warning: package 'glmnet' was built under R version 4.3.1
## Loading required package: Matrix
## Loaded glmnet 4.1-8

Input data

datatpsd <- read_excel("C:\\Users\\User\\Documents\\raziq\\semseter 5\\psd\\Tugas individu.xlsx")
datatpsd

Regresi klasik

modelklasik <- lm(IPM~JumlahPendudukMiskin+PDRB+AHH+Pendidikan, data=datatpsd)
modelklasik1 <- summary(modelklasik)
modelklasik1
## 
## Call:
## lm(formula = IPM ~ JumlahPendudukMiskin + PDRB + AHH + Pendidikan, 
##     data = datatpsd)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.3669 -0.7955  0.0870  0.7800  3.2824 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           1.014e+01  8.342e+00   1.215    0.234    
## JumlahPendudukMiskin -2.964e-04  2.506e-04  -1.183    0.247    
## PDRB                  7.432e-06  4.612e-06   1.611    0.118    
## AHH                   7.061e-01  1.369e-01   5.158 1.64e-05 ***
## Pendidikan            2.028e-01  2.714e-02   7.472 3.10e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.352 on 29 degrees of freedom
## Multiple R-squared:  0.8945, Adjusted R-squared:  0.8799 
## F-statistic: 61.45 on 4 and 29 DF,  p-value: 9.642e-14

Model regresi klasik yang didapatkan ialah \[IPM = 1.014e^{+01} - 2.964e^{-04}JumlahPendudukMiskin + 7.432e^{-06}PDRB + 7.061e^{-01}AHH + 2.028e^{-01}Pendidikan \]

R squared dan RSE model klasik

# R squared
R2.modelklasik <- modelklasik1$r.squared
R2.modelklasik
## [1] 0.8944696
# RSE
rse.modelklasik <- modelklasik1$sigma
rse.modelklasik
## [1] 1.351745

R2 model klasik yang didapatkan ialah \[R^2 = 0.8944696 \], dan rse model klasik yang didapatkan ialah \[RSE = 1.351745\]

Regresi Ridge

x <- data.matrix(datatpsd[,c('JumlahPendudukMiskin','PDRB','AHH','Pendidikan')])
y <- datatpsd$IPM
cv.r<-cv.glmnet(x,y,alpha=0)

best.lr<-cv.r$lambda.min
bestridge<-glmnet(x,y,alpha=0,lambda=best.lr)
coef(bestridge)
## 5 x 1 sparse Matrix of class "dgCMatrix"
##                                 s0
## (Intercept)           1.384306e+01
## JumlahPendudukMiskin -2.405764e-04
## PDRB                  8.414421e-06
## AHH                   6.619396e-01
## Pendidikan            1.904712e-01

Model regresi Ridge yang didapatkan ialah \[IPM = 1.384306e^{+01} - 2.405764e^{-04}JumlahPendudukMiskin + 8.414421e^{-06}PDRB + 6.619396e^{-01}AHH + 1.904712e^{-01}Pendidikan \]

R squared dan RSE model ridge

# fungsi untuk cari rsquared
rsq<-function(bestmodel,bestlambda,x,y){
 #y duga
 y.duga <- predict(bestmodel, s = bestlambda, newx = x)

 #JKG dan JKT
 jkt <- sum((y - mean(y))^2)
 jkg <- sum((y.duga- y)^2)

#find R-Squared
rsq <- 1 - jkg/jkt
return(rsq) 
}

# R2 ridge
R2.modelridge <- rsq(bestridge,best.lr,x,y)
R2.modelridge
## [1] 0.8919811
#RSE ridge
train_predictionsr <- predict(bestridge,newx = x)
# Hitung residu (selisih antara prediksi dan nilai sebenarnya)
residualsr <- y - train_predictionsr
# Hitung varian residu
dfr <- length(y) - length(bestridge$beta)
residual_variancer <- sum(residualsr^2) / dfr
# Hitung RSE
rse.modelridge <- sqrt(residual_variancer)
rse.modelridge
## [1] 1.344604

R2 model ridge yang didapatkan ialah \[R^2 = 0.8919811 \], dan rse model ridge yang didapatkan ialah \[RSE = 1.344604\]

Regresi Lasso

cv.l<-cv.glmnet(x,y,alpha=1)
best.ll<-cv.l$lambda.min
bestlasso<-glmnet(x,y,alpha=1,lambda=best.ll)
coef(bestlasso)
## 5 x 1 sparse Matrix of class "dgCMatrix"
##                                 s0
## (Intercept)           1.060306e+01
## JumlahPendudukMiskin -2.797461e-04
## PDRB                  7.387861e-06
## AHH                   6.994152e-01
## Pendidikan            2.025546e-01

Model regresi lasso yang didapatkan ialah \[IPM = 1.060306e^{+01} - 2.797461e^{-04}JumlahPendudukMiskin + 7.387861e^{-06}PDRB + 6.994152e^{-01}AHH + 2.025546e^{-01}Pendidikan \]

R squared dan RSE model Lasso

# R2 lasso
R2.modellasso <- rsq(bestlasso,best.ll,x,y)
R2.modellasso
## [1] 0.8944333
#RSElasso
train_predictionsLasso <- predict(bestlasso,newx = x)
# Hitung residu (selisih antara prediksi dan nilai sebenarnya)
residualsLasso <- y - train_predictionsLasso
# Hitung varian residu
dfLasso <- length(y) - length(bestlasso$beta)
residual_varianceLasso <- sum(residualsLasso^2) / dfLasso
# Hitung RSE
rse.modelLasso <- sqrt(residual_varianceLasso)
rse.modelLasso
## [1] 1.329254

R2 model lasso yang didapatkan ialah \[R^2 = 0.8944333 \], dan rse model lasso yang didapatkan ialah \[RSE = 1.329254\]

Perbandingan model regresi

perbandingan <- matrix(c(R2.modelklasik, R2.modelridge, R2.modellasso, rse.modelklasik, rse.modelridge, rse.modelLasso),ncol=2,byrow = F)
row.names(perbandingan)<- c("Model klasik","model ridge","model lasso")
colnames(perbandingan) <- c("R squared","RSE")
perbandingan
##              R squared      RSE
## Model klasik 0.8944696 1.351745
## model ridge  0.8919811 1.344604
## model lasso  0.8944333 1.329254

perbandingan dilihat dari nilai rse terendah, maka yang menghasilkan rse terendah = 1.329254, ialah model lasso, maka model terbaiknya ialah model lasso

Model Terbaik (Model lasso)

coef(bestlasso)
## 5 x 1 sparse Matrix of class "dgCMatrix"
##                                 s0
## (Intercept)           1.060306e+01
## JumlahPendudukMiskin -2.797461e-04
## PDRB                  7.387861e-06
## AHH                   6.994152e-01
## Pendidikan            2.025546e-01

\[IPM = 1.060306e^{+01} - 2.797461e^{-04}JumlahPendudukMiskin + 7.387861e^{-06}PDRB + 6.994152e^{-01}AHH + 2.025546e^{-01}Pendidikan \]

Interpretasi koefesien model

IPM akan meningkat jika jumlah penduduk miskin berkurang, PDRB meningkat, angka harapan hidup meningkat, dan pendidikan meningkat