DATA
data <- read.csv("D:/STATISTIKA/SEM 5/Modern Prediksi dan Machine Learning/Jurnal Tugas Pekan 2-3/bdims.csv")
dim(data)
## [1] 507 25
str(data)
## 'data.frame': 507 obs. of 25 variables:
## $ bia_di: num 42.9 43.7 40.1 44.3 42.5 43.3 43.5 44.4 43.5 42 ...
## $ bii_di: num 26 28.5 28.2 29.9 29.9 27 30 29.8 26.5 28 ...
## $ bit_di: num 31.5 33.5 33.3 34 34 31.5 34 33.2 32.1 34 ...
## $ che_de: num 17.7 16.9 20.9 18.4 21.5 19.6 21.9 21.8 15.5 22.5 ...
## $ che_di: num 28 30.8 31.7 28.2 29.4 31.3 31.7 28.8 27.5 28 ...
## $ elb_di: num 13.1 14 13.9 13.9 15.2 14 16.1 15.1 14.1 15.6 ...
## $ wri_di: num 10.4 11.8 10.9 11.2 11.6 11.5 12.5 11.9 11.2 12 ...
## $ kne_di: num 18.8 20.6 19.7 20.9 20.7 18.8 20.8 21 18.9 21.1 ...
## $ ank_di: num 14.1 15.1 14.1 15 14.9 13.9 15.6 14.6 13.2 15 ...
## $ sho_gi: num 106 110 115 104 108 ...
## $ che_gi: num 89.5 97 97.5 97 97.5 ...
## $ wai_gi: num 71.5 79 83.2 77.8 80 82.5 82 76.8 68.5 77.5 ...
## $ nav_gi: num 74.5 86.5 82.9 78.8 82.5 80.1 84 80.5 69 81.5 ...
## $ hip_gi: num 93.5 94.8 95 94 98.5 95.3 101 98 89.5 99.8 ...
## $ thi_gi: num 51.5 51.5 57.3 53 55.4 57.5 60.9 56 50 59.8 ...
## $ bic_gi: num 32.5 34.4 33.4 31 32 33 42.4 34.1 33 36.5 ...
## $ for_gi: num 26 28 28.8 26.2 28.4 28 32.3 28 26 29.2 ...
## $ kne_gi: num 34.5 36.5 37 37 37.7 36.6 40.1 39.2 35.5 38.3 ...
## $ cal_gi: num 36.5 37.5 37.3 34.8 38.6 36.1 40.3 36.7 35 38.6 ...
## $ ank_gi: num 23.5 24.5 21.9 23 24.4 23.5 23.6 22.5 22 22.2 ...
## $ wri_gi: num 16.5 17 16.9 16.6 18 16.9 18.8 18 16.5 16.9 ...
## $ age : int 21 23 28 23 22 21 26 27 23 21 ...
## $ wgt : num 65.6 71.8 80.7 72.6 78.8 74.8 86.4 78.4 62 81.6 ...
## $ hgt : num 174 175 194 186 187 ...
## $ sex : int 1 1 1 1 1 1 1 1 1 1 ...
names(data)
## [1] "bia_di" "bii_di" "bit_di" "che_de" "che_di" "elb_di" "wri_di" "kne_di"
## [9] "ank_di" "sho_gi" "che_gi" "wai_gi" "nav_gi" "hip_gi" "thi_gi" "bic_gi"
## [17] "for_gi" "kne_gi" "cal_gi" "ank_gi" "wri_gi" "age" "wgt" "hgt"
## [25] "sex"
head(data)
## bia_di bii_di bit_di che_de che_di elb_di wri_di kne_di ank_di sho_gi che_gi
## 1 42.9 26.0 31.5 17.7 28.0 13.1 10.4 18.8 14.1 106.2 89.5
## 2 43.7 28.5 33.5 16.9 30.8 14.0 11.8 20.6 15.1 110.5 97.0
## 3 40.1 28.2 33.3 20.9 31.7 13.9 10.9 19.7 14.1 115.1 97.5
## 4 44.3 29.9 34.0 18.4 28.2 13.9 11.2 20.9 15.0 104.5 97.0
## 5 42.5 29.9 34.0 21.5 29.4 15.2 11.6 20.7 14.9 107.5 97.5
## 6 43.3 27.0 31.5 19.6 31.3 14.0 11.5 18.8 13.9 119.8 99.9
## wai_gi nav_gi hip_gi thi_gi bic_gi for_gi kne_gi cal_gi ank_gi wri_gi age
## 1 71.5 74.5 93.5 51.5 32.5 26.0 34.5 36.5 23.5 16.5 21
## 2 79.0 86.5 94.8 51.5 34.4 28.0 36.5 37.5 24.5 17.0 23
## 3 83.2 82.9 95.0 57.3 33.4 28.8 37.0 37.3 21.9 16.9 28
## 4 77.8 78.8 94.0 53.0 31.0 26.2 37.0 34.8 23.0 16.6 23
## 5 80.0 82.5 98.5 55.4 32.0 28.4 37.7 38.6 24.4 18.0 22
## 6 82.5 80.1 95.3 57.5 33.0 28.0 36.6 36.1 23.5 16.9 21
## wgt hgt sex
## 1 65.6 174.0 1
## 2 71.8 175.3 1
## 3 80.7 193.5 1
## 4 72.6 186.5 1
## 5 78.8 187.2 1
## 6 74.8 181.5 1
MENENTUKAN VARIABEL
Y <- data$wgt
X1 <- data$bia_di
X2 <- data$bii_di
X3 <- data$bit_di
X4 <- data$che_de
X5 <- data$che_di
X6 <- data$elb_di
X7 <- data$wri_di
X8 <- data$kne_di
X9 <- data$ank_di
X10 <- data$sho_gi
X11 <- data$che_gi
X12 <- data$wai_gi
X13 <- data$nav_gi
X14 <- data$hip_gi
X15 <- data$thi_gi
X16 <- data$bic_gi
X17 <- data$for_gi
X18 <- data$kne_gi
X19 <- data$cal_gi
X20 <- data$ank_gi
X21 <- data$wri_gi
X22 <- data$age
X23 <- data$hgt
MEMBENTUK DATA REGRESI
data_reg <- data.frame(Y, X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,X20, X21, X22, X23)
head(data_reg)
## Y X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14
## 1 65.6 42.9 26.0 31.5 17.7 28.0 13.1 10.4 18.8 14.1 106.2 89.5 71.5 74.5 93.5
## 2 71.8 43.7 28.5 33.5 16.9 30.8 14.0 11.8 20.6 15.1 110.5 97.0 79.0 86.5 94.8
## 3 80.7 40.1 28.2 33.3 20.9 31.7 13.9 10.9 19.7 14.1 115.1 97.5 83.2 82.9 95.0
## 4 72.6 44.3 29.9 34.0 18.4 28.2 13.9 11.2 20.9 15.0 104.5 97.0 77.8 78.8 94.0
## 5 78.8 42.5 29.9 34.0 21.5 29.4 15.2 11.6 20.7 14.9 107.5 97.5 80.0 82.5 98.5
## 6 74.8 43.3 27.0 31.5 19.6 31.3 14.0 11.5 18.8 13.9 119.8 99.9 82.5 80.1 95.3
## X15 X16 X17 X18 X19 X20 X21 X22 X23
## 1 51.5 32.5 26.0 34.5 36.5 23.5 16.5 21 174.0
## 2 51.5 34.4 28.0 36.5 37.5 24.5 17.0 23 175.3
## 3 57.3 33.4 28.8 37.0 37.3 21.9 16.9 28 193.5
## 4 53.0 31.0 26.2 37.0 34.8 23.0 16.6 23 186.5
## 5 55.4 32.0 28.4 37.7 38.6 24.4 18.0 22 187.2
## 6 57.5 33.0 28.0 36.6 36.1 23.5 16.9 21 181.5
dim(data_reg)
## [1] 507 24
PREPROCESSING DATA
colSums(is.na(data_reg))
## Y X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17 X18 X19
## 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## X20 X21 X22 X23
## 0 0 0 0
sum(duplicated(data_reg))
## [1] 0
summary(data_reg)
## Y X1 X2 X3
## Min. : 42.00 Min. :32.40 Min. :18.70 Min. :24.70
## 1st Qu.: 58.40 1st Qu.:36.20 1st Qu.:26.50 1st Qu.:30.60
## Median : 68.20 Median :38.70 Median :28.00 Median :32.00
## Mean : 69.15 Mean :38.81 Mean :27.83 Mean :31.98
## 3rd Qu.: 78.85 3rd Qu.:41.15 3rd Qu.:29.25 3rd Qu.:33.35
## Max. :116.40 Max. :47.40 Max. :34.70 Max. :38.00
## X4 X5 X6 X7
## Min. :14.30 Min. :22.20 Min. : 9.90 Min. : 8.10
## 1st Qu.:17.30 1st Qu.:25.65 1st Qu.:12.40 1st Qu.: 9.80
## Median :19.00 Median :27.80 Median :13.30 Median :10.50
## Mean :19.23 Mean :27.97 Mean :13.39 Mean :10.54
## 3rd Qu.:20.90 3rd Qu.:29.95 3rd Qu.:14.40 3rd Qu.:11.20
## Max. :27.50 Max. :35.60 Max. :16.70 Max. :13.30
## X8 X9 X10 X11
## Min. :15.70 Min. : 9.90 Min. : 85.90 Min. : 72.60
## 1st Qu.:17.90 1st Qu.:13.00 1st Qu.: 99.45 1st Qu.: 85.30
## Median :18.70 Median :13.80 Median :108.20 Median : 91.60
## Mean :18.81 Mean :13.86 Mean :108.20 Mean : 93.33
## 3rd Qu.:19.60 3rd Qu.:14.80 3rd Qu.:116.55 3rd Qu.:101.15
## Max. :24.30 Max. :17.20 Max. :134.80 Max. :118.70
## X12 X13 X14 X15
## Min. : 57.90 Min. : 64.00 Min. : 78.80 Min. :46.30
## 1st Qu.: 68.00 1st Qu.: 78.85 1st Qu.: 92.00 1st Qu.:53.70
## Median : 75.80 Median : 84.60 Median : 96.00 Median :56.30
## Mean : 76.98 Mean : 85.65 Mean : 96.68 Mean :56.86
## 3rd Qu.: 84.50 3rd Qu.: 91.60 3rd Qu.:101.00 3rd Qu.:59.50
## Max. :113.20 Max. :121.10 Max. :128.30 Max. :75.70
## X16 X17 X18 X19
## Min. :22.40 Min. :19.60 Min. :29.00 Min. :28.40
## 1st Qu.:27.60 1st Qu.:23.60 1st Qu.:34.40 1st Qu.:34.10
## Median :31.00 Median :25.80 Median :36.00 Median :36.00
## Mean :31.17 Mean :25.94 Mean :36.20 Mean :36.08
## 3rd Qu.:34.45 3rd Qu.:28.40 3rd Qu.:37.95 3rd Qu.:38.00
## Max. :42.40 Max. :32.50 Max. :49.00 Max. :47.70
## X20 X21 X22 X23
## Min. :16.40 Min. :13.0 Min. :18.00 Min. :147.2
## 1st Qu.:21.00 1st Qu.:15.0 1st Qu.:23.00 1st Qu.:163.8
## Median :22.00 Median :16.1 Median :27.00 Median :170.3
## Mean :22.16 Mean :16.1 Mean :30.18 Mean :171.1
## 3rd Qu.:23.30 3rd Qu.:17.1 3rd Qu.:36.00 3rd Qu.:177.8
## Max. :29.30 Max. :19.6 Max. :67.00 Max. :198.1
sapply(data_reg, sd)
## Y X1 X2 X3 X4 X5 X6 X7
## 13.345762 3.059132 2.206308 2.030916 2.515877 2.741650 1.352906 0.944361
## X8 X9 X10 X11 X12 X13 X14 X15
## 1.347595 1.247351 10.374834 10.027621 11.012688 9.424128 6.680623 4.459889
## X16 X17 X18 X19 X20 X21 X22 X23
## 4.246941 2.830579 2.617570 2.847661 1.862337 1.380931 9.608472 9.407205
sapply(data_reg, function(x) var(x) == 0)
## Y X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12
## FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## X13 X14 X15 X16 X17 X18 X19 X20 X21 X22 X23
## FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
MEMBAGI DATA TRAINING DAN TESTING
set.seed(7)
n <- nrow(data_reg)
index_train <- sample(1:n, size = 0.8 * n)
train_data <- data_reg[index_train, ]
test_data <- data_reg[-index_train, ]
nrow(train_data)
## [1] 405
nrow(test_data)
## [1] 102
MENYIAPKAN DATA TRAINING DAN TESTING
x_train <- as.matrix(train_data[, paste0("X", 1:23)])
y_train <- train_data$Y
x_test <- as.matrix(test_data[, paste0("X", 1:23)])
y_test <- test_data$Y
EKSPLORASI VARIABEL DEPENDEN
hist(
train_data$Y,
main = "Histogram Berat Badan",
xlab = "Berat Badan (kg)",
ylab = "Frekuensi"
)
KORELASI ANTAR VARIABEL INDEPENDEN
cor_X <- cor(train_data[, paste0("X", 1:23)])
round(cor_X, 2)
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15
## X1 1.00 0.35 0.53 0.59 0.78 0.77 0.72 0.64 0.67 0.80 0.73 0.66 0.35 0.38 0.13
## X2 0.35 1.00 0.69 0.36 0.35 0.35 0.29 0.45 0.38 0.31 0.34 0.45 0.61 0.58 0.42
## X3 0.53 0.69 1.00 0.48 0.54 0.54 0.49 0.62 0.51 0.50 0.50 0.58 0.61 0.74 0.51
## X4 0.59 0.36 0.48 1.00 0.67 0.67 0.61 0.54 0.60 0.73 0.80 0.80 0.62 0.55 0.34
## X5 0.78 0.35 0.54 0.67 1.00 0.77 0.73 0.67 0.68 0.88 0.87 0.80 0.51 0.54 0.32
## X6 0.77 0.35 0.54 0.67 0.77 1.00 0.85 0.73 0.83 0.82 0.81 0.70 0.44 0.44 0.19
## X7 0.72 0.29 0.49 0.61 0.73 0.85 1.00 0.71 0.78 0.77 0.77 0.68 0.41 0.43 0.19
## X8 0.64 0.45 0.62 0.54 0.67 0.73 0.71 1.00 0.72 0.68 0.65 0.61 0.46 0.58 0.43
## X9 0.67 0.38 0.51 0.60 0.68 0.83 0.78 0.72 1.00 0.69 0.71 0.63 0.43 0.40 0.17
## X10 0.80 0.31 0.50 0.73 0.88 0.82 0.77 0.68 0.69 1.00 0.92 0.83 0.52 0.54 0.32
## X11 0.73 0.34 0.50 0.80 0.87 0.81 0.77 0.65 0.71 0.92 1.00 0.89 0.63 0.58 0.35
## X12 0.66 0.45 0.58 0.80 0.80 0.70 0.68 0.61 0.63 0.83 0.89 1.00 0.76 0.69 0.41
## X13 0.35 0.61 0.61 0.62 0.51 0.44 0.41 0.46 0.43 0.52 0.63 0.76 1.00 0.81 0.58
## X14 0.38 0.58 0.74 0.55 0.54 0.44 0.43 0.58 0.40 0.54 0.58 0.69 0.81 1.00 0.82
## X15 0.13 0.42 0.51 0.34 0.32 0.19 0.19 0.43 0.17 0.32 0.35 0.41 0.58 0.82 1.00
## X16 0.71 0.34 0.51 0.74 0.81 0.80 0.77 0.69 0.69 0.89 0.91 0.81 0.57 0.57 0.41
## X17 0.75 0.33 0.51 0.72 0.83 0.86 0.82 0.72 0.74 0.89 0.89 0.79 0.50 0.52 0.34
## X18 0.53 0.47 0.63 0.56 0.62 0.60 0.60 0.74 0.56 0.64 0.62 0.66 0.60 0.74 0.65
## X19 0.52 0.41 0.61 0.55 0.61 0.58 0.59 0.68 0.54 0.63 0.61 0.63 0.52 0.69 0.63
## X20 0.59 0.35 0.56 0.57 0.63 0.65 0.64 0.63 0.65 0.67 0.67 0.66 0.54 0.60 0.44
## X21 0.77 0.29 0.52 0.68 0.77 0.85 0.86 0.73 0.76 0.83 0.83 0.74 0.45 0.48 0.24
## X22 0.10 0.23 0.27 0.32 0.20 0.21 0.22 0.17 0.26 0.18 0.26 0.37 0.42 0.21 -0.04
## X23 0.76 0.42 0.52 0.57 0.65 0.75 0.68 0.59 0.68 0.68 0.64 0.57 0.36 0.38 0.13
## X16 X17 X18 X19 X20 X21 X22 X23
## X1 0.71 0.75 0.53 0.52 0.59 0.77 0.10 0.76
## X2 0.34 0.33 0.47 0.41 0.35 0.29 0.23 0.42
## X3 0.51 0.51 0.63 0.61 0.56 0.52 0.27 0.52
## X4 0.74 0.72 0.56 0.55 0.57 0.68 0.32 0.57
## X5 0.81 0.83 0.62 0.61 0.63 0.77 0.20 0.65
## X6 0.80 0.86 0.60 0.58 0.65 0.85 0.21 0.75
## X7 0.77 0.82 0.60 0.59 0.64 0.86 0.22 0.68
## X8 0.69 0.72 0.74 0.68 0.63 0.73 0.17 0.59
## X9 0.69 0.74 0.56 0.54 0.65 0.76 0.26 0.68
## X10 0.89 0.89 0.64 0.63 0.67 0.83 0.18 0.68
## X11 0.91 0.89 0.62 0.61 0.67 0.83 0.26 0.64
## X12 0.81 0.79 0.66 0.63 0.66 0.74 0.37 0.57
## X13 0.57 0.50 0.60 0.52 0.54 0.45 0.42 0.36
## X14 0.57 0.52 0.74 0.69 0.60 0.48 0.21 0.38
## X15 0.41 0.34 0.65 0.63 0.44 0.24 -0.04 0.13
## X16 1.00 0.95 0.65 0.65 0.68 0.85 0.19 0.61
## X17 0.95 1.00 0.67 0.68 0.71 0.90 0.17 0.67
## X18 0.65 0.67 1.00 0.80 0.75 0.66 0.15 0.55
## X19 0.65 0.68 0.80 1.00 0.78 0.66 0.11 0.47
## X20 0.68 0.71 0.75 0.78 1.00 0.75 0.16 0.55
## X21 0.85 0.90 0.66 0.66 0.75 1.00 0.21 0.70
## X22 0.19 0.17 0.15 0.11 0.16 0.21 1.00 0.11
## X23 0.61 0.67 0.55 0.47 0.55 0.70 0.11 1.00
VISUALISASI KORELASI
library(corrplot)
## corrplot 0.95 loaded
corrplot(cor_X, method = "color", type = "lower", tl.col = "black", tl.cex = 0.7)
MENCARI PASANGAN X DENGAN KORELASI TINGGI
cor_pairs <- which(abs(cor_X) >= 0.80 & upper.tri(cor_X), arr.ind = TRUE)
hasil_korelasi <- data.frame(
Variabel_1 = rownames(cor_X)[cor_pairs[, 1]],
Variabel_2 = colnames(cor_X)[cor_pairs[, 2]],
Korelasi = cor_X[cor_pairs]
)
hasil_korelasi
## Variabel_1 Variabel_2 Korelasi
## 1 X6 X7 0.8499839
## 2 X6 X9 0.8264952
## 3 X1 X10 0.8011856
## 4 X5 X10 0.8821236
## 5 X6 X10 0.8195398
## 6 X4 X11 0.8048939
## 7 X5 X11 0.8748057
## 8 X6 X11 0.8061236
## 9 X10 X11 0.9249950
## 10 X4 X12 0.8020188
## 11 X10 X12 0.8253376
## 12 X11 X12 0.8859260
## 13 X13 X14 0.8111445
## 14 X14 X15 0.8216325
## 15 X5 X16 0.8106560
## 16 X6 X16 0.8039710
## 17 X10 X16 0.8938637
## 18 X11 X16 0.9083007
## 19 X12 X16 0.8134074
## 20 X5 X17 0.8253807
## 21 X6 X17 0.8587246
## 22 X7 X17 0.8155432
## 23 X10 X17 0.8899042
## 24 X11 X17 0.8914032
## 25 X16 X17 0.9466780
## 26 X6 X21 0.8482830
## 27 X7 X21 0.8582021
## 28 X10 X21 0.8328684
## 29 X11 X21 0.8272033
## 30 X16 X21 0.8494313
## 31 X17 X21 0.8997243
REGRESI LINEAR AWAL
model_awal <- lm(Y ~ X1 + X2 + X3 + X4 + X5 + X6 + X7 + X8 + X9 + X10 + X11 + X12 + X13 + X14 + X15 + X16 + X17 + X18 + X19 + X20 + X21 + X22 + X23,
data = train_data)
summary(model_awal)
##
## Call:
## lm(formula = Y ~ X1 + X2 + X3 + X4 + X5 + X6 + X7 + X8 + X9 +
## X10 + X11 + X12 + X13 + X14 + X15 + X16 + X17 + X18 + X19 +
## X20 + X21 + X22 + X23, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.6861 -1.1858 0.0108 1.1398 9.1100
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.193e+02 2.765e+00 -43.156 < 2e-16 ***
## X1 -2.721e-02 7.128e-02 -0.382 0.702845
## X2 3.141e-02 7.399e-02 0.425 0.671433
## X3 1.282e-02 9.941e-02 0.129 0.897470
## X4 2.181e-01 7.688e-02 2.838 0.004789 **
## X5 1.006e-01 9.152e-02 1.100 0.272152
## X6 2.786e-01 2.031e-01 1.372 0.170879
## X7 1.619e-01 2.439e-01 0.664 0.507366
## X8 4.355e-01 1.486e-01 2.930 0.003596 **
## X9 5.009e-02 1.680e-01 0.298 0.765740
## X10 7.107e-02 3.387e-02 2.098 0.036555 *
## X11 1.591e-01 4.121e-02 3.861 0.000133 ***
## X12 3.297e-01 2.772e-02 11.897 < 2e-16 ***
## X13 2.445e-02 2.723e-02 0.898 0.369826
## X14 2.048e-01 5.088e-02 4.026 6.86e-05 ***
## X15 3.478e-01 5.769e-02 6.028 3.93e-09 ***
## X16 8.471e-02 9.163e-02 0.924 0.355814
## X17 3.427e-01 1.513e-01 2.265 0.024052 *
## X18 1.695e-01 8.759e-02 1.935 0.053757 .
## X19 3.331e-01 7.552e-02 4.411 1.34e-05 ***
## X20 8.653e-03 1.103e-01 0.078 0.937490
## X21 -9.753e-02 2.191e-01 -0.445 0.656457
## X22 -4.889e-02 1.361e-02 -3.592 0.000371 ***
## X23 2.950e-01 2.020e-02 14.604 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.04 on 381 degrees of freedom
## Multiple R-squared: 0.9778, Adjusted R-squared: 0.9764
## F-statistic: 728 on 23 and 381 DF, p-value: < 2.2e-16
UJI MULTIKOLINEARITAS DENGAN VIF
library(car)
## Loading required package: carData
vif_result <- vif(model_awal)
vif_result
## X1 X2 X3 X4 X5 X6 X7 X8
## 4.770068 2.535674 3.980244 3.497700 6.136984 7.591746 5.203242 3.913427
## X9 X10 X11 X12 X13 X14 X15 X16
## 4.321714 11.644877 16.189237 8.992152 5.984285 10.497777 6.257007 14.727049
## X17 X18 X19 X20 X21 X22 X23
## 17.340366 4.914002 4.605499 4.181067 8.970191 1.641241 3.428665
BEST-SUBSET SELECTION
library(leaps)
best_subset <- regsubsets(Y ~ X1 + X2 + X3 + X4 + X5 + X6 + X7 + X8 + X9 + X10 + X11 + X12 + X13 + X14 + X15 + X16 + X17 + X18 + X19 + X20 + X21 + X22 + X23,
data = train_data,
method = "exhaustive",
nvmax = 23)
summary_best <- summary(best_subset)
summary_best
## Subset selection object
## Call: regsubsets.formula(Y ~ X1 + X2 + X3 + X4 + X5 + X6 + X7 + X8 +
## X9 + X10 + X11 + X12 + X13 + X14 + X15 + X16 + X17 + X18 +
## X19 + X20 + X21 + X22 + X23, data = train_data, method = "exhaustive",
## nvmax = 23)
## 23 Variables (and intercept)
## Forced in Forced out
## X1 FALSE FALSE
## X2 FALSE FALSE
## X3 FALSE FALSE
## X4 FALSE FALSE
## X5 FALSE FALSE
## X6 FALSE FALSE
## X7 FALSE FALSE
## X8 FALSE FALSE
## X9 FALSE FALSE
## X10 FALSE FALSE
## X11 FALSE FALSE
## X12 FALSE FALSE
## X13 FALSE FALSE
## X14 FALSE FALSE
## X15 FALSE FALSE
## X16 FALSE FALSE
## X17 FALSE FALSE
## X18 FALSE FALSE
## X19 FALSE FALSE
## X20 FALSE FALSE
## X21 FALSE FALSE
## X22 FALSE FALSE
## X23 FALSE FALSE
## 1 subsets of each size up to 23
## Selection Algorithm: exhaustive
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17
## 1 ( 1 ) " " " " " " " " " " " " " " " " " " " " " " "*" " " " " " " " " " "
## 2 ( 1 ) " " " " " " " " " " " " " " " " " " " " "*" " " " " " " " " " " " "
## 3 ( 1 ) " " " " " " " " " " " " " " " " " " " " " " "*" " " " " "*" " " " "
## 4 ( 1 ) " " " " " " " " " " " " " " " " " " " " " " "*" " " " " "*" " " "*"
## 5 ( 1 ) " " " " " " " " " " " " " " " " " " " " "*" "*" " " " " "*" " " " "
## 6 ( 1 ) " " " " " " " " " " " " " " "*" " " " " "*" "*" " " " " "*" " " " "
## 7 ( 1 ) " " " " " " " " " " " " " " " " " " " " "*" "*" " " "*" "*" " " "*"
## 8 ( 1 ) " " " " " " " " " " " " " " "*" " " " " "*" "*" " " "*" "*" " " "*"
## 9 ( 1 ) " " " " " " " " " " " " " " "*" " " " " "*" "*" " " "*" "*" " " "*"
## 10 ( 1 ) " " " " " " "*" " " " " " " "*" " " " " "*" "*" " " "*" "*" " " "*"
## 11 ( 1 ) " " " " " " "*" " " " " " " "*" " " "*" "*" "*" " " "*" "*" " " "*"
## 12 ( 1 ) " " " " " " "*" " " "*" " " "*" " " "*" "*" "*" " " "*" "*" " " "*"
## 13 ( 1 ) " " " " " " "*" " " "*" " " "*" " " "*" "*" "*" " " "*" "*" " " "*"
## 14 ( 1 ) " " " " " " "*" " " "*" " " "*" " " "*" "*" "*" "*" "*" "*" " " "*"
## 15 ( 1 ) " " " " " " "*" "*" "*" " " "*" " " "*" "*" "*" "*" "*" "*" " " "*"
## 16 ( 1 ) " " " " " " "*" "*" "*" " " "*" " " "*" "*" "*" "*" "*" "*" "*" "*"
## 17 ( 1 ) " " " " " " "*" "*" "*" "*" "*" " " "*" "*" "*" "*" "*" "*" "*" "*"
## 18 ( 1 ) " " "*" " " "*" "*" "*" "*" "*" " " "*" "*" "*" "*" "*" "*" "*" "*"
## 19 ( 1 ) " " "*" " " "*" "*" "*" "*" "*" " " "*" "*" "*" "*" "*" "*" "*" "*"
## 20 ( 1 ) "*" "*" " " "*" "*" "*" "*" "*" " " "*" "*" "*" "*" "*" "*" "*" "*"
## 21 ( 1 ) "*" "*" " " "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*"
## 22 ( 1 ) "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*"
## 23 ( 1 ) "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*" "*"
## X18 X19 X20 X21 X22 X23
## 1 ( 1 ) " " " " " " " " " " " "
## 2 ( 1 ) "*" " " " " " " " " " "
## 3 ( 1 ) " " " " " " " " " " "*"
## 4 ( 1 ) " " " " " " " " " " "*"
## 5 ( 1 ) " " "*" " " " " " " "*"
## 6 ( 1 ) " " "*" " " " " " " "*"
## 7 ( 1 ) " " "*" " " " " " " "*"
## 8 ( 1 ) " " "*" " " " " " " "*"
## 9 ( 1 ) " " "*" " " " " "*" "*"
## 10 ( 1 ) " " "*" " " " " "*" "*"
## 11 ( 1 ) " " "*" " " " " "*" "*"
## 12 ( 1 ) " " "*" " " " " "*" "*"
## 13 ( 1 ) "*" "*" " " " " "*" "*"
## 14 ( 1 ) "*" "*" " " " " "*" "*"
## 15 ( 1 ) "*" "*" " " " " "*" "*"
## 16 ( 1 ) "*" "*" " " " " "*" "*"
## 17 ( 1 ) "*" "*" " " " " "*" "*"
## 18 ( 1 ) "*" "*" " " " " "*" "*"
## 19 ( 1 ) "*" "*" " " "*" "*" "*"
## 20 ( 1 ) "*" "*" " " "*" "*" "*"
## 21 ( 1 ) "*" "*" " " "*" "*" "*"
## 22 ( 1 ) "*" "*" " " "*" "*" "*"
## 23 ( 1 ) "*" "*" "*" "*" "*" "*"
id_adjr2 <- which.max(summary_best$adjr2)
id_cp <- which.min(summary_best$cp)
id_bic <- which.min(summary_best$bic)
id_adjr2
## [1] 15
id_cp
## [1] 13
id_bic
## [1] 11
summary_best$adjr2[id_adjr2]
## [1] 0.9767766
summary_best$cp[id_cp]
## [1] 8.339215
summary_best$bic[id_bic]
## [1] -1456.492
coef(best_subset, id = id_adjr2)
## (Intercept) X4 X5 X6 X8
## -119.97616018 0.21113001 0.08926929 0.32988356 0.47086009
## X10 X11 X12 X13 X14
## 0.07060256 0.16848840 0.32955526 0.03215492 0.20291202
## X15 X17 X18 X19 X22
## 0.36250741 0.41751009 0.15636152 0.33284265 -0.04661985
## X23
## 0.29501045
coef(best_subset, id = id_cp)
## (Intercept) X4 X6 X8 X10
## -120.07250819 0.20380697 0.35448301 0.46343499 0.07159654
## X11 X12 X14 X15 X17
## 0.18481502 0.34410646 0.22736443 0.36639819 0.40369723
## X18 X19 X22 X23
## 0.16275700 0.32461622 -0.04233033 0.29649349
coef(best_subset, id = id_bic)
## (Intercept) X4 X8 X10 X11
## -121.38765539 0.21041238 0.60427967 0.07572829 0.18574862
## X12 X14 X15 X17 X19
## 0.34195897 0.24036443 0.36703876 0.49840601 0.37130479
## X22 X23
## -0.03949161 0.31568819
MODEL BEST-SUBSET BERDASARKAN BIC
model_best <- lm(Y ~ X4 + X8 + X10 + X11 + X12 + X14 + X15 + X17 + X19 + X22 + X23,data = train_data)
summary(model_best)
##
## Call:
## lm(formula = Y ~ X4 + X8 + X10 + X11 + X12 + X14 + X15 + X17 +
## X19 + X22 + X23, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.2419 -1.4067 0.0441 1.1311 8.8919
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -121.38766 2.54200 -47.753 < 2e-16 ***
## X4 0.21041 0.07521 2.798 0.00540 **
## X8 0.60428 0.12438 4.858 1.71e-06 ***
## X10 0.07573 0.02983 2.538 0.01152 *
## X11 0.18575 0.03706 5.012 8.17e-07 ***
## X12 0.34196 0.02526 13.538 < 2e-16 ***
## X14 0.24036 0.04036 5.955 5.77e-09 ***
## X15 0.36704 0.05081 7.223 2.65e-12 ***
## X17 0.49841 0.09791 5.090 5.55e-07 ***
## X19 0.37130 0.06216 5.974 5.19e-09 ***
## X22 -0.03949 0.01266 -3.119 0.00195 **
## X23 0.31569 0.01661 19.010 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.041 on 393 degrees of freedom
## Multiple R-squared: 0.977, Adjusted R-squared: 0.9764
## F-statistic: 1521 on 11 and 393 DF, p-value: < 2.2e-16
RIDGE REGRESSION
library(glmnetUtils)
set.seed(7)
model_ridge <- cv.glmnet(
Y ~ .,
data = train_data,
alpha = 0,
type.measure = "mse",
family = "gaussian",
nfolds = 5
)
lambda_ridge <- model_ridge$lambda.min
cat("Lambda terbaik Ridge:", lambda_ridge, "\n")
## Lambda terbaik Ridge: 1.197007
plot(model_ridge)
coef_ridge <- coef(model_ridge, s = "lambda.min")
coef_ridge
## 24 x 1 sparse Matrix of class "dgCMatrix"
## lambda.min
## (Intercept) -117.04325200
## X1 0.06669775
## X2 0.07276288
## X3 0.05740606
## X4 0.34132790
## X5 0.21652588
## X6 0.26159567
## X7 0.26856870
## X8 0.34965781
## X9 0.11934438
## X10 0.09223510
## X11 0.12996283
## X12 0.21846760
## X13 0.07302086
## X14 0.20337302
## X15 0.28181412
## X16 0.15365483
## X17 0.26797391
## X18 0.25846306
## X19 0.29916655
## X20 0.05179781
## X21 0.09462680
## X22 -0.04466173
## X23 0.22482871
LASSO REGRESSION
set.seed(7)
model_lasso <- cv.glmnet(
Y ~ .,
data = train_data,
alpha = 1,
type.measure = "mse",
family = "gaussian",
nfolds = 5
)
lambda_lasso <- model_lasso$lambda.min
cat("Lambda terbaik LASSO:", lambda_lasso, "\n")
## Lambda terbaik LASSO: 0.04106296
plot(model_lasso)
coef_lasso <- coef(model_lasso, s = "lambda.min")
coef_lasso
## 24 x 1 sparse Matrix of class "dgCMatrix"
## lambda.min
## (Intercept) -118.83682586
## X1 .
## X2 0.02557922
## X3 .
## X4 0.20528394
## X5 0.08972769
## X6 0.27845262
## X7 0.07624486
## X8 0.41984391
## X9 0.03264934
## X10 0.06564886
## X11 0.16428337
## X12 0.32665534
## X13 0.01775265
## X14 0.21481679
## X15 0.34666285
## X16 0.08574257
## X17 0.33160216
## X18 0.17387073
## X19 0.33189513
## X20 .
## X21 .
## X22 -0.03967619
## X23 0.29220330
ELASTIC NET
set.seed(7)
alpha_grid <- seq(from = 0.1, to = 0.9, by = 0.1)
cv_enet <- lapply(alpha_grid,
function(i) {
cv.glmnet(
Y ~ .,
data = train_data,
alpha = i,
type.measure = "mse",
family = "gaussian",
nfolds = 5
)
})
par(mfrow = c(3,3))
for(i in 1:length(alpha_grid)){
plot(cv_enet[[i]],
main = paste("alpha =", alpha_grid[i]))
}
par(mfrow = c(1,1))
cv_errors <- sapply(cv_enet,
function(model) min(model$cvm))
alpha_result <- data.frame(
alpha = alpha_grid,
CV_Error = cv_errors)
alpha_result
## alpha CV_Error
## 1 0.1 4.393482
## 2 0.2 4.472229
## 3 0.3 4.368814
## 4 0.4 4.663017
## 5 0.5 4.534121
## 6 0.6 4.419727
## 7 0.7 4.514367
## 8 0.8 4.352008
## 9 0.9 4.454233
id_alpha <- which.min(cv_errors)
alpha_best <- alpha_grid[id_alpha]
cat("Alpha terbaik Elastic Net:", alpha_best, "\n")
## Alpha terbaik Elastic Net: 0.8
model_enet <- cv_enet[[id_alpha]]
lambda_enet <- model_enet$lambda.min
cat("Lambda terbaik Elastic Net:",lambda_enet,"\n")
## Lambda terbaik Elastic Net: 0.0467688
coef_enet <- coef(model_enet, s = "lambda.min")
coef_enet
## 24 x 1 sparse Matrix of class "dgCMatrix"
## lambda.min
## (Intercept) -118.88953757
## X1 .
## X2 0.02628044
## X3 .
## X4 0.20809603
## X5 0.09234897
## X6 0.27540456
## X7 0.08159181
## X8 0.41850720
## X9 0.03752258
## X10 0.06689765
## X11 0.16334211
## X12 0.32466323
## X13 0.01959682
## X14 0.21459908
## X15 0.34524773
## X16 0.08699430
## X17 0.32953152
## X18 0.17495924
## X19 0.33236843
## X20 .
## X21 .
## X22 -0.04046033
## X23 0.29150005
EVALUASI BEST-SUBSET
pred_best <- predict(model_best, newdata = test_data)
mse_best <- mean((y_test - pred_best)^2)
r2_best <- 1 - sum((y_test - pred_best)^2) /sum((y_test - mean(y_test))^2)
pred_best_train <- predict(model_best, newdata = train_data)
mse_best_train <- mean((y_train - pred_best_train)^2)
mae_best_train <- mean(abs(y_train - pred_best_train))
mae_best_test <- mean(abs(y_test - pred_best))
r2_best_train <- 1 - sum((y_train - pred_best_train)^2) /
sum((y_train - mean(y_train))^2)
EVALUASI RIDGE
pred_ridge_train <- predict(model_ridge, newdata = train_data, na.action = na.pass)
rss_ridge <- sum((train_data$Y - pred_ridge_train)^2)
tss_ridge <- sum((train_data$Y - mean(train_data$Y))^2)
r2_ridge_train <- 1 -(rss_ridge / tss_ridge)
pred_ridge_test <- predict(model_ridge, newdata = test_data, na.action = na.pass)
mse_ridge <- mean((y_test - pred_ridge_test)^2)
r2_ridge <- 1 -sum((y_test - pred_ridge_test)^2) / sum((y_test - mean(y_test))^2)
mse_ridge_train <- mean((y_train - pred_ridge_train)^2)
mae_ridge_train <- mean(abs(y_train - pred_ridge_train))
mae_ridge_test <- mean(abs(y_test - pred_ridge_test))
EVALUASI LASSO
pred_lasso_train <- predict(model_lasso, newdata = train_data, na.action = na.pass)
rss_lasso <- sum((train_data$Y - pred_lasso_train)^2)
tss_lasso <- sum((train_data$Y - mean(train_data$Y))^2)
r2_lasso_train <- 1 - (rss_lasso / tss_lasso)
pred_lasso_test <- predict(model_lasso, newdata = test_data, na.action = na.pass)
mse_lasso <- mean((y_test - pred_lasso_test)^2)
r2_lasso <- 1 - sum((y_test - pred_lasso_test)^2) / sum((y_test - mean(y_test))^2)
mse_lasso_train <- mean((y_train - pred_lasso_train)^2)
mae_lasso_train <- mean(abs(y_train - pred_lasso_train))
mae_lasso_test <- mean(abs(y_test - pred_lasso_test))
EVALUASI ELASTIC NET
pred_enet_train <- predict(model_enet, newdata = train_data, na.action = na.pass)
rss_enet <- sum((train_data$Y - pred_enet_train)^2)
tss_enet <- sum((train_data$Y - mean(train_data$Y))^2)
r2_enet_train <- 1 - (rss_enet / tss_enet)
pred_enet_test <- predict(model_enet, newdata = test_data, na.action = na.pass)
mse_enet <- mean((y_test - pred_enet_test)^2)
r2_enet <- 1 - sum((y_test - pred_enet_test)^2) / sum((y_test - mean(y_test))^2)
mse_enet_train <- mean((y_train - pred_enet_train)^2)
mae_enet_train <- mean(abs(y_train - pred_enet_train))
mae_enet_test <- mean(abs(y_test - pred_enet_test))
PERBANDINGAN SEMUA MODEL
hasil_model <- data.frame(
Model = c("Best-Subset (BIC)", "Ridge", "LASSO", "Elastic Net"),
Jumlah_Variabel = c(11, 23, 19, 19),
MSE_Training = c(mse_best_train, mse_ridge_train, mse_lasso_train, mse_enet_train),
MAE_Training = c(mae_best_train, mae_ridge_train, mae_lasso_train, mae_enet_train),
R2_Training = c(r2_best_train, r2_ridge_train, r2_lasso_train, r2_enet_train),
MSE_Testing = c(mse_best, mse_ridge, mse_lasso, mse_enet),
MAE_Testing = c(mae_best_test, mae_ridge_test, mae_lasso_test, mae_enet_test),
R2_Testing = c(r2_best, r2_ridge, r2_lasso, r2_enet)
)
hasil_model
## Model Jumlah_Variabel MSE_Training MAE_Training R2_Training
## 1 Best-Subset (BIC) 11 4.040315 1.554568 0.9770438
## 2 Ridge 23 4.708593 1.624273 0.9732468
## 3 LASSO 19 4.359813 1.565700 0.9752285
## 4 Elastic Net 19 4.444336 1.584725 0.9747483
## MSE_Testing MAE_Testing R2_Testing
## 1 6.263749 1.954801 0.9660736
## 2 7.144075 2.132281 0.9613055
## 3 6.336633 1.986016 0.9656789
## 4 6.391132 1.998235 0.9653837
PERINGKAT MODEL BERDASARKAN MSE
hasil_model_mse <- hasil_model[
order(hasil_model$MSE_Testing),]
hasil_model_mse
## Model Jumlah_Variabel MSE_Training MAE_Training R2_Training
## 1 Best-Subset (BIC) 11 4.040315 1.554568 0.9770438
## 3 LASSO 19 4.359813 1.565700 0.9752285
## 4 Elastic Net 19 4.444336 1.584725 0.9747483
## 2 Ridge 23 4.708593 1.624273 0.9732468
## MSE_Testing MAE_Testing R2_Testing
## 1 6.263749 1.954801 0.9660736
## 3 6.336633 1.986016 0.9656789
## 4 6.391132 1.998235 0.9653837
## 2 7.144075 2.132281 0.9613055
model_terbaik <- hasil_model_mse[1, ]
model_terbaik
## Model Jumlah_Variabel MSE_Training MAE_Training R2_Training
## 1 Best-Subset (BIC) 11 4.040315 1.554568 0.9770438
## MSE_Testing MAE_Testing R2_Testing
## 1 6.263749 1.954801 0.9660736