Metode Seleksi Peubah untuk High-dimensional Data
G1501202053 Ikhlasul Amalia Rahmi
10/6/2020
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.0.5## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.6 v dplyr 1.0.8
## v tidyr 1.2.0 v stringr 1.4.0
## v readr 2.1.2 v forcats 0.5.1## Warning: package 'ggplot2' was built under R version 4.0.5## Warning: package 'tibble' was built under R version 4.0.5## Warning: package 'tidyr' was built under R version 4.0.5## Warning: package 'readr' was built under R version 4.0.5## Warning: package 'dplyr' was built under R version 4.0.5## Warning: package 'forcats' was built under R version 4.0.4## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(glmnetUtils)## Warning: package 'glmnetUtils' was built under R version 4.0.4library(leaps)
#install.packages("varbvs")
library(varbvs)Data
Data yang digunakan pada praktikum kali ini adalah data Leukemia. Berikut adalah informasi singkat mengenai data
Expression levels recorded for 3,571 genes in 72 patients with leukemia (Golub et al, 1999). The binary outcome encodes the disease subtype: acute lymphobastic leukemia (ALL) or acute myeloid leukemia (AML).
data ini bisa diperoleh dalam package varbvs
Import Data ke R
data("leukemia",package = "varbvs")
leukemia = data.frame(y=leukemia$y,leukemia$x)Metode Forward Selection
Metode Forward selection ini dijalankan menggunakan fungsi regsubsets dari package leaps. Argumen nvmax disini adalah untuk menentukan banyaknya peubah/subset yang dimasukan ke model. Karena data leukemia memiliki 72 observasi, maka peubah yang dimasukan ke model tidak bisa lebih dari 71 peubah.
model_forward <- regsubsets(y~.,data=leukemia,method = "forward",nvmax = 71)## Warning in leaps.setup(x, y, wt = wt, nbest = nbest, nvmax = nvmax, force.in =
## force.in, : 3500 linear dependencies found#summary(model_forward)Kemudian, kita akan melihat subset mana yang terbaik. Penentuan ini dilakukan dengan menggunakan nilai BIC. Nilai BIC terkecil yang dianggap sebagai subset terbaik.
best_forward <- data.frame(subset=seq_along(summary(model_forward)$bic),
BIC = summary(model_forward)$bic)Selanjutnya dengan menggunakan plot dibawah ini, kita bisa melihat bahwa nilai yang paling kecil adalah pada subset paling kanan atau dengan kata lain subset ke 70 atau 71.
ggplot(best_forward,aes(subset,BIC))+
geom_line(size=1)+
geom_point(color="red",size=2)+
theme_bw()
Jika diperhatikan pada output dibawah ini, subset 71 nilai BICnya -Inf sehingga kita pilih yang subset 70.
best_forward[50:71,]## subset BIC
## 50 50 -984.314
## 51 51 -1025.111
## 52 52 -1066.418
## 53 53 -1102.631
## 54 54 -1156.951
## 55 55 -1210.036
## 56 56 -1277.306
## 57 57 -1339.210
## 58 58 -1397.888
## 59 59 -1476.068
## 60 60 -1573.544
## 61 61 -1653.842
## 62 62 -1792.192
## 63 63 -1915.087
## 64 64 -2000.464
## 65 65 -2135.452
## 66 66 -2379.000
## 67 67 -2585.619
## 68 68 -2925.810
## 69 69 -3431.180
## 70 70 -5065.300
## 71 71 -InfSintaks dibawah ini digunakan untuk mengekstract nilai koefisien dari subset 70.
coef_forward = coef(model_forward,70)
length(coef_forward)## [1] 71Jika kita tampilkan, ada sebanyak 70 peubah yang terpilih dengan 1 intercept.
coef_forward ## (Intercept) X183 X218 X235 X287
## 3.472222e-01 -7.404151e-02 -6.090950e-08 7.576329e-03 -2.753443e-03
## X296 X298 X341 X348 X351
## -4.656128e-02 -2.685595e-04 -2.859934e-08 -2.095386e-04 -3.125436e-06
## X418 X446 X478 X598 X604
## 7.108548e-03 7.806248e-05 -1.666704e-04 -5.760329e-06 -4.508718e-04
## X625 X682 X691 X697 X710
## -1.916912e-05 -1.113632e-06 -2.082914e-02 -1.107586e-03 5.790618e-03
## X716 X784 X801 X849 X1053
## 7.966634e-03 2.169628e-02 -5.422339e-02 4.383456e-03 -3.178720e-02
## X1123 X1182 X1192 X1204 X1219
## 3.787290e-02 1.141740e-01 -1.234209e-02 1.736643e-11 -1.698153e-01
## X1267 X1335 X1493 X1551 X1560
## -1.877156e-02 1.451522e-02 2.187258e-04 -2.049213e-03 -5.764137e-10
## X1667 X1713 X1858 X1889 X1909
## -1.533883e-03 5.013101e-04 -1.541831e-05 -4.734743e-06 3.503166e-02
## X1946 X2089 X2102 X2107 X2155
## 7.517935e-02 6.261964e-04 3.353616e-02 1.917570e-02 1.403177e-04
## X2234 X2315 X2363 X2427 X2491
## -1.787946e-04 4.128251e-02 -3.593878e-03 3.409575e-02 2.144905e-02
## X2523 X2558 X2579 X2715 X2751
## -2.823069e-03 -4.467083e-02 6.571662e-05 4.532983e-05 -5.201828e-07
## X2761 X2811 X2861 X2888 X2915
## -1.124179e-03 1.097293e-02 -2.455356e-07 7.308873e-02 -1.769428e-03
## X2954 X3038 X3311 X3478 X3512
## 8.256019e-04 1.414855e-01 8.937411e-09 4.371139e-02 -2.100190e-03
## X3522 X3529 X3530 X3539 X3545
## 1.596075e-02 1.728537e-05 -2.879700e-02 2.584945e-02 -1.363613e-03
## X3557
## -4.631553e-02Metode LASSO Metode kedua yang kita coba adalah metode LASSO. Metode ini bisa dijalankan menggunakan package glmnet. Package glmnetUtils merupakan package tambahan dari glmnet yang memungkinkan syntax glmnet bisa dinput menggunakan object data.frame.
Fungsi cv.glmnet digunakan untuk menjalankan metode LASSO, asalkan nilai argumen alpha=1. Kemudian, dengan fungsi ini juga dimungkinkan memilih parameter penalty lambda terbaik dengan menggunakan cross-validation (validasi-silang) yang didasarkan pada kriteria tertentu, contohnya saja kriteria “deviance” dan “auc”.Argumen nfolds digunakan untuk menentukan jumlah folds/lipatan pada cross-validation. Penjelasan cross-validation lebih lengkap bisa dilihat pada video pada link berikut https://www.youtube.com/watch?v=QRlSktU5Cn0&feature=youtu.be.
model_lasso_dev <- cv.glmnet(y~.,data=leukemia,alpha = 1,
type.measure="deviance",
family="binomial",
nfolds=5)
model_lasso_auc <- cv.glmnet(y~.,data=leukemia,alpha = 1,
type.measure="auc",
family="binomial",
nfolds=5)Setelah sintaks diatas dijalankan, selanjutnya dimungkinkan untuk membuat plot nilai lambda dalam bentuk log dengan nilai kriteria yang dipilih.
plot(model_lasso_dev)
plot(model_lasso_auc)
Informasi penting yang bisa dilihat pada plot diatas adalah banyaknya peubah terpilih yang ditulis diatas plot. Kemudian ada garis vertikal putus-putus yang menandakan nilai lambda optimum berdasarkan kriteria yang dipilih. Jika menggunakan AUC maka nilai lambda optimum dipilih berdasarkan nilai AUC terbesar. Sedangkan menggunakan deviance nilai lambda optimum dipilih berdasarkan nilai deviance terkecil. Selain itu, kriteria lambda optimum juga dipilih berdasarkan lebar selang terkecil dari garis pada setiap titik. Sehingga garis vertikal yang satunya menandakan hal tersebut.
Nilai koefisien dari variable terpilih bisa dikeluarkan dengan sintaks dibawah ini. Argumen s pada fungsi coef bisa diisi dengan “lambda.min”(peubah yang terpilih berdasarkan nilai lambda optimal) dan “lambda.1se”(peubah yang terpilih berdasarkan nilai lambda yang memiliki selang terkecil).
coef_auc_min <- coef(model_lasso_auc,s = "lambda.min")
broom::tidy(coef_auc_min)## Warning: 'tidy.dgCMatrix' is deprecated.
## See help("Deprecated")## Warning: 'tidy.dgTMatrix' is deprecated.
## See help("Deprecated")## row column value
## 1 (Intercept) s1 -0.87278635
## 2 X456 s1 -0.07267079
## 3 X626 s1 -0.18650586
## 4 X672 s1 -0.03360700
## 5 X956 s1 0.27034368
## 6 X979 s1 0.53539113
## 7 X1182 s1 0.06864860
## 8 X1219 s1 -0.05008682
## 9 X1652 s1 0.29690162
## 10 X2481 s1 0.27781300
## 11 X3441 s1 -0.08379518coef_dev_min <- coef(model_lasso_dev,s = "lambda.min")
broom::tidy(coef_dev_min)## Warning: 'tidy.dgCMatrix' is deprecated.
## See help("Deprecated")
## Warning: 'tidy.dgTMatrix' is deprecated.
## See help("Deprecated")## row column value
## 1 (Intercept) s1 -2.105351950
## 2 X158 s1 0.052466245
## 3 X219 s1 -0.132573105
## 4 X456 s1 -0.614156024
## 5 X657 s1 -0.161344071
## 6 X672 s1 -1.000508499
## 7 X888 s1 0.091913710
## 8 X918 s1 0.088751241
## 9 X956 s1 0.475777266
## 10 X979 s1 1.602684717
## 11 X1219 s1 -0.266342344
## 12 X1652 s1 0.352491511
## 13 X1796 s1 0.013808361
## 14 X1946 s1 0.566741056
## 15 X2230 s1 0.049321276
## 16 X2239 s1 -0.014187057
## 17 X2387 s1 -0.019321462
## 18 X2481 s1 1.034589642
## 19 X2537 s1 0.039528516
## 20 X2727 s1 -0.030640421
## 21 X2888 s1 0.239429232
## 22 X3098 s1 0.404944214
## 23 X3158 s1 0.051519134
## 24 X3292 s1 0.006195577coef_auc_se <- coef(model_lasso_auc,s = "lambda.1se")
broom::tidy(coef_auc_se)## Warning: 'tidy.dgCMatrix' is deprecated.
## See help("Deprecated")
## Warning: 'tidy.dgTMatrix' is deprecated.
## See help("Deprecated")## row column value
## 1 (Intercept) s1 -0.87278635
## 2 X456 s1 -0.07267079
## 3 X626 s1 -0.18650586
## 4 X672 s1 -0.03360700
## 5 X956 s1 0.27034368
## 6 X979 s1 0.53539113
## 7 X1182 s1 0.06864860
## 8 X1219 s1 -0.05008682
## 9 X1652 s1 0.29690162
## 10 X2481 s1 0.27781300
## 11 X3441 s1 -0.08379518coef_dev_se <- coef(model_lasso_dev,s = "lambda.1se")
broom::tidy(coef_dev_se)## Warning: 'tidy.dgCMatrix' is deprecated.
## See help("Deprecated")
## Warning: 'tidy.dgTMatrix' is deprecated.
## See help("Deprecated")## row column value
## 1 (Intercept) s1 -1.584948939
## 2 X158 s1 0.066607502
## 3 X219 s1 -0.008977114
## 4 X456 s1 -0.490422189
## 5 X626 s1 -0.055399972
## 6 X657 s1 -0.064658721
## 7 X672 s1 -0.681095353
## 8 X888 s1 0.005183430
## 9 X956 s1 0.367269069
## 10 X979 s1 1.214699198
## 11 X1182 s1 0.055551534
## 12 X1219 s1 -0.155181109
## 13 X1652 s1 0.337848298
## 14 X1946 s1 0.341003810
## 15 X2481 s1 0.793748461
## 16 X2537 s1 0.030507114
## 17 X2888 s1 0.143575056
## 18 X3098 s1 0.281995908
## 19 X3158 s1 0.044942705Metode Ridge
Metode terakhir yang kita coba adalah metode Ridge. Metode ini pada dasarnya bukan merupakan metode seleksi, namun metode untuk mengatasi multikolinearitas. Metode ini bisa membantu memperoleh seleksi peubah yang lebih baik jika digabungkan dengan metode LASSO. Penggabungan ini melahirkan metode baru yang bernama Elastic-Net yang akan dibahas pada praktikum berikutnya.
model_ridge_auc <- cv.glmnet(y~.,data=leukemia,alpha = 0,
type.measure="auc",
family="binomial",
nfolds=5)
plot(model_ridge_auc)