principal component analysis
Galih Dwika Putra R
2/2/2022
Model dalam Realita
Jika kita melirik kembali pada pembelajaran sebelumnya, kita bisa merasakan ada sesuatu yang janggal, kan? Benar. Kita memilih variabel estimator secara abritrasi, alias terserah kita. Seperti pada credit risk scoring, kita memilih variabel ‘jumlah tanggungan’ dan ‘tenor’, dalam pembuatan model market segmentasi, kita memilih ‘usia’,‘nilaibelanjasetahun’,‘jenis.kelamin’,dan ‘profesi’ begitu saja. Dalam kasus nyata, memilih variabel prediktor/penjelas, bukanlah hal yang mudah. Kita perlu memilih jumlah variabel penjelas yang optimal, melakukan EDA berulang kali, transformasi data, dan sebagainya. Kita ambil contoh credit risk scoring, tidak mungkin kita membuat estimator hanya berdasarkan 2 variabel saja. Umumnya, model risk scoring melibatkan begitu banyak calon variabel prediktor; mulai dari demografi, disposable income, credit history, hingga kepemilikan aset. Belum lagi, kita tidak bisa lupa, bahwa banyaknya jumlah variabel penjelas, tidak menjamin kualitas prediksi model; sebaliknya, itu bisa menjadi bumerang. Dalam praktik, model risk scoring dan juga model machine learning lainnya menggunakan unsupervised learning (seperti k-means) untuk mencari pola dalam data tanpa bantuan atribut target, yang kemudian menggunakan hasilnya sebagai input untuk bagi algoritma supervised learning(seperti C5.0) untuk mencapai tujuannya. Banyaknya calon variabel predictor bagi model risk scoring juga bisa diatasi dengan cara seperti itu; pertama kita gunakan algoritma unsupervising learning untuk mendapatkan pola data dan variabel yang paling signifikan bagi resiko debitur, lalu menggunakan hasilnya untuk input bagi C5.0 untuk menciptkan model prediksi. Salah satu model untuk keperluan mereduksi variabel (atau disebut juga dimension reduction) adalah Principal Component Analysis.
Overview Principal Component Analysis
PCA adalah salah satu metode reduksi dimensi pada machine learning. PCA akan memilih ‘variabel-variabel’ yang mampu menjelaskan sebagian variabilitas pada data. Ide dasar PCA : PCA akan mengurangi dimensi data dengan membentuk variabel baru disebut ‘principal component’ yang berasal dari kombinasi linier variabel-variabel lama. Yang dimaksud linier di sini adalah linier dalam variabel contoh :
PC1 = 0.674X1 + 0.663X2 + 0.3134X3 # Ini linier dalam variabel
PC2 = 0.2313X1^2 + 0.2342X2 + log0.1234X2 # Ini tidak linier dalam variabelPCA dipilih dengan 3 syarat berikut : * Setiap PC memberikan varians terbesar * Setiap PC tidak berkorelasi dengan PC lain * Panjang vector yang memuat koefisien PC adalah 1 Asumsi yang harus berjalan agar PCA berjalan : * Tipe variabel harus numerik * Variabel yang menjadi input PCA adalah variabel prediktor * Variabel-variabel prediktor memiliki hubungan linier * Semua variabel harus distandarisasi Perhitungan PCA bisa dilakukan menggunakan konsep eigen value dan vector eigen; eigen value menunjukkan kontribusi PC terhadap variabilitas data, sedangkan vector eigen memberikan koefisien PC. Banyaknya PC akan dipilih sesuai dengan batas yang diinginkan atau menggunakan metode elbow atau screeplot.
Menyiapkan data
1 Menyiapkan data (standarisasi data) 2 Menghitung matrik kovarian atau matrik korelasi 3 Menghitung nilai eigen dan vector eigen dari matrik korelasi 4 Memilih principal component 5 Visualisasi output 6 Menghitung skor baru
Cara kerja PCA adalah memilih principal component yang memberikan varians terbesar (eigen value) Cara ini membuat PCA sangat sensitif terhadap nilai variabel yang berbeda atau terhadap skala variabel yang berbeda. Cara sederhana untuk mengatasi ini adalah dengan melakukan standarisasi skala (setiap obs dikurangi dengan mean variabel, dan dibagi dengan standart deviasi variabel)
Setelah menstandartkan seluruh nilai variabel, tugas kita berikutnya adalah membuat matriks korelasi yang akan menunjukkan hubungan korelasi linier di seluruh variabel. Tahap ini akan memenuhi 2 tujuan : menghilangkan 2 variabel yang memiliki koefisiensi linier besar, dan mencari principal component dengan memilih variabel yang memberikan varians terbesar. Untuk tujuan kedua ini, bisa kita peroleh dengan menghitung value eigen dan vector eigen. Dari sinilah kita kita akan memperoleh variabel baru (dari vector eigen) yang merupakan kombinasi linier variabel lama.
Tentang jumlah principal component yang dipilih, kita bisa menggunakan beberapa kriteria : * Batasan variabilitas * Kriteria Kaiser; memilih seluruh PC yang eigen valuenya > 1 * Memilih k Principal Component Setelah mendapat PC yang diinginkan, kita bisa memlakukan visualisasi menggunakan biplot. Terakhir, skor variable lama akan ditransformasikan menjadi variabel baru
datanew = dataold * PCPackage dan Fungsi yang digunakan PCA
- cor() untuk membuat matrik korelasi
- eigen() menghitung nilai eigen dan vector eigen
- prcomp() untuk analisa PC
- princomp() untuk analisa PC
- screenplot() untuk membuat screenplot
- biplot() untuk membuat biplot
- autoplot() dari package ‘ggfortify’ untuk membuat biplot
- fviz_pca_ind() dari package factorextra untuk membuat biplot
Perbedaan prcomp() dan princomp()
Keduanya sama-sama melakukan melakukan analisa PCA; perbedaan utama terletak saat dilakukan standarisasi; prcomp() akan menggunakan n-1 sebagai denominator, sedangankan princomp() menggunakan n. Kesimpulan: Jika data cukup besar, gunakan princomp()
syntax prcomp()
prcomp(x, center = TRUE, scale = FALSE)Ada beberapa argumen lain dalam fungsi prcomp tapi untuk sementara cukup center dan scale yang lebih bermakna. Argument ‘center’ berfungsi untuk menentukan apakah variabel harus di’geser’ menjadi terpusat pada angka 0 atau tidak. Sedangkan argumen ‘scale’ digunakan untuk menentukan apakah nilai variabel perlu diskalakan sebelum proses analisa dimulai atau tidak. Dengan mensetting kedua parameter menjadi TRUE, R akan melakukan standarisasi nilai.
Contoh penerapan PCA dengan prcomp()
#Panggil library openxlsx untuk membaca file data Excel
library(openxlsx)## Warning: package 'openxlsx' was built under R version 4.1.2#Baca data pada sheet "3varb" dalam file https://storage.googleapis.com/dqlab-dataset/dqlab_pcadata.xlsx
#dan simpan data dengan nama df_raw
df_raw <- read.xlsx("https://storage.googleapis.com/dqlab-dataset/dqlab_pcadata.xlsx", sheet = "3varb")
#Tampilkan struktur data
str(df_raw)## 'data.frame': 20 obs. of 3 variables:
## $ x1: num 8.1 10.6 7.5 14.8 11 7.5 11.5 12.2 11.7 9.1 ...
## $ x2: num 10.6 13 9.5 15.8 13.3 9.5 13.4 13.5 13.5 11.3 ...
## $ x3: num 217.7 173.3 648.5 578.3 -44.4 ...#Tampilkan beberapa baris observasi dengan fungsi head()
head(df_raw)## x1 x2 x3
## 1 8.1 10.6 217.7
## 2 10.6 13.0 173.3
## 3 7.5 9.5 648.5
## 4 14.8 15.8 578.3
## 5 11.0 13.3 -44.4
## 6 7.5 9.5 -53.7#Lakukan analisa PCA dengan fungsi prcomp() dan
#simpan output ke dalam obyek dengan nama pr.out
pr.out <- prcomp(df_raw, center = TRUE, scale = TRUE, retx = TRUE)
#Tampilkan komponen output fungsi prcomp()
names(pr.out)## [1] "sdev" "rotation" "center" "scale" "x"#Tampilkan output PCA dengan memanggil obyek pr.out
pr.out## Standard deviations (1, .., p=3):
## [1] 1.4578260 0.9287578 0.1102369
##
## Rotation (n x k) = (3 x 3):
## PC1 PC2 PC3
## x1 0.6704698 -0.2112281 -0.71123334
## x2 0.6640498 -0.2567210 0.70223374
## x3 0.3309200 0.9431209 0.03185768#Tampilkan summary dari output PCA
summary(pr.out)## Importance of components:
## PC1 PC2 PC3
## Standard deviation 1.4578 0.9288 0.11024
## Proportion of Variance 0.7084 0.2875 0.00405
## Cumulative Proportion 0.7084 0.9960 1.00000#Gambarkan Screeplot dengan menggunakan fungsi screeplot()
#Tambahkan garis horizontal sebagai panduan untuk menggunakan kriteria Kaiser
screeplot(pr.out,type = "line")
abline(h = 1, col = "red", lty = 3)
#Gambarkan biplot dengan menggunakan fungsi biplot()
#Gunakan opsi scale = 0 agar panjang vektor sesuai dengan kontribusi variabel.
biplot(pr.out, scale = 0)
Mari kita pahami satu persatu hasil dari prcomp()
[1] "sdev" "rotation" "center" "scale" "x" Ini adalah komponen dari output prcomp()
sdev = akar dari eigen value rotation = loading dari principal component; loading adalah koefisien dari kombinasi linier variabel-variabel lama yang membentuk principal component center = mean dari masing-masing variabel lama scale = standart deviasi dari nilai kolom-kolom (variabel) lama x = skor data setelah variabel lama ditransformasi dengan PC
Standard deviations (1, .., p=3):
[1] 1.4578260 0.9287578 0.1102369Ini adalah standar deviasi yang akan digunakan untuk mengukur kontribusi principal component pada variabilitas data; ini karena sdev juga merupakan nilai akar dari eigen value yang berfungsi sebagai pengukur kontribusi PC dalam variabilitas data.
Rotation (n x k) = (3 x 3):
PC1 PC2 PC3
x1 0.6704698 -0.2112281 -0.71123334
x2 0.6640498 -0.2567210 0.70223374
x3 0.3309200 0.9431209 0.03185768Ini adalah bagian rotation yang menunjukkan loading dari PC; nilai-nilai ini yang akan digunakan untuk menghitung skor data pada koordinat yang baru. Koefisien-koefisien secara kolom itu menunjukkan berapa besar korelasi variabel terkait dengan PC nya. Contoh : 0.6704.. menunjukkan korelasi x1 terhadap PC1, 0.3309200 menunjukkan korelasi x3 terhadap PC1.
Importance of components:
PC1 PC2 PC3
Standard deviation 1.4578 0.9288 0.11024
Proportion of Variance 0.7084 0.2875 0.00405
Cumulative Proportion 0.7084 0.9960 1.00000Bagian ini menunjukkan nilai kontribusi varians masing-masing PC terhadap data. Dari data ini, akan menjadi dasar dari screeplot; di mana kita akan menentukan berapa PC yang dibutuhkan.
Lalu berlanjut pada graph pertama; itu adalah graph screeplot di mana kita akan menentukan berapa PC yang dibutuhkan berdasarkan prinsip ‘elbow’ atau kraiser
pada graph kedua, adalah biplot di mana kita bisa melihat skor baru dari PCA masing-masing obs, juga kontribusi variabel terhadap PC
Praktik
#Panggil library openxlsx untuk membaca file data Excel
library(openxlsx)
#Baca data pada sheet "csdata" dalam file "https://storage.googleapis.com/dqlab-dataset/dqlab_pcadata.xlsx"
#dan simpan data dengan nama "csdat_raw"
csdat_raw <- read.xlsx("https://storage.googleapis.com/dqlab-dataset/dqlab_pcadata.xlsx", sheet = "csdata")
#Tampilkan struktur data
str(csdat_raw)## 'data.frame': 900 obs. of 6 variables:
## $ contractcode: chr "AGR-000001" "AGR-000011" "AGR-000030" "AGR-000043" ...
## $ income : num 295 271 159 210 165 220 70 88 163 100 ...
## $ tenor : num 48 36 12 12 36 24 36 48 48 36 ...
## $ dependents : num 5 5 0 3 0 5 3 3 5 6 ...
## $ midoverdue : num 75.5 75.5 0 53 38 15 38 38 38 38 ...
## $ riskrating : num 4 4 1 3 2 1 2 2 2 2 ...#Tampilkan beberapa baris observasi dengan fungsi head()
head(csdat_raw)## contractcode income tenor dependents midoverdue riskrating
## 1 AGR-000001 295 48 5 75.5 4
## 2 AGR-000011 271 36 5 75.5 4
## 3 AGR-000030 159 12 0 0.0 1
## 4 AGR-000043 210 12 3 53.0 3
## 5 AGR-000049 165 36 0 38.0 2
## 6 AGR-000063 220 24 5 15.0 1#Tampilkan statistika deskriptif untuk semua variabel dalam data dengan fungsi summary()
summary(csdat_raw)## contractcode income tenor dependents
## Length:900 Min. : 70.0 Min. :12.00 Min. :0.000
## Class :character 1st Qu.:121.0 1st Qu.:12.00 1st Qu.:1.000
## Mode :character Median :162.0 Median :24.00 Median :3.000
## Mean :163.3 Mean :29.93 Mean :2.932
## 3rd Qu.:199.0 3rd Qu.:48.00 3rd Qu.:5.000
## Max. :300.0 Max. :48.00 Max. :6.000
## midoverdue riskrating
## Min. : 0.0 Min. :1.000
## 1st Qu.:15.0 1st Qu.:1.000
## Median :53.0 Median :3.000
## Mean :48.1 Mean :2.681
## 3rd Qu.:53.0 3rd Qu.:3.000
## Max. :91.0 Max. :5.000#Gambarkan distribusi Income berdasarkan Dependents
library(ggplot2)
ggplot(csdat_raw, aes(as.factor(dependents), income)) +
geom_boxplot() + xlab("Dependents") + ggtitle("Boxplot Income Berdasarkan Dependents")
#Pisahkan data untuk traning set dan testing set
#untuk tiap-tiap risk rating
#[5]
#Catat indeks/ nomor baris untuk tiap-tiap risk rating
index1 <- which(csdat_raw$riskrating == 1)
index2 <- which(csdat_raw$riskrating == 2)
#Lakukan pencatatan indeks untuk risk rating berikutnya
#[6]
index3 <- which(csdat_raw$riskrating == 3)
index4 <- which(csdat_raw$riskrating == 4)
index5 <- which(csdat_raw$riskrating == 5)
#80% data akan digunakan sebagai traning set.
#Ulangi langkah sampai dengan index5
#[7]
ntrain1 <- round(0.8 * length(index1))
ntrain2 <- round(0.8 * length(index2))
ntrain3 <- round(0.8 * length(index3))
ntrain4 <- round(0.8 * length(index4))
ntrain5 <- round(0.8 * length(index5))
#set seed agar sampling ini bisa direproduksi
set.seed(100)
#sampling data masing-masing rating untuk training set
#Ulangi langkah sampai dengan train5_index
#[8]
train1_index <- sample(index1, ntrain1)
train2_index <- sample(index2, ntrain2)
train3_index <- sample(index3,ntrain3)
train4_index <- sample(index4, ntrain4)
train5_index <- sample(index5, ntrain5)
#menyimpan data ke dalam testing set
#Ulangi langkah sampai dengan test5_index
#[9]
test1_index <- setdiff(index1, train1_index)
test2_index <- setdiff(index2, train2_index)
test3_index <- setdiff(index3, train3_index)
test4_index <- setdiff(index4, train4_index)
test5_index <- setdiff(index5, train5_index)
#Menggabungkan hasil sampling masing-masing risk rating ke dalam training set
csdattrain <- do.call("rbind", list(csdat_raw[train1_index,],
csdat_raw[train2_index,], csdat_raw[train3_index,],
csdat_raw[train4_index,], csdat_raw[train5_index,]))
cstrainl <- subset(csdattrain, select =
-c(contractcode,riskrating))
#Menggabungkan hasil sampling masing-masing risk rating ke dalam testing set
csdattest <- do.call("rbind", list(csdat_raw[test1_index,], csdat_raw[test2_index,], csdat_raw[test3_index,], csdat_raw[test4_index,], csdat_raw[test5_index,]))
cstest <- subset(csdattest,
select = -c(contractcode, riskrating))
#Menghitung korelasi antar variabel dalam data frame
cor(cstrainl)## income tenor dependents midoverdue
## income 1.00000000 -0.07256604 0.2427909 0.1250535
## tenor -0.07256604 1.00000000 0.0334339 0.2333681
## dependents 0.24279088 0.03343390 1.0000000 0.7632659
## midoverdue 0.12505348 0.23336810 0.7632659 1.0000000#Lakukan analisa PCA dengan fungsi prcomp() dan
#simpan output ke dalam obyek dengan nama pr.out
pr.outl <- prcomp(cstrainl, scale = TRUE, center = TRUE)
#Tampilkan output PCA dengan memanggil obyek pr.out
pr.outl## Standard deviations (1, .., p=4):
## [1] 1.3685609 1.0492944 0.9059637 0.4530475
##
## Rotation (n x k) = (4 x 4):
## PC1 PC2 PC3 PC4
## income -0.2665678 0.6235436 -0.7299486 0.08549929
## tenor -0.1827165 -0.7592266 -0.6015443 -0.16832731
## dependents -0.6675878 0.1100498 0.2569754 -0.69005738
## midoverdue -0.6707330 -0.1505238 0.1981998 0.69869635#Tampilkan summary dari output PCA
summary(pr.outl)## Importance of components:
## PC1 PC2 PC3 PC4
## Standard deviation 1.3686 1.0493 0.9060 0.45305
## Proportion of Variance 0.4682 0.2752 0.2052 0.05131
## Cumulative Proportion 0.4682 0.7435 0.9487 1.00000#Gambarkan Screeplot dengan menggunakan fungsi screeplot()
screeplot(pr.outl, type = "line", ylim = c(0,2))
#Tambahkan garis horizontal sebagai panduan untuk menggunakan kriteria Kaiser
abline(h = 1, lty = 3, col = "red")
#Gambarkan biplot dengan menggunakan fungsi biplot()
biplot(pr.outl, scale = 0)
PCA 8 Variabel
#Panggil library openxlsx untuk membaca file data Excel
library(openxlsx)
#Baca data pada sheet "cslarge" dalam file "https://storage.googleapis.com/dqlab-dataset/dqlab_pcadata.xlsx"
#dan simpan data dengan nama "cslarge_raw"
cslarge_raw <- read.xlsx("https://storage.googleapis.com/dqlab-dataset/dqlab_pcadata.xlsx", sheet = "cslarge")
#Tampilkan struktur data
str(cslarge_raw)## 'data.frame': 900 obs. of 10 variables:
## $ contractcode: chr "AGR-000001" "AGR-000011" "AGR-000030" "AGR-000043" ...
## $ income : num 295 271 159 210 165 220 70 88 163 100 ...
## $ tenor : num 48 36 12 12 36 24 36 48 48 36 ...
## $ dependents : num 5 5 0 3 0 5 3 3 5 6 ...
## $ midoverdue : num 76 76 0 53 38 15 38 38 38 38 ...
## $ riskrating : num 4 4 1 3 2 1 2 2 2 2 ...
## $ age : num 55 53 35 45 36 45 21 24 35 26 ...
## $ empyear : num 12 10 5 7 5 8 1 1 6 2 ...
## $ asset : num 893 906 552 791 593 ...
## $ debt : num 4.6984 4.0639 0.05 0.7214 0.0667 ...#Tampilkan beberapa baris observasi dengan fungsi head()
head(cslarge_raw)## contractcode income tenor dependents midoverdue riskrating age empyear
## 1 AGR-000001 295 48 5 76 4 55 12
## 2 AGR-000011 271 36 5 76 4 53 10
## 3 AGR-000030 159 12 0 0 1 35 5
## 4 AGR-000043 210 12 3 53 3 45 7
## 5 AGR-000049 165 36 0 38 2 36 5
## 6 AGR-000063 220 24 5 15 1 45 8
## asset debt
## 1 892.9266 4.69837074
## 2 905.8225 4.06385168
## 3 551.7261 0.05000000
## 4 791.1124 0.72138396
## 5 592.6501 0.06666667
## 6 778.0493 2.59791099#Tampilkan statistika deskriptif untuk semua variabel dalam data frame.
summary(cslarge_raw)## contractcode income tenor dependents
## Length:900 Min. : 70.0 Min. :12.00 Min. :0.000
## Class :character 1st Qu.:121.0 1st Qu.:12.00 1st Qu.:1.000
## Mode :character Median :162.0 Median :24.00 Median :3.000
## Mean :163.3 Mean :29.93 Mean :2.932
## 3rd Qu.:199.0 3rd Qu.:48.00 3rd Qu.:5.000
## Max. :300.0 Max. :48.00 Max. :6.000
## midoverdue riskrating age empyear
## Min. : 0.00 Min. :1.000 Min. :20.00 Min. : 0.000
## 1st Qu.:15.00 1st Qu.:1.000 1st Qu.:29.00 1st Qu.: 3.000
## Median :53.00 Median :3.000 Median :36.00 Median : 5.000
## Mean :48.16 Mean :2.681 Mean :35.88 Mean : 5.153
## 3rd Qu.:53.00 3rd Qu.:3.000 3rd Qu.:42.00 3rd Qu.: 7.000
## Max. :91.00 Max. :5.000 Max. :61.00 Max. :13.000
## asset debt
## Min. : 232.2 Min. : 0.0500
## 1st Qu.: 440.0 1st Qu.: 0.6469
## Median : 555.0 Median : 2.0253
## Mean : 571.0 Mean : 3.8091
## 3rd Qu.: 687.8 3rd Qu.: 5.1902
## Max. :1192.3 Max. :23.5382#Gambarkan distribusi income berdasarkan dependents.
library(ggplot2) # library untuk fungsi ggplot
ggplot(cslarge_raw, aes(as.factor(dependents), income)) +
geom_boxplot() + xlab("Dependents") + ggtitle("Boxplot Income Berdasarkan Dependents")
#Gambarkan distribusi debt berdasarkan dependents seperti pada
#contoh boxplot income di atas.
ggplot(cslarge_raw, aes(as.factor(dependents),debt)) + geom_boxplot() + xlab("Dependents") + ggtitle("Boxplot Debt Berdasarkan Dependents")
#Pisahkan data untuk traning set dan testing set
#untuk tiap-tiap risk rating
#[5]
#Catat indeks/ nomor baris untuk tiap-tiap risk rating
index1l <- which(cslarge_raw$riskrating == 1)
index2l <- which(cslarge_raw$riskrating == 2)
index3l <- which(cslarge_raw$riskrating == 3)
index4l <- which(cslarge_raw$riskrating == 4)
index5l <- which(cslarge_raw$riskrating == 5)
#Lakukan pencatatan indeks untuk risk rating berikutnya
#80% data akan digunakan sebagai traning set.
#Ulangi langkah sampai dengan index5
ntrain1l <- round(0.8 * length(index1l))
ntrain2l <- round(0.8 * length(index2l))
ntrain3l <- round(0.8 * length(index3l))
ntrain4l <- round(0.8 * length(index4l))
ntrain5l <- round(0.8 * length(index5l))
#set seed agar sampling ini bisa direproduksi
set.seed(100)
#sampling data masing-masing rating untuk training set
train1l_index <- sample(index1l, ntrain1l)
train2l_index <- sample(index2l, ntrain2l)
#Ulangi langkah sampai dengan train5_index
train3l_index <- sample(index3l, ntrain3l)
train4l_index <- sample(index4l, ntrain4l)
train5l_index <- sample(index5l, ntrain5l)
#menyimpan data ke dalam testing set
test1l_index <- setdiff(index1l, train1l_index)
test2l_index <- setdiff(index2l, train2l_index)
#Ulangi langkah sampai dengan test5_index
test3l_index <- setdiff(index3l, train3l_index)
test4l_index <- setdiff(index4l, train4l_index)
test5l_index <- setdiff(index5l, train5l_index)
#Menggabungkan hasil sampling masing-masing risk rating ke dalam training set
cslarge_train <- do.call("rbind", list(cslarge_raw[train1l_index,],
cslarge_raw[train2l_index,], cslarge_raw[train3l_index,],
cslarge_raw[train4l_index,], cslarge_raw[train5l_index,]))
cstrainl <- subset(cslarge_train, select = -c(contractcode,riskrating))
#Menggabungkan hasil sampling masing-masing risk rating ke dalam testing set
cslarge_test <- do.call("rbind", list(cslarge_raw[test1l_index,], cslarge_raw[test2l_index,], cslarge_raw[test3l_index,], cslarge_raw[test4l_index,], cslarge_raw[test5l_index,]))
cstestl <- subset(cslarge_test, select = -c(contractcode,riskrating))
#Menghitung korelasi antar variabel dalam data frame
cor(cstrainl)## income tenor dependents midoverdue age
## income 1.00000000 -0.07256604 0.2427909 0.12756439 0.98345799
## tenor -0.07256604 1.00000000 0.0334339 0.23170789 -0.07433539
## dependents 0.24279088 0.03343390 1.0000000 0.76422579 0.23110488
## midoverdue 0.12756439 0.23170789 0.7642258 1.00000000 0.12134786
## age 0.98345799 -0.07433539 0.2311049 0.12134786 1.00000000
## empyear 0.97526554 -0.07152033 0.2499218 0.13267309 0.92632487
## asset 0.86275940 -0.07265391 0.1901048 0.09832691 0.93780421
## debt 0.16255937 0.08842241 0.6952961 0.70521333 0.15994524
## empyear asset debt
## income 0.97526554 0.86275940 0.16255937
## tenor -0.07152033 -0.07265391 0.08842241
## dependents 0.24992178 0.19010482 0.69529606
## midoverdue 0.13267309 0.09832691 0.70521333
## age 0.92632487 0.93780421 0.15994524
## empyear 1.00000000 0.74882989 0.16008510
## asset 0.74882989 1.00000000 0.13959529
## debt 0.16008510 0.13959529 1.00000000#Menggambarkan matrik korelasi dengan ggcorrplot
library(ggcorrplot)## Warning: package 'ggcorrplot' was built under R version 4.1.2ggcorrplot(cor(cstrainl))
#Lakukan analisa PCA dengan fungsi prcomp() dan
#simpan output ke dalam obyek dengan nama pr.out
pr.outl <- prcomp(cstrainl, center = TRUE, scale = TRUE)
#Tampilkan output PCA dengan memanggil obyek pr.out
pr.outl## Standard deviations (1, .., p=8):
## [1] 1.9886275 1.5061223 0.9869479 0.5697568 0.5168331 0.4513118 0.0807862
## [8] 0.0306914
##
## Rotation (n x k) = (8 x 8):
## PC1 PC2 PC3 PC4 PC5
## income -0.48037618 0.1732370 -0.04956696 0.05692772 -0.21996290
## tenor 0.02300648 -0.1921475 -0.96534791 -0.02622698 -0.04016120
## dependents -0.23802064 -0.5058409 0.19514188 0.46401430 0.04509053
## midoverdue -0.18278120 -0.5638239 -0.03401568 0.29673063 0.22083181
## age -0.48194139 0.1807062 -0.05221971 -0.04070810 0.10019847
## empyear -0.46111279 0.1571628 -0.04049775 0.17088762 -0.57056947
## asset -0.44138937 0.1785155 -0.05058642 -0.22043915 0.71311191
## debt -0.19730574 -0.5196857 0.13958206 -0.78310912 -0.23470343
## PC6 PC7 PC8
## income 0.053169773 0.560979083 6.063182e-01
## tenor -0.168350384 -0.003290186 -9.006944e-05
## dependents -0.657287184 0.004360366 -1.701761e-03
## midoverdue 0.714643123 0.002246697 1.006382e-03
## age 0.002608534 0.386800275 -7.556671e-01
## empyear 0.111545448 -0.623731435 -6.927760e-02
## asset -0.102418913 -0.382877667 2.377850e-01
## debt -0.056134329 -0.004113309 6.814070e-04#Tampilkan summary dari output PCA
summary(pr.outl)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 1.9886 1.5061 0.9869 0.56976 0.51683 0.45131 0.08079
## Proportion of Variance 0.4943 0.2836 0.1218 0.04058 0.03339 0.02546 0.00082
## Cumulative Proportion 0.4943 0.7779 0.8996 0.94022 0.97361 0.99907 0.99988
## PC8
## Standard deviation 0.03069
## Proportion of Variance 0.00012
## Cumulative Proportion 1.00000#Gambarkan Screeplot dengan menggunakan fungsi screeplot()
screeplot(pr.outl, type = "line", ylim = c(0,2))
#Tambahkan garis horizontal sebagai panduan untuk menggunakan kriteria Kaiser
abline(h = 1, lty = 3, col = "red")
#Gambarkan biplot dengan menggunakan fungsi biplot()
biplot(pr.outl, scale = 0)
#Gambarkan Principal Component dan risk rating dengan menggunakan
#fungsi autoplot() dari package ggfortify.
library(ggfortify)## Warning: package 'ggfortify' was built under R version 4.1.2autoplot(pr.outl, data = cslarge_train, colour = 'riskrating',
loadings = TRUE, loadings.label = TRUE,
loadings.label.size = 3, scale = 0)
#Gambarkan Principal Component dan risk rating dengan menggunakan
#fungsi fviz_pca_ind() package factoextra.
library(factoextra)## Warning: package 'factoextra' was built under R version 4.1.2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBafviz_pca_ind(pr.outl, label="none", habillage=cslarge_train$riskrating)
Kekurangan PCA
PCA tidak bisa dianggap sebagai model, karena hanya melibatkan variabel prediktor. PCA lebih cocok digunakan untuk teknik processing data. Alternatif lainnya adalah menggunakan partial least square yang melibatkan variabel respon dalam reduksi dimensi