Input Data https://www.kaggle.com/datasets/uom190346a/sleep-health-and-lifestyle-dataset Peubah-peubah yang digunakan pada data ini adalah

y : Stress Level
x1 : Sleep Duration x2 : Quality of Sleep
x3 : Physical Activity Level

Sumber Data https://www.kaggle.com/datasets/uom190346a/sleep-health-and-lifestyle-dataset

library(rio)
data <- import("https://raw.githubusercontent.com/CahyaniDyahRofiana/PraktikumPSD/main/Data/dataprak.csv")
head(data)
##   Stress Level Sleep Duration Quality of Sleep Physical Activity Level
## 1            6            6.1                6                      42
## 2            8            6.2                6                      60
## 3            8            6.2                6                      60
## 4            8            5.9                4                      30
## 5            8            5.9                4                      30
## 6            8            5.9                4                      30
colnames(data) <- c("y","x1","x2","x3")
head(data)
##   y  x1 x2 x3
## 1 6 6.1  6 42
## 2 8 6.2  6 60
## 3 8 6.2  6 60
## 4 8 5.9  4 30
## 5 8 5.9  4 30
## 6 8 5.9  4 30

Regresi Klasik Pemodelan Awal

model <- lm(y ~ x1+x2+x3, data=data)
model
## 
## Call:
## lm(formula = y ~ x1 + x2 + x3, data = data)
## 
## Coefficients:
## (Intercept)           x1           x2           x3  
##    15.36513     -0.23832     -1.23520      0.01272
summary(model)
## 
## Call:
## lm(formula = y ~ x1 + x2 + x3, data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.7419 -0.4386  0.1832  0.3721  1.5966 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 15.365129   0.374601  41.017  < 2e-16 ***
## x1          -0.238322   0.102250  -2.331   0.0203 *  
## x2          -1.235199   0.067690 -18.248  < 2e-16 ***
## x3           0.012716   0.001867   6.812  3.9e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7338 on 370 degrees of freedom
## Multiple R-squared:  0.8304, Adjusted R-squared:  0.829 
## F-statistic: 603.8 on 3 and 370 DF,  p-value: < 2.2e-16
rsqk=summary(model)$r.squared;rsqk
## [1] 0.8303803
rsek=sigma(model);rsek
## [1] 0.7337941

Model regresi klasik menunjukkan bahwa peubah penjelas yang signifikan terhadap peubah respon adalah x1, x2, x3. Diketahui pula nilai R-Square dari model ini yaitu sebesar 83.04% artinya peubah-peubah penjelas yang digunakan mampu menjelaskan y sebagai peubah respon sebesar 83.04% , sementara nilai RSE sebesar 0.7337941

Ridge Regression Peubah yang digunakan

y <- data$y
x <- data.matrix(data[,c("x1","x2","x3")])
library(lmridge)
lmr <- lmridge(`y`~.,data=data)
summary(lmr)
## 
## Call:
## lmridge.default(formula = y ~ ., data = data)
## 
## 
## Coefficients: for Ridge parameter K= 0 
##           Estimate Estimate (Sc) StdErr (Sc) t-value (Sc) Pr(>|t|)    
## Intercept  15.3651      -62.3949     47.1706      -1.3227   0.1867    
## x1         -0.2383       -3.6622      1.5691      -2.3339   0.0201 *  
## x2         -1.2352      -28.5542      1.5627     -18.2725   <2e-16 ***
## x3          0.0127        5.1159      0.7500       6.8215   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Ridge Summary
##         R2     adj-R2   DF ridge          F        AIC        BIC 
##    0.83040    0.82950    2.99999  605.41536 -229.54765 1997.89674 
## Ridge minimum MSE= 5.46656 at K= 0 
## P-value for F-test ( 2.99999 , 371.0001 ) = 1.642193e-142 
## -------------------------------------------------------------------

CV

library(glmnet)
## Warning: package 'glmnet' was built under R version 4.2.3
## Loading required package: Matrix
## Loaded glmnet 4.1-8
cvr<- glmnet::cv.glmnet(x,y,alpha=0)
plot(cvr)

Best Model

best.lr<-cvr$lambda.min
bestridge<-glmnet(x,y,alpha=0,lambda=best.lr)
coef(bestridge)
## 4 x 1 sparse Matrix of class "dgCMatrix"
##                      s0
## (Intercept) 15.63160131
## x1          -0.53734032
## x2          -0.96750348
## x3           0.01117057

Model ini juga menunjukkan bahwa peubah x1 dan x2 memiliki hubungan negatif terhadap peubah tak bebas.

#Fungsi R-Square
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) 
}
#R-Square Ridge
rsqr = rsq(bestridge,best.lr,x,y);rsqr
## [1] 0.8224656
#Residual Standard Error Ridge
y_pred <- predict(bestridge, s = best.lr, newx = x)
residuals <- y - y_pred
RSS <- sum(residuals^2)
n <- length(y)
p <- length(coef(bestridge)) - 1  # Jumlah koefisien tanpa intercept
DFE <- n - p - 1
rser <- sqrt(RSS / DFE);rser
## [1] 0.7507188

Lasso Regression CV

cv.r<-cv.glmnet(x,y,alpha=1)
plot(cv.r)

Best Model

best.l<-cv.r$lambda.min
bestlasso<-glmnet(x,y,alpha=1,lambda=best.l)
coef(bestlasso)
## 4 x 1 sparse Matrix of class "dgCMatrix"
##                      s0
## (Intercept) 15.32498859
## x1          -0.23347939
## x2          -1.23119583
## x3           0.01231621
#Fungsi R-Square
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) 
}
#R-Square Lasso
rsql = rsq(bestlasso,best.l,x,y);rsql
## [1] 0.8303451
#Residual Standard Error Lasso
y_predl <- predict(bestlasso, s = best.l, newx = x)
residualsl <- y - y_predl
RSSl <- sum(residualsl^2)
nl <- length(y)
pl <- length(coef(bestlasso)) - 1  # Jumlah koefisien tanpa intercept
DFEl <- n - p - 1
rsel <- sqrt(RSSl / DFEl);rsel
## [1] 0.7338702

Perbandingan

# Buat vektor dengan peubah-peubah yang ingin Anda masukkan ke dalam tabel
peubah_klasik <- c(RSquare = rsqk, RSE = rsek)
peubah_ridge <- c(RSquare = rsqr, RSE = rser)
peubah_lasso <- c(RSquare = rsql, RSE = rsel)

# Gabungkan vektor-vektor tersebut menjadi sebuah matriks atau data frame
tabel_cross <- rbind(peubah_klasik, peubah_ridge, peubah_lasso)

# Berikan nama baris dan kolom
rownames(tabel_cross) <- c("klasik", "ridge", "lasso")
colnames(tabel_cross) <- c("RSquare", "RSE")

tabel_cross
##          RSquare       RSE
## klasik 0.8303803 0.7337941
## ridge  0.8224656 0.7507188
## lasso  0.8303451 0.7338702

Berdasarkan perbandingan di atas, diketahui bahwa model yang memiliki R-Square tertinggi dan Residual Standard Error (RSE) terendah adalah model regresi klasik. Hal ini berarti model regresi klasik lebih baik dalam menjelaskan variasi data dan lebih akurat dalam memprediksi nilai aktual.

Interpretasi Model Terbaik

summary(model)
## 
## Call:
## lm(formula = y ~ x1 + x2 + x3, data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.7419 -0.4386  0.1832  0.3721  1.5966 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 15.365129   0.374601  41.017  < 2e-16 ***
## x1          -0.238322   0.102250  -2.331   0.0203 *  
## x2          -1.235199   0.067690 -18.248  < 2e-16 ***
## x3           0.012716   0.001867   6.812  3.9e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7338 on 370 degrees of freedom
## Multiple R-squared:  0.8304, Adjusted R-squared:  0.829 
## F-statistic: 603.8 on 3 and 370 DF,  p-value: < 2.2e-16

y : Stress Level
x1 : Sleep Duration x2 : Quality of Sleep
x3 : Physical Activity Level Berdasarkan hasil model regresi klasik diperoleh informasi bahwa x1 (Sleep Duration) berpengaruh terhadap y (Stress Level) pada tingkat signifikansi 0.05 dan peubah x2 (Quality of Sleep ) dan x3 (Physical Activity Level) berpengaruh terhadap peubah y pada tingkat signifikansi 0.

Kemudian diketahui pula bahwa peubah x1 dan x2 berpengaruh negatif, artinya semakin tinggi nilai kedua peubah tersebut, maka akan semakin rendah nilai peubah y (Stress Level)